/[emacs]/emacs/lisp/emacs-lisp/checkdoc.el
ViewVC logotype

Diff of /emacs/lisp/emacs-lisp/checkdoc.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.27 by rost, Sun May 12 19:08:11 2002 UTC revision 1.27.2.1 by miles, Fri Apr 4 06:20:16 2003 UTC
# Line 91  Line 91 
91  ;;   The variable `checkdoc-spellcheck-documentation-flag' can be set  ;;   The variable `checkdoc-spellcheck-documentation-flag' can be set
92  ;; to customize how spell checking is to be done.  Since spell  ;; to customize how spell checking is to be done.  Since spell
93  ;; checking can be quite slow, you can optimize how best you want your  ;; checking can be quite slow, you can optimize how best you want your
94  ;; checking done.  The default is 'defun, which spell checks each time  ;; checking done.  The default is `defun', which spell checks each time
95  ;; `checkdoc-defun' or `checkdoc-eval-defun' is used.  Setting to nil  ;; `checkdoc-defun' or `checkdoc-eval-defun' is used.  Setting to nil
96  ;; prevents spell checking during normal usage.  ;; prevents spell checking during normal usage.
97  ;;   Setting this variable to nil does not mean you cannot take  ;;   Setting this variable to nil does not mean you cannot take
# Line 301  variable `checkdoc-common-verbs-wrong-vo Line 301  variable `checkdoc-common-verbs-wrong-vo
301    :type 'boolean)    :type 'boolean)
302    
303  (defvar checkdoc-generate-compile-warnings-flag nil  (defvar checkdoc-generate-compile-warnings-flag nil
304    "Non-nil means generage warnings in a buffer for browsing.    "Non-nil means generate warnings in a buffer for browsing.
305  Do not set this by hand, use a function like `checkdoc-current-buffer'  Do not set this by hand, use a function like `checkdoc-current-buffer'
306  with a universal argument.")  with a universal argument.")
307    
# Line 426  be re-created.") Line 426  be re-created.")
426    ;; end of a word in a conglomerate.    ;; end of a word in a conglomerate.
427    (modify-syntax-entry ?- "w" checkdoc-syntax-table)    (modify-syntax-entry ?- "w" checkdoc-syntax-table)
428    )    )
429            
430    
431  ;;; Compatibility  ;;; Compatibility
432  ;;  ;;
# Line 461  be re-created.") Line 461  be re-created.")
461  ;;  ;;
462  ;;;###autoload  ;;;###autoload
463  (defun checkdoc ()  (defun checkdoc ()
464    "Interactivly check the entire buffer for style errors.    "Interactively check the entire buffer for style errors.
465  The current status of the ckeck will be displayed in a buffer which  The current status of the check will be displayed in a buffer which
466  the users will view as each check is completed."  the users will view as each check is completed."
467    (interactive)    (interactive)
468    (let ((status (list "Checking..." "-" "-" "-"))    (let ((status (list "Checking..." "-" "-" "-"))
469          (checkdoc-spellcheck-documentation-flag          (checkdoc-spellcheck-documentation-flag
470           (member checkdoc-spellcheck-documentation-flag           (car (memq checkdoc-spellcheck-documentation-flag
471                   '(buffer interactive t)))                      '(buffer interactive t))))
472          ;; if the user set autofix to never, then that breaks the          ;; if the user set autofix to never, then that breaks the
473          ;; obviously requested asking implied by using this function.          ;; obviously requested asking implied by using this function.
474          ;; Set it to paranoia level.          ;; Set it to paranoia level.
# Line 509  the users will view as each check is com Line 509  the users will view as each check is com
509    
510  (defun checkdoc-display-status-buffer (check)  (defun checkdoc-display-status-buffer (check)
511    "Display and update the status buffer for the current checkdoc mode.    "Display and update the status buffer for the current checkdoc mode.
512  CHECK is a vector stating the current status of each test as an  CHECK is a list of four strings stating the current status of each
513  element is the status of that level of teset."  test; the nth string describes the status of the nth test."
514    (let (temp-buffer-setup-hook)    (let (temp-buffer-setup-hook)
515      (with-output-to-temp-buffer " *Checkdoc Status*"      (with-output-to-temp-buffer " *Checkdoc Status*"
516        (princ-list        (princ-list
# Line 535  Optional argument SHOWSTATUS indicates t Line 535  Optional argument SHOWSTATUS indicates t
535  checkdoc status window instead of the usual behavior."  checkdoc status window instead of the usual behavior."
536    (interactive "P")    (interactive "P")
537    (let ((checkdoc-spellcheck-documentation-flag    (let ((checkdoc-spellcheck-documentation-flag
538           (member checkdoc-spellcheck-documentation-flag           (car (memq checkdoc-spellcheck-documentation-flag
539                   '(interactive t))))                      '(interactive t)))))
540      (checkdoc-interactive-loop start-here showstatus 'checkdoc-next-error)))      (prog1
541            ;; Due to a design flaw, this will never spell check
542            ;; docstrings.
543            (checkdoc-interactive-loop start-here showstatus
544                                       'checkdoc-next-error)
545          ;; This is a workaround to perform spell checking.
546          (checkdoc-interactive-ispell-loop start-here))))
547    
548  ;;;###autoload  ;;;###autoload
549  (defun checkdoc-message-interactive (&optional start-here showstatus)  (defun checkdoc-message-interactive (&optional start-here showstatus)
# Line 550  Optional argument SHOWSTATUS indicates t Line 556  Optional argument SHOWSTATUS indicates t
556  checkdoc status window instead of the usual behavior."  checkdoc status window instead of the usual behavior."
557    (interactive "P")    (interactive "P")
558    (let ((checkdoc-spellcheck-documentation-flag    (let ((checkdoc-spellcheck-documentation-flag
559           (member checkdoc-spellcheck-documentation-flag           (car (memq checkdoc-spellcheck-documentation-flag
560                   '(interactive t))))                      '(interactive t)))))
561      (checkdoc-interactive-loop start-here showstatus      (prog1
562                                 'checkdoc-next-message-error)))          ;; Due to a design flaw, this will never spell check messages.
563            (checkdoc-interactive-loop start-here showstatus
564                                       'checkdoc-next-message-error)
565          ;; This is a workaround to perform spell checking.
566          (checkdoc-message-interactive-ispell-loop start-here))))
567    
568  (defun checkdoc-interactive-loop (start-here showstatus findfunc)  (defun checkdoc-interactive-loop (start-here showstatus findfunc)
569    "Interactivly loop over all errors that can be found by a given method.    "Interactively loop over all errors that can be found by a given method.
570  Searching starts at START-HERE.  SHOWSTATUS expresses the verbosity  
571  of the search, and wether ending the search will auto-exit this function.  If START-HERE is nil, searching starts at the beginning of the current
572    buffer, otherwise searching starts at START-HERE.  SHOWSTATUS
573    expresses the verbosity of the search, and whether ending the search
574    will auto-exit this function.
575    
576  FINDFUNC is a symbol representing a function that will position the  FINDFUNC is a symbol representing a function that will position the
577  cursor, and return error message text to present to the user.  It is  cursor, and return error message text to present to the user.  It is
578  assumed that the cursor will stop just before a major sexp, which will  assumed that the cursor will stop just before a major sexp, which will
# Line 569  style." Line 583  style."
583                    (if (not start-here) (goto-char (point-min)))))                    (if (not start-here) (goto-char (point-min)))))
584           ;; Assign a flag to spellcheck flag           ;; Assign a flag to spellcheck flag
585           (checkdoc-spellcheck-documentation-flag           (checkdoc-spellcheck-documentation-flag
586            (member checkdoc-spellcheck-documentation-flag            (car (memq checkdoc-spellcheck-documentation-flag
587                    '(buffer interactive t)))                       '(buffer interactive t))))
588           ;; Fetch the error list           ;; Fetch the error list
589           (err-list (list (funcall findfunc nil)))           (err-list (list (funcall findfunc nil)))
590           (cdo nil)           (cdo nil)
# Line 614  style." Line 628  style."
628                  (goto-char (checkdoc-error-start (car (car err-list))))                  (goto-char (checkdoc-error-start (car (car err-list))))
629                  (if (not (pos-visible-in-window-p))                  (if (not (pos-visible-in-window-p))
630                      (recenter (- (window-height) 2)))                      (recenter (- (window-height) 2)))
631                  (setq c (checkdoc-read-event)))1                  (setq c (checkdoc-read-event)))
632                (if (not (integerp c)) (setq c ??))                (if (not (integerp c)) (setq c ??))
633                (cond                (cond
634                 ;; Exit condition                 ;; Exit condition
# Line 626  style." Line 640  style."
640                  (goto-char (cdr (car err-list)))                  (goto-char (cdr (car err-list)))
641                  ;; `automatic-then-never' tells the autofix function                  ;; `automatic-then-never' tells the autofix function
642                  ;; to only allow one fix to be automatic.  The autofix                  ;; to only allow one fix to be automatic.  The autofix
643                  ;; function will than set the flag to 'never, allowing                  ;; function will then set the flag to 'never, allowing
644                  ;; the checker to return a different error.                  ;; the checker to return a different error.
645                  (let ((checkdoc-autofix-flag 'automatic-then-never)                  (let ((checkdoc-autofix-flag 'automatic-then-never)
646                        (fixed nil))                        (fixed nil))
# Line 691  style." Line 705  style."
705                  (setq returnme err-list                  (setq returnme err-list
706                        err-list nil                        err-list nil
707                        begin (point)))                        begin (point)))
708                 ;; Goofy s tuff                 ;; Goofy stuff
709                 (t                 (t
710                  (if (get-buffer-window "*Checkdoc Help*")                  (if (get-buffer-window "*Checkdoc Help*")
711                      (progn                      (progn
# Line 720  style." Line 734  style."
734      (message "Checkdoc: Done.")      (message "Checkdoc: Done.")
735      returnme))      returnme))
736    
737    (defun checkdoc-interactive-ispell-loop (start-here)
738      "Interactively spell check doc strings in the current buffer.
739    If START-HERE is nil, searching starts at the beginning of the current
740    buffer, otherwise searching starts at START-HERE."
741      (when checkdoc-spellcheck-documentation-flag
742        (save-excursion
743          ;; Move point to where we need to start.
744          (if start-here
745              ;; Include whatever function point is in for good measure.
746              (beginning-of-defun)
747            (goto-char (point-min)))
748          ;; Loop over docstrings.
749          (while (checkdoc-next-docstring)
750            (message "Searching for doc string spell error...%d%%"
751                     (/ (* 100 (point)) (point-max)))
752            (if (looking-at "\"")
753                (checkdoc-ispell-docstring-engine
754                 (save-excursion (forward-sexp 1) (point-marker)))))
755          (message "Checkdoc: Done."))))
756    
757    (defun checkdoc-message-interactive-ispell-loop (start-here)
758      "Interactively spell check messages in the current buffer.
759    If START-HERE is nil, searching starts at the beginning of the current
760    buffer, otherwise searching starts at START-HERE."
761      (when checkdoc-spellcheck-documentation-flag
762        (save-excursion
763          ;; Move point to where we need to start.
764          (if start-here
765              ;; Include whatever function point is in for good measure.
766              (beginning-of-defun)
767            (goto-char (point-min)))
768          ;; Loop over message strings.
769          (while (checkdoc-message-text-next-string (point-max))
770            (message "Searching for message string spell error...%d%%"
771                     (/ (* 100 (point)) (point-max)))
772            (if (looking-at "\"")
773                (checkdoc-ispell-docstring-engine
774                 (save-excursion (forward-sexp 1) (point-marker)))))
775          (message "Checkdoc: Done."))))
776    
777    
778  (defun checkdoc-next-error (enable-fix)  (defun checkdoc-next-error (enable-fix)
779    "Find and return the next checkdoc error list, or nil.    "Find and return the next checkdoc error list, or nil.
780  Only documentation strings are checked.  Only documentation strings are checked.
781  Add error vector is of the form (WARNING . POSITION) where WARNING  An error list is of the form (WARNING . POSITION) where WARNING is the
782  is the warning text, and POSITION is the point in the buffer where the  warning text, and POSITION is the point in the buffer where the error
783  error was found.  We can use points and not markers because we promise  was found.  We can use points and not markers because we promise not
784  not to edit the buffer before point without re-executing this check.  to edit the buffer before point without re-executing this check.
785  Argument ENABLE-FIX will enable auto-fixing while looking for the next  Argument ENABLE-FIX will enable auto-fixing while looking for the next
786  error.  This argument assumes that the cursor is already positioned to  error.  This argument assumes that the cursor is already positioned to
787  perform the fix."  perform the fix."
# Line 803  otherwise stop after the first error." Line 858  otherwise stop after the first error."
858    (if (interactive-p) (message "Checking buffer for style..."))    (if (interactive-p) (message "Checking buffer for style..."))
859    ;; Assign a flag to spellcheck flag    ;; Assign a flag to spellcheck flag
860    (let ((checkdoc-spellcheck-documentation-flag    (let ((checkdoc-spellcheck-documentation-flag
861           (memq checkdoc-spellcheck-documentation-flag '(buffer t)))           (car (memq checkdoc-spellcheck-documentation-flag
862                        '(buffer t))))
863          (checkdoc-autofix-flag (if take-notes 'never          (checkdoc-autofix-flag (if take-notes 'never
864                                   checkdoc-autofix-flag))                                   checkdoc-autofix-flag))
865          (checkdoc-generate-compile-warnings-flag          (checkdoc-generate-compile-warnings-flag
# Line 847  is the starting location.  If this is ni Line 903  is the starting location.  If this is ni
903    (let ((wrong nil) (msg nil) (errors nil)    (let ((wrong nil) (msg nil) (errors nil)
904          ;; Assign a flag to spellcheck flag          ;; Assign a flag to spellcheck flag
905          (checkdoc-spellcheck-documentation-flag          (checkdoc-spellcheck-documentation-flag
906           (member checkdoc-spellcheck-documentation-flag           (car (memq checkdoc-spellcheck-documentation-flag
907                   '(buffer t)))                      '(buffer t))))
908          (checkdoc-autofix-flag (if take-notes 'never          (checkdoc-autofix-flag (if take-notes 'never
909                                   checkdoc-autofix-flag))                                   checkdoc-autofix-flag))
910          (checkdoc-generate-compile-warnings-flag          (checkdoc-generate-compile-warnings-flag
# Line 891  if there is one." Line 947  if there is one."
947    (if (not buffer-file-name)    (if (not buffer-file-name)
948       (error "Can only check comments for a file buffer"))       (error "Can only check comments for a file buffer"))
949    (let* ((checkdoc-spellcheck-documentation-flag    (let* ((checkdoc-spellcheck-documentation-flag
950            (member checkdoc-spellcheck-documentation-flag            (car (memq checkdoc-spellcheck-documentation-flag
951                    '(buffer t)))                       '(buffer t))))
952           (checkdoc-autofix-flag (if take-notes 'never checkdoc-autofix-flag))           (checkdoc-autofix-flag (if take-notes 'never checkdoc-autofix-flag))
953           (e (checkdoc-file-comments-engine))           (e (checkdoc-file-comments-engine))
954          (checkdoc-generate-compile-warnings-flag          (checkdoc-generate-compile-warnings-flag
# Line 939  Optional argument TAKE-NOTES causes all Line 995  Optional argument TAKE-NOTES causes all
995          (checkdoc-show-diagnostics)))          (checkdoc-show-diagnostics)))
996      (goto-char p))      (goto-char p))
997    (if (interactive-p) (message "Checking interactive message text...done.")))    (if (interactive-p) (message "Checking interactive message text...done.")))
998        
999  ;;;###autoload  ;;;###autoload
1000  (defun checkdoc-eval-defun ()  (defun checkdoc-eval-defun ()
1001    "Evaluate the current form with `eval-defun' and check its documentation.    "Evaluate the current form with `eval-defun' and check its documentation.
# Line 971  space at the end of each line." Line 1027  space at the end of each line."
1027        (forward-sexp 1)        (forward-sexp 1)
1028        (skip-chars-forward " \n\t")        (skip-chars-forward " \n\t")
1029        (let* ((checkdoc-spellcheck-documentation-flag        (let* ((checkdoc-spellcheck-documentation-flag
1030                (member checkdoc-spellcheck-documentation-flag                (car (memq checkdoc-spellcheck-documentation-flag
1031                        '(defun t)))                           '(defun t))))
1032               (beg (save-excursion (beginning-of-defun) (point)))               (beg (save-excursion (beginning-of-defun) (point)))
1033               (end (save-excursion (end-of-defun) (point)))               (end (save-excursion (end-of-defun) (point)))
1034               (msg (checkdoc-this-string-valid)))               (msg (checkdoc-this-string-valid)))
# Line 1147  generating a buffered list of errors." Line 1203  generating a buffered list of errors."
1203      map)      map)
1204    "Keymap used to override evaluation key-bindings for documentation checking.")    "Keymap used to override evaluation key-bindings for documentation checking.")
1205    
1206  (defvar checkdoc-minor-keymap checkdoc-minor-mode-map  (defvaralias 'checkdoc-minor-keymap 'checkdoc-minor-mode-map)
1207    "Obsolete!  Use `checkdoc-minor-mode-map'.")  (make-obsolete-variable 'checkdoc-minor-keymap
1208                            'checkdoc-minor-mode-map)
1209    
1210  ;; Add in a menubar with easy-menu  ;; Add in a menubar with easy-menu
1211    
1212  (easy-menu-define  (easy-menu-define
1213   checkdoc-minor-menu checkdoc-minor-mode-map "Checkdoc Minor Mode Menu"   nil checkdoc-minor-mode-map "Checkdoc Minor Mode Menu"
1214   '("CheckDoc"   '("CheckDoc"
1215     ["Interactive Buffer Style Check" checkdoc t]     ["Interactive Buffer Style Check" checkdoc t]
1216     ["Interactive Buffer Style and Spelling Check" checkdoc-ispell t]     ["Interactive Buffer Style and Spelling Check" checkdoc-ispell t]
# Line 1194  bound to \\<checkdoc-minor-mode-map> \\[ Line 1251  bound to \\<checkdoc-minor-mode-map> \\[
1251  checking of documentation strings.  checking of documentation strings.
1252    
1253  \\{checkdoc-minor-mode-map}"  \\{checkdoc-minor-mode-map}"
1254    nil " CDoc" nil)    nil " CDoc" nil
1255      :group 'checkdoc)
1256    
1257  ;;; Subst utils  ;;; Subst utils
1258  ;;  ;;
# Line 1598  function,command,variable,option or symb Line 1656  function,command,variable,option or symb
1656                            (concat (car fp) "-flag"))))                            (concat (car fp) "-flag"))))
1657                     (if (checkdoc-y-or-n-p                     (if (checkdoc-y-or-n-p
1658                          (format                          (format
1659                           "Rename to %s and Query-Replace all occurances? "                           "Rename to %s and Query-Replace all occurrences? "
1660                           newname))                           newname))
1661                         (progn                         (progn
1662                           (beginning-of-defun)                           (beginning-of-defun)
# Line 1704  function,command,variable,option or symb Line 1762  function,command,variable,option or symb
1762               ;; it occurs last.               ;; it occurs last.
1763               (and checkdoc-verb-check-experimental-flag               (and checkdoc-verb-check-experimental-flag
1764                    (save-excursion                    (save-excursion
1765                      ;; Maybe rebuild the monster-regex                      ;; Maybe rebuild the monster-regexp
1766                      (checkdoc-create-common-verbs-regexp)                      (checkdoc-create-common-verbs-regexp)
1767                      (let ((lim (save-excursion                      (let ((lim (save-excursion
1768                                   (end-of-line)                                   (end-of-line)
# Line 2334  The default boundary is the entire buffe Line 2392  The default boundary is the entire buffe
2392      (while (setq type (checkdoc-message-text-next-string end))      (while (setq type (checkdoc-message-text-next-string end))
2393        (setq e (checkdoc-message-text-engine type)))        (setq e (checkdoc-message-text-engine type)))
2394      e))      e))
2395      
2396  (defun checkdoc-message-text-next-string (end)  (defun checkdoc-message-text-next-string (end)
2397    "Move cursor to the next checkable message string after point.    "Move cursor to the next checkable message string after point.
2398  Return the message classification.  Return the message classification.
# Line 2581  This function will not modify `match-dat Line 2639  This function will not modify `match-dat
2639    (if (looking-at "\\(\\(\\w+\\|\\s_\\)+\\.el\\):\\([0-9]+\\):")    (if (looking-at "\\(\\(\\w+\\|\\s_\\)+\\.el\\):\\([0-9]+\\):")
2640        (let ((l (string-to-int (match-string 3)))        (let ((l (string-to-int (match-string 3)))
2641              (f (match-string 1)))              (f (match-string 1)))
2642          (if (not (get-buffer f))          (if (not (get-file-buffer f))
2643              (error "Can't find buffer %s" f))              (error "Can't find buffer %s" f))
2644          (switch-to-buffer-other-window (get-buffer f))          (switch-to-buffer-other-window (get-file-buffer f))
2645          (goto-line l))))          (goto-line l))))
2646    
2647  (defun checkdoc-buffer-label ()  (defun checkdoc-buffer-label ()

Legend:
Removed from v.1.27  
changed lines
  Added in v.1.27.2.1

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26