]> code.delx.au - gnu-emacs/blobdiff - lisp/emacs-lisp/checkdoc.el
* emacs-lisp/checkdoc.el (checkdoc-file-comments-engine): Insert
[gnu-emacs] / lisp / emacs-lisp / checkdoc.el
index 05f0bb0977deb33af090ae694316b6551cbf1bd7..666b373ca5399e16da349eac905506d97e352592 100644 (file)
@@ -1,6 +1,7 @@
 ;;; checkdoc.el --- check documentation strings for style requirements
 
-;;;  Copyright (C) 1997, 1998, 2001  Free Software Foundation
+;; Copyright (C) 1997, 1998, 2001, 2002, 2003, 2004,
+;;   2005, 2006 Free Software Foundation, Inc.
 
 ;; Author: Eric M. Ludlam <zappo@gnu.org>
 ;; Version: 0.6.2
@@ -20,8 +21,8 @@
 
 ;; You should have received a copy of the GNU General Public License
 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
 
 ;;; Commentary:
 ;;
      (defmacro defcustom (var value doc &rest args)
        `(defvar ,var ,value ,doc))))
 
+(defvar compilation-error-regexp-alist)
+(defvar compilation-mode-font-lock-keywords)
+
+(defgroup checkdoc nil
+  "Support for doc string checking in Emacs Lisp."
+  :prefix "checkdoc"
+  :group 'lisp
+  :version "20.3")
+
 (defcustom checkdoc-autofix-flag 'semiautomatic
-  "*Non-nil means attempt auto-fixing of doc strings.
+  "Non-nil means attempt auto-fixing of doc strings.
 If this value is the symbol `query', then the user is queried before
 any change is made.  If the value is `automatic', then all changes are
 made without asking unless the change is very-complex.  If the value
@@ -204,37 +214,39 @@ The value `never' is the same as nil, never ask or change anything."
                 (other :tag "semiautomatic" semiautomatic)))
 
 (defcustom checkdoc-bouncy-flag t
-  "*Non-nil means to \"bounce\" to auto-fix locations.
+  "Non-nil means to \"bounce\" to auto-fix locations.
 Setting this to nil will silently make fixes that require no user
 interaction.  See `checkdoc-autofix-flag' for auto-fixing details."
   :group 'checkdoc
   :type 'boolean)
 
 (defcustom checkdoc-force-docstrings-flag t
-  "*Non-nil means that all checkable definitions should have documentation.
+  "Non-nil means that all checkable definitions should have documentation.
 Style guide dictates that interactive functions MUST have documentation,
 and that it's good but not required practice to make non user visible items
 have doc strings."
   :group 'checkdoc
   :type 'boolean)
+(put 'checkdoc-force-docstrings-flag 'safe-local-variable 'booleanp)
 
 (defcustom checkdoc-force-history-flag t
-  "*Non-nil means that files should have a History section or ChangeLog file.
+  "Non-nil means that files should have a History section or ChangeLog file.
 This helps document the evolution of, and recent changes to, the package."
   :group 'checkdoc
   :type 'boolean)
 
 (defcustom checkdoc-permit-comma-termination-flag nil
-  "*Non-nil means the first line of a docstring may end with a comma.
+  "Non-nil means the first line of a docstring may end with a comma.
 Ordinarily, a full sentence is required.  This may be misleading when
 there is a substantial caveat to the one-line description -- the comma
 should be used when the first part could stand alone as a sentence, but
 it indicates that a modifying clause follows."
   :group 'checkdoc
   :type 'boolean)
+(put 'checkdoc-permit-comma-termination-flag 'safe-local-variable 'booleanp)
 
 (defcustom checkdoc-spellcheck-documentation-flag nil
-  "*Non-nil means run Ispell on text based on value.
+  "Non-nil means run Ispell on text based on value.
 This is automatically set to nil if Ispell does not exist on your
 system.  Possible values are:
 
@@ -255,14 +267,14 @@ system.  Possible values are:
   "List of words that are correct when spell-checking Lisp documentation.")
 
 (defcustom checkdoc-max-keyref-before-warn 10
-  "*The number of \\ [command-to-keystroke] tokens allowed in a doc string.
+  "The number of \\ [command-to-keystroke] tokens allowed in a doc string.
 Any more than this and a warning is generated suggesting that the construct
 \\ {keymap} be used instead."
   :group 'checkdoc
   :type 'integer)
 
 (defcustom checkdoc-arguments-in-order-flag t
-  "*Non-nil means warn if arguments appear out of order.
+  "Non-nil means warn if arguments appear out of order.
 Setting this to nil will mean only checking that all the arguments
 appear in the proper form in the documentation, not that they are in
 the same order as they appear in the argument list.  No mention is
@@ -294,7 +306,7 @@ problem discovered.  This is useful for adding additional checks.")
 A search leaves the cursor in front of the parameter list.")
 
 (defcustom checkdoc-verb-check-experimental-flag t
-  "*Non-nil means to attempt to check the voice of the doc string.
+  "Non-nil means to attempt to check the voice of the doc string.
 This check keys off some words which are commonly misused.  See the
 variable `checkdoc-common-verbs-wrong-voice' if you wish to add your own."
   :group 'checkdoc
@@ -317,12 +329,12 @@ This should be set in an Emacs Lisp file's local variables."
   "List of words (not capitalized) which should be capitalized.")
 
 (defvar checkdoc-proper-noun-regexp
-  (let ((expr "\\<\\(")
+  (let ((expr "\\_<\\(")
        (l checkdoc-proper-noun-list))
     (while l
       (setq expr (concat expr (car l) (if (cdr l) "\\|" ""))
            l (cdr l)))
-    (concat expr "\\)\\>"))
+    (concat expr "\\)\\_>"))
   "Regular expression derived from `checkdoc-proper-noun-regexp'.")
 
 (defvar checkdoc-common-verbs-regexp nil
@@ -430,32 +442,20 @@ be re-created.")
 
 ;;; Compatibility
 ;;
-(if (string-match "X[Ee]macs" emacs-version)
-    (progn
-      (defalias 'checkdoc-make-overlay 'make-extent)
-      (defalias 'checkdoc-overlay-put 'set-extent-property)
-      (defalias 'checkdoc-delete-overlay 'delete-extent)
-      (defalias 'checkdoc-overlay-start 'extent-start)
-      (defalias 'checkdoc-overlay-end 'extent-end)
-      (defalias 'checkdoc-mode-line-update 'redraw-modeline)
-      (defalias 'checkdoc-call-eval-buffer 'eval-buffer)
-      )
-  (defalias 'checkdoc-make-overlay 'make-overlay)
-  (defalias 'checkdoc-overlay-put 'overlay-put)
-  (defalias 'checkdoc-delete-overlay 'delete-overlay)
-  (defalias 'checkdoc-overlay-start 'overlay-start)
-  (defalias 'checkdoc-overlay-end 'overlay-end)
-  (defalias 'checkdoc-mode-line-update 'force-mode-line-update)
-  (defalias 'checkdoc-call-eval-buffer 'eval-current-buffer)
-  )
-
-;; Emacs 20s have MULE characters which don't equate to numbers.
-(if (fboundp 'char=)
-    (defalias 'checkdoc-char= 'char=)
-  (defalias 'checkdoc-char= '=))
-
-;; Read events, not characters
-(defalias 'checkdoc-read-event 'read-event)
+(defalias 'checkdoc-make-overlay
+  (if (featurep 'xemacs) 'make-extent 'make-overlay))
+(defalias 'checkdoc-overlay-put
+  (if (featurep 'xemacs) 'set-extent-property 'overlay-put))
+(defalias 'checkdoc-delete-overlay
+  (if (featurep 'xemacs) 'delete-extent 'delete-overlay))
+(defalias 'checkdoc-overlay-start
+  (if (featurep 'xemacs) 'extent-start 'overlay-start))
+(defalias 'checkdoc-overlay-end
+  (if (featurep 'xemacs) 'extent-end 'overlay-end))
+(defalias 'checkdoc-mode-line-update
+  (if (featurep 'xemacs) 'redraw-modeline 'force-mode-line-update))
+(defalias 'checkdoc-char=
+  (if (featurep 'xemacs) 'char= '=))
 
 ;;; User level commands
 ;;
@@ -628,7 +628,7 @@ style."
                (goto-char (checkdoc-error-start (car (car err-list))))
                (if (not (pos-visible-in-window-p))
                    (recenter (- (window-height) 2)))
-               (setq c (checkdoc-read-event)))
+               (setq c (read-event)))
              (if (not (integerp c)) (setq c ??))
              (cond
               ;; Exit condition
@@ -653,8 +653,7 @@ style."
                        (sit-for 2))
                    (setq err-list (cdr err-list))))
                (beginning-of-defun)
-               (let ((pe (car err-list))
-                     (ne (funcall findfunc nil)))
+               (let ((ne (funcall findfunc nil)))
                  (if ne
                      (setq err-list (cons ne err-list))
                    (cond ((not err-list)
@@ -665,7 +664,7 @@ style."
                            "No Additional style errors.  Continuing...")
                           (sit-for 2))))))
               ;; Move to the next error (if available)
-              ((or (checkdoc-char= c ?n) (checkdoc-char= c ?\ ))
+              ((or (checkdoc-char= c ?n) (checkdoc-char= c ?\s))
                (let ((ne (funcall findfunc nil)))
                  (if (not ne)
                      (if showstatus
@@ -845,7 +844,7 @@ Evaluation is done first because good documentation for something that
 doesn't work is just not useful.  Comments, doc strings, and rogue
 spacing are all verified."
   (interactive)
-  (checkdoc-call-eval-buffer nil)
+  (eval-buffer nil)
   (checkdoc-current-buffer t))
 
 ;;;###autoload
@@ -900,7 +899,7 @@ Prefix argument TAKE-NOTES means to continue through the whole buffer and
 save warnings in a separate buffer.  Second optional argument START-POINT
 is the starting location.  If this is nil, `point-min' is used instead."
   (interactive "P")
-  (let ((wrong nil) (msg nil) (errors nil)
+  (let ((wrong nil) (msg nil)
        ;; Assign a flag to spellcheck flag
        (checkdoc-spellcheck-documentation-flag
         (car (memq checkdoc-spellcheck-documentation-flag
@@ -920,7 +919,7 @@ is the starting location.  If this is nil, `point-min' is used instead."
        (progn
          (goto-char wrong)
          (if (not take-notes)
-             (error (checkdoc-error-text msg)))))
+             (error "%s" (checkdoc-error-text msg)))))
     (checkdoc-show-diagnostics)
     (if (interactive-p)
        (message "No style warnings."))))
@@ -953,7 +952,7 @@ if there is one."
         (e (checkdoc-file-comments-engine))
        (checkdoc-generate-compile-warnings-flag
         (or take-notes checkdoc-generate-compile-warnings-flag)))
-    (if e (error (checkdoc-error-text e)))
+    (if e (error "%s" (checkdoc-error-text e)))
     (checkdoc-show-diagnostics)
     e))
 
@@ -991,7 +990,7 @@ Optional argument TAKE-NOTES causes all errors to be logged."
     (if (not (interactive-p))
        e
       (if e
-         (error (checkdoc-error-text e))
+         (error "%s" (checkdoc-error-text e))
        (checkdoc-show-diagnostics)))
     (goto-char p))
   (if (interactive-p) (message "Checking interactive message text...done.")))
@@ -1034,15 +1033,15 @@ space at the end of each line."
             (msg (checkdoc-this-string-valid)))
        (if msg (if no-error
                    (message (checkdoc-error-text msg))
-                 (error (checkdoc-error-text msg)))
+                 (error "%s" (checkdoc-error-text msg)))
          (setq msg (checkdoc-message-text-search beg end))
          (if msg (if no-error
                      (message (checkdoc-error-text msg))
-                   (error (checkdoc-error-text msg)))
+                   (error "%s" (checkdoc-error-text msg)))
            (setq msg (checkdoc-rogue-space-check-engine beg end))
            (if msg (if no-error
                        (message (checkdoc-error-text msg))
-                     (error (checkdoc-error-text msg))))))
+                     (error "%s" (checkdoc-error-text msg))))))
        (if (interactive-p) (message "Checkdoc: done."))))))
 
 ;;; Ispell interface for forcing a spell check
@@ -1247,7 +1246,7 @@ generating a buffered list of errors."
 With prefix ARG, turn Checkdoc minor mode on iff ARG is positive.
 
 In Checkdoc minor mode, the usual bindings for `eval-defun' which is
-bound to \\<checkdoc-minor-mode-map> \\[checkdoc-eval-defun] and `checkdoc-eval-current-buffer' are overridden to include
+bound to \\<checkdoc-minor-mode-map>\\[checkdoc-eval-defun] and `checkdoc-eval-current-buffer' are overridden to include
 checking of documentation strings.
 
 \\{checkdoc-minor-mode-map}"
@@ -1562,8 +1561,9 @@ mouse-[0-3]\\)\\)\\>"))
      ;; to describe the most important commands in your major mode, and
      ;; then use `\\{...}' to display the rest of the mode's keymap.
      (save-excursion
-       (if (re-search-forward "\\\\\\\\\\[\\w+" e t
-                             (1+ checkdoc-max-keyref-before-warn))
+       (if (and (re-search-forward "\\\\\\\\\\[\\w+" e t
+                                  (1+ checkdoc-max-keyref-before-warn))
+               (not (re-search-forward "\\\\\\\\{\\w+}" e t)))
           (checkdoc-create-error
            "Too many occurrences of \\[function].  Use \\{keymap} instead"
            s (marker-position e))))
@@ -1593,7 +1593,7 @@ mouse-[0-3]\\)\\)\\>"))
                     ;; a prefix.
                     (let ((disambiguate
                            (completing-read
-                            "Disambiguating Keyword (default: variable): "
+                            "Disambiguating Keyword (default variable): "
                             '(("function") ("command") ("variable")
                               ("option") ("symbol"))
                             nil t nil nil "variable")))
@@ -2261,7 +2261,8 @@ Code:, and others referenced in the style guide."
                    (re-search-forward "^;;; Code" nil t)
                    (re-search-forward "^(require" nil t)
                    (re-search-forward "^(" nil t))
-               (beginning-of-line)))
+               (beginning-of-line))
+              (t (re-search-forward ";;; .* --- .*\n")))
              (if (checkdoc-y-or-n-p
                   "You should have a \";;; Commentary:\", add one? ")
                  (insert "\n;;; Commentary:\n;; \n\n")
@@ -2326,10 +2327,10 @@ Code:, and others referenced in the style guide."
        (save-excursion
          (goto-char (point-max))
          (if (not (re-search-backward
-                   (concat "^;;;[ \t]+" fn "\\(" (regexp-quote fe)
+                   (concat "^;;;[ \t]+" (regexp-quote fn) "\\(" (regexp-quote fe)
                            "\\)?[ \t]+ends here[ \t]*$"
                            "\\|^;;;[ \t]+ End of file[ \t]+"
-                           fn "\\(" (regexp-quote fe) "\\)?")
+                           (regexp-quote fn) "\\(" (regexp-quote fe) "\\)?")
                    nil t))
              (if (checkdoc-y-or-n-p "No identifiable footer!  Add one? ")
                  (progn
@@ -2580,92 +2581,52 @@ This function will not modify `match-data'."
 ;;; Warning management
 ;;
 (defvar checkdoc-output-font-lock-keywords
-  '(("\\(\\w+\\.el\\): \\(\\w+\\)"
+  '(("^\\*\\*\\* \\(.+\\.el\\): \\([^ \n]+\\)"
      (1 font-lock-function-name-face)
-     (2 font-lock-comment-face))
-    ("^\\(\\w+\\.el\\):" 1 font-lock-function-name-face)
-    (":\\([0-9]+\\):" 1 font-lock-constant-face))
+     (2 font-lock-comment-face)))
   "Keywords used to highlight a checkdoc diagnostic buffer.")
 
-(defvar checkdoc-output-mode-map nil
-  "Keymap used in `checkdoc-output-mode'.")
+(defvar checkdoc-output-error-regex-alist
+  '(("^\\(.+\\.el\\):\\([0-9]+\\): " 1 2)))
 
 (defvar checkdoc-pending-errors nil
   "Non-nil when there are errors that have not been displayed yet.")
 
-(if checkdoc-output-mode-map
-    nil
-  (setq checkdoc-output-mode-map (make-sparse-keymap))
-  (if (not (string-match "XEmacs" emacs-version))
-      (define-key checkdoc-output-mode-map [mouse-2]
-       'checkdoc-find-error-mouse))
-  (define-key checkdoc-output-mode-map "\C-c\C-c" 'checkdoc-find-error)
-  (define-key checkdoc-output-mode-map "\C-m" 'checkdoc-find-error))
-
-(defun checkdoc-output-mode ()
-  "Create and setup the buffer used to maintain checkdoc warnings.
-\\<checkdoc-output-mode-map>\\[checkdoc-find-error]  - Go to this error location
-\\[checkdoc-find-error-mouse] - Goto the error clicked on."
-  (if (get-buffer checkdoc-diagnostic-buffer)
-      (get-buffer checkdoc-diagnostic-buffer)
-    (save-excursion
-      (set-buffer (get-buffer-create checkdoc-diagnostic-buffer))
-      (kill-all-local-variables)
-      (setq mode-name "Checkdoc"
-           major-mode 'checkdoc-output-mode)
-      (set (make-local-variable 'font-lock-defaults)
-          '((checkdoc-output-font-lock-keywords) t t ((?- . "w") (?_ . "w"))))
-      (use-local-map checkdoc-output-mode-map)
-      (run-hooks 'checkdoc-output-mode-hook)
-      (current-buffer))))
-
-(defun checkdoc-find-error-mouse (e)
-  ;; checkdoc-params: (e)
-  "Call `checkdoc-find-error' where the user clicks the mouse."
-  (interactive "e")
-  (mouse-set-point e)
-  (checkdoc-find-error))
-
-(defun checkdoc-find-error ()
-  "In a checkdoc diagnostic buffer, find the error under point."
-  (interactive)
-  (beginning-of-line)
-  (if (looking-at "\\(\\(\\w+\\|\\s_\\)+\\.el\\):\\([0-9]+\\):")
-      (let ((l (string-to-int (match-string 3)))
-           (f (match-string 1)))
-       (if (not (get-file-buffer f))
-           (error "Can't find buffer %s" f))
-       (switch-to-buffer-other-window (get-file-buffer f))
-       (goto-line l))))
+(define-derived-mode checkdoc-output-mode compilation-mode "Checkdoc"
+  "Set up the major mode for the buffer containing the list of errors."
+  (set (make-local-variable 'compilation-error-regexp-alist)
+       checkdoc-output-error-regex-alist)
+  (set (make-local-variable 'compilation-mode-font-lock-keywords)
+       checkdoc-output-font-lock-keywords))
 
 (defun checkdoc-buffer-label ()
   "The name to use for a checkdoc buffer in the error list."
   (if (buffer-file-name)
-      (file-name-nondirectory (buffer-file-name))
+      (file-relative-name (buffer-file-name))
     (concat "#<buffer "(buffer-name) ">")))
 
 (defun checkdoc-start-section (check-type)
   "Initialize the checkdoc diagnostic buffer for a pass.
 Create the header so that the string CHECK-TYPE is displayed as the
 function called to create the messages."
-  (checkdoc-output-to-error-buffer
-   "\n\n\C-l\n*** "
-   (checkdoc-buffer-label) ": " check-type " V " checkdoc-version))
+  (let ((dir default-directory)
+       (label (checkdoc-buffer-label)))
+    (with-current-buffer (get-buffer-create checkdoc-diagnostic-buffer)
+      (checkdoc-output-mode)
+      (setq default-directory dir)
+      (goto-char (point-max))
+      (insert "\n\n\C-l\n*** " label ": " check-type " V " checkdoc-version))))
 
 (defun checkdoc-error (point msg)
   "Store POINT and MSG as errors in the checkdoc diagnostic buffer."
   (setq checkdoc-pending-errors t)
-  (checkdoc-output-to-error-buffer
-   "\n" (checkdoc-buffer-label) ":"
-   (int-to-string (count-lines (point-min) (or point 1))) ": "
-   msg))
-
-(defun checkdoc-output-to-error-buffer (&rest text)
-  "Place TEXT into the checkdoc diagnostic buffer."
-  (save-excursion
-    (set-buffer (checkdoc-output-mode))
-    (goto-char (point-max))
-    (apply 'insert text)))
+  (let ((text (list "\n" (checkdoc-buffer-label) ":"
+                   (int-to-string
+                    (count-lines (point-min) (or point (point-min))))
+                   ": " msg)))
+    (with-current-buffer (get-buffer checkdoc-diagnostic-buffer)
+      (goto-char (point-max))
+      (apply 'insert text))))
 
 (defun checkdoc-show-diagnostics ()
   "Display the checkdoc diagnostic buffer in a temporary window."
@@ -2681,20 +2642,16 @@ function called to create the messages."
        (setq checkdoc-pending-errors nil)
        nil)))
 
-(defgroup checkdoc nil
-  "Support for doc string checking in Emacs Lisp."
-  :prefix "checkdoc"
-  :group 'lisp
-  :version "20.3")
-
 (custom-add-option 'emacs-lisp-mode-hook
                   (lambda () (checkdoc-minor-mode 1)))
 
 (add-to-list 'debug-ignored-errors
             "Argument `.*' should appear (as .*) in the doc string")
+(add-to-list 'debug-ignored-errors
+            "Lisp symbol `.*' should appear in quotes")
 (add-to-list 'debug-ignored-errors "Disambiguate .* by preceding .*")
 
 (provide 'checkdoc)
 
-;;; arch-tag: c49a7ec8-3bb7-46f2-bfbc-d5f26e033b26
+;; arch-tag: c49a7ec8-3bb7-46f2-bfbc-d5f26e033b26
 ;;; checkdoc.el ends here