]> code.delx.au - gnu-emacs/blobdiff - lisp/emacs-lisp/checkdoc.el
Merge changes from emacs-23 branch
[gnu-emacs] / lisp / emacs-lisp / checkdoc.el
index 70360eb77cfcdaf6a53cbe6e4d38502ec81ad6dc..9880e2918b0e0814cd49d0c2dae4a49b8abb0b1d 100644 (file)
@@ -1,7 +1,6 @@
 ;;; checkdoc.el --- check documentation strings for style requirements
 
-;; Copyright (C) 1997, 1998, 2001, 2002, 2003, 2004,
-;;   2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1998, 2001-2011  Free Software Foundation, Inc.
 
 ;; Author: Eric M. Ludlam <zappo@gnu.org>
 ;; Version: 0.6.2
@@ -201,9 +200,9 @@ without asking, and complex changes are made by asking the user first.
 The value `never' is the same as nil, never ask or change anything."
   :group 'checkdoc
   :type '(choice (const automatic)
-                (const query)
-                (const never)
-                (other :tag "semiautomatic" semiautomatic)))
+          (const query)
+          (const never)
+          (other :tag "semiautomatic" semiautomatic)))
 
 (defcustom checkdoc-bouncy-flag t
   "Non-nil means to \"bounce\" to auto-fix locations.
@@ -250,10 +249,10 @@ system.  Possible values are:
   t           - Always spell-check"
   :group 'checkdoc
   :type '(choice (const nil)
-                (const defun)
-                (const buffer)
-                (const interactive)
-                (const t)))
+          (const defun)
+          (const buffer)
+          (const interactive)
+          (const t)))
 
 (defvar checkdoc-ispell-lisp-words
   '("alist" "emacs" "etags" "keymap" "paren" "regexp" "sexp" "xemacs")
@@ -429,19 +428,15 @@ and experimental check.  Do not modify this list without setting
 the value of `checkdoc-common-verbs-regexp' to nil which cause it to
 be re-created.")
 
-(defvar checkdoc-syntax-table nil
+(defvar checkdoc-syntax-table
+  (let ((st (make-syntax-table emacs-lisp-mode-syntax-table)))
+    ;; When dealing with syntax in doc strings, make sure that - are
+    ;; encompassed in words so we can use cheap \\> to get the end of a symbol,
+    ;; not the end of a word in a conglomerate.
+    (modify-syntax-entry ?- "w" st)
+    st)
   "Syntax table used by checkdoc in document strings.")
 
-(if checkdoc-syntax-table
-    nil
-  (setq checkdoc-syntax-table (copy-syntax-table emacs-lisp-mode-syntax-table))
-  ;; When dealing with syntax in doc strings, make sure that - are encompassed
-  ;; in words so we can use cheap \\> to get the end of a symbol, not the
-  ;; end of a word in a conglomerate.
-  (modify-syntax-entry ?- "w" checkdoc-syntax-table)
-  )
-
-
 ;;; Compatibility
 ;;
 (defalias 'checkdoc-make-overlay
@@ -515,12 +510,11 @@ CHECK is a list of four strings stating the current status of each
 test; the nth string describes the status of the nth test."
   (let (temp-buffer-setup-hook)
     (with-output-to-temp-buffer "*Checkdoc Status*"
-      (princ-list
-       "Buffer comments and tags:  " (nth 0 check) "\n"
-       "Documentation style:       " (nth 1 check) "\n"
-       "Message/Query text style:  " (nth 2 check) "\n"
-       "Unwanted Spaces:           " (nth 3 check)
-       )))
+      (mapc #'princ
+            (list "Buffer comments and tags:  " (nth 0 check)
+                  "\nDocumentation style:       " (nth 1 check)
+                  "\nMessage/Query text style:  " (nth 2 check)
+                  "\nUnwanted Spaces:           " (nth 3 check)))))
   (shrink-window-if-larger-than-buffer
    (get-buffer-window "*Checkdoc Status*"))
   (message nil)
@@ -623,7 +617,7 @@ style."
                      (recenter (/ (- (window-height) l) 2))))
                (recenter))
              (message "%s (C-h,%se,n,p,q)" (checkdoc-error-text
-                                             (car (car err-list)))
+                                             (car (car err-list)))
                       (if (checkdoc-error-unfixable (car (car err-list)))
                           "" "f,"))
              (save-excursion
@@ -713,20 +707,21 @@ style."
                      (delete-window (get-buffer-window "*Checkdoc Help*"))
                      (kill-buffer "*Checkdoc Help*"))
                  (with-output-to-temp-buffer "*Checkdoc Help*"
-                   (princ-list
-                    "Checkdoc Keyboard Summary:\n"
-                    (if (checkdoc-error-unfixable (car (car err-list)))
-                        ""
-                      (concat
-                       "f, y    - auto Fix this warning without asking (if\
+                    (with-current-buffer standard-output
+                      (insert
+                       "Checkdoc Keyboard Summary:\n"
+                       (if (checkdoc-error-unfixable (car (car err-list)))
+                           ""
+                         (concat
+                          "f, y    - auto Fix this warning without asking (if\
  available.)\n"
-                       "         Very complex operations will still query.\n")
-                      )
-                    "e      - Enter recursive Edit.  Press C-M-c to exit.\n"
-                    "SPC, n - skip to the Next error.\n"
-                    "DEL, p - skip to the Previous error.\n"
-                    "q      - Quit checkdoc.\n"
-                    "C-h    - Toggle this help buffer."))
+                          "         Very complex operations will still query.\n")
+                         )
+                       "e      - Enter recursive Edit.  Press C-M-c to exit.\n"
+                       "SPC, n - skip to the Next error.\n"
+                       "DEL, p - skip to the Previous error.\n"
+                       "q      - Quit checkdoc.\n"
+                       "C-h    - Toggle this help buffer.")))
                  (shrink-window-if-larger-than-buffer
                   (get-buffer-window "*Checkdoc Help*"))))))
          (if cdo (checkdoc-delete-overlay cdo)))))
@@ -826,9 +821,9 @@ assumes that the cursor is already positioned to perform the fix."
   "Enter recursive edit to permit a user to fix some error checkdoc has found.
 MSG is the error that was found, which is displayed in a help buffer."
   (with-output-to-temp-buffer "*Checkdoc Help*"
-    (princ-list
-     "Error message:\n  " msg
-     "\n\nEdit to fix this problem, and press C-M-c to continue."))
+    (mapc #'princ
+          (list "Error message:\n  " msg
+                "\n\nEdit to fix this problem, and press C-M-c to continue.")))
   (shrink-window-if-larger-than-buffer
    (get-buffer-window "*Checkdoc Help*"))
   (message "When you're done editing press C-M-c to continue.")
@@ -947,14 +942,14 @@ if there is one."
   (interactive "P")
   (if take-notes (checkdoc-start-section "checkdoc-comments"))
   (if (not buffer-file-name)
-     (error "Can only check comments for a file buffer"))
+      (error "Can only check comments for a file buffer"))
   (let* ((checkdoc-spellcheck-documentation-flag
          (car (memq checkdoc-spellcheck-documentation-flag
                      '(buffer t))))
         (checkdoc-autofix-flag (if take-notes 'never checkdoc-autofix-flag))
         (e (checkdoc-file-comments-engine))
-       (checkdoc-generate-compile-warnings-flag
-        (or take-notes checkdoc-generate-compile-warnings-flag)))
+         (checkdoc-generate-compile-warnings-flag
+          (or take-notes checkdoc-generate-compile-warnings-flag)))
     (if e (error "%s" (checkdoc-error-text e)))
     (checkdoc-show-diagnostics)
     e))
@@ -970,8 +965,8 @@ Optional argument INTERACT permits more interactive fixing."
   (if take-notes (checkdoc-start-section "checkdoc-rogue-spaces"))
   (let* ((checkdoc-autofix-flag (if take-notes 'never checkdoc-autofix-flag))
         (e (checkdoc-rogue-space-check-engine nil nil interact))
-       (checkdoc-generate-compile-warnings-flag
-        (or take-notes checkdoc-generate-compile-warnings-flag)))
+         (checkdoc-generate-compile-warnings-flag
+          (or take-notes checkdoc-generate-compile-warnings-flag)))
     (if (not (called-interactively-p 'interactive))
        e
       (if e
@@ -1207,40 +1202,37 @@ generating a buffered list of errors."
     map)
   "Keymap used to override evaluation key-bindings for documentation checking.")
 
-(define-obsolete-variable-alias 'checkdoc-minor-keymap
-    'checkdoc-minor-mode-map "21.1")
-
 ;; Add in a menubar with easy-menu
 
 (easy-menu-define
- nil checkdoc-minor-mode-map "Checkdoc Minor Mode Menu"
- '("CheckDoc"
-   ["Interactive Buffer Style Check" checkdoc t]
-   ["Interactive Buffer Style and Spelling Check" checkdoc-ispell t]
-   ["Check Buffer" checkdoc-current-buffer t]
-   ["Check and Spell Buffer" checkdoc-ispell-current-buffer t]
-   "---"
-   ["Interactive Style Check" checkdoc-interactive t]
-   ["Interactive Style and Spelling Check" checkdoc-ispell-interactive t]
-   ["Find First Style Error" checkdoc-start t]
-   ["Find First Style or Spelling  Error" checkdoc-ispell-start t]
-   ["Next Style Error" checkdoc-continue t]
-   ["Next Style or Spelling  Error" checkdoc-ispell-continue t]
-   ["Interactive Message Text Style Check" checkdoc-message-interactive t]
-   ["Interactive Message Text Style and Spelling Check"
-    checkdoc-ispell-message-interactive t]
-   ["Check Message Text" checkdoc-message-text t]
-   ["Check and Spell Message Text" checkdoc-ispell-message-text t]
-   ["Check Comment Style" checkdoc-comments buffer-file-name]
-   ["Check Comment Style and Spelling" checkdoc-ispell-comments
-    buffer-file-name]
-   ["Check for Rogue Spaces" checkdoc-rogue-spaces t]
-   "---"
-   ["Check Defun" checkdoc-defun t]
-   ["Check and Spell Defun" checkdoc-ispell-defun t]
-   ["Check and Evaluate Defun" checkdoc-eval-defun t]
-   ["Check and Evaluate Buffer" checkdoc-eval-current-buffer t]
-   ))
 nil checkdoc-minor-mode-map "Checkdoc Minor Mode Menu"
 '("CheckDoc"
+    ["Interactive Buffer Style Check" checkdoc t]
+    ["Interactive Buffer Style and Spelling Check" checkdoc-ispell t]
+    ["Check Buffer" checkdoc-current-buffer t]
+    ["Check and Spell Buffer" checkdoc-ispell-current-buffer t]
+    "---"
+    ["Interactive Style Check" checkdoc-interactive t]
+    ["Interactive Style and Spelling Check" checkdoc-ispell-interactive t]
+    ["Find First Style Error" checkdoc-start t]
+    ["Find First Style or Spelling  Error" checkdoc-ispell-start t]
+    ["Next Style Error" checkdoc-continue t]
+    ["Next Style or Spelling  Error" checkdoc-ispell-continue t]
+    ["Interactive Message Text Style Check" checkdoc-message-interactive t]
+    ["Interactive Message Text Style and Spelling Check"
+     checkdoc-ispell-message-interactive t]
+    ["Check Message Text" checkdoc-message-text t]
+    ["Check and Spell Message Text" checkdoc-ispell-message-text t]
+    ["Check Comment Style" checkdoc-comments buffer-file-name]
+    ["Check Comment Style and Spelling" checkdoc-ispell-comments
+     buffer-file-name]
+    ["Check for Rogue Spaces" checkdoc-rogue-spaces t]
+    "---"
+    ["Check Defun" checkdoc-defun t]
+    ["Check and Spell Defun" checkdoc-ispell-defun t]
+    ["Check and Evaluate Defun" checkdoc-eval-defun t]
+    ["Check and Evaluate Buffer" checkdoc-eval-current-buffer t]
+    ))
 ;; XEmacs requires some weird stuff to add this menu in a minor mode.
 ;; What is it?
 
@@ -1369,7 +1361,7 @@ See the style guide in the Emacs Lisp manual for more details."
                           (setq checkdoc-autofix-flag 'never))))
                 (checkdoc-create-error
                  "You should convert this comment to documentation"
-                 (point) (save-excursion (end-of-line) (point))))
+                 (point) (line-end-position)))
             (checkdoc-create-error
              (if (nth 2 fp)
                  "All interactive functions should have documentation"
@@ -1377,12 +1369,8 @@ See the style guide in the Emacs Lisp manual for more details."
 documentation string")
              (point) (+ (point) 1) t)))))
     (if (and (not err) (looking-at "\""))
-       (let ((old-syntax-table (syntax-table)))
-         (unwind-protect
-             (progn
-               (set-syntax-table checkdoc-syntax-table)
-               (checkdoc-this-string-valid-engine fp))
-           (set-syntax-table old-syntax-table)))
+        (with-syntax-table checkdoc-syntax-table
+          (checkdoc-this-string-valid-engine fp))
       err)))
 
 (defun checkdoc-this-string-valid-engine (fp)
@@ -1391,7 +1379,7 @@ Depends on `checkdoc-this-string-valid' to reset the syntax table so that
 regexp short cuts work.  FP is the function defun information."
   (let ((case-fold-search nil)
        ;; Use a marker so if an early check modifies the text,
-       ;; we won't accidentally loose our place.  This could cause
+       ;; we won't accidentally lose our place.  This could cause
        ;; end-of doc string whitespace to also delete the " char.
        (s (point))
        (e (if (looking-at "\"")
@@ -1489,12 +1477,10 @@ regexp short cuts work.  FP is the function defun information."
                    "First line not a complete sentence.  Add RET here? "
                    "\n" t)
                   (let (l1 l2)
-                    (forward-line 1)
-                    (end-of-line)
+                    (end-of-line 2)
                     (setq l1 (current-column)
                           l2 (save-excursion
-                               (forward-line 1)
-                               (end-of-line)
+                               (end-of-line 2)
                                (current-column)))
                     (if (> (+ l1 l2 1) 80)
                         (setq msg "Incomplete auto-fix; doc string \
@@ -1511,10 +1497,7 @@ may require more formatting")
               (forward-line 1)
               (beginning-of-line)
               (if (and (re-search-forward "[.!?:\"]\\([ \t\n]+\\|\"\\)"
-                                          (save-excursion
-                                            (end-of-line)
-                                            (point))
-                                          t)
+                                          (line-end-position) t)
                        (< (current-column) numc))
                   (if (checkdoc-autofix-ask-replace
                        p (1+ p)
@@ -1529,9 +1512,7 @@ may require more formatting")
           (if msg
               (checkdoc-create-error msg s (save-excursion
                                              (goto-char s)
-                                             (end-of-line)
-                                             (point)))
-            nil) ))))
+                                             (line-end-position))))))))
      ;; Continuation of above.  Make sure our sentence is capitalized.
      (save-excursion
        (skip-chars-forward "\"\\*")
@@ -1631,7 +1612,7 @@ function,command,variable,option or symbol." ms1))))))
         (if (and (< (point) e) (> (current-column) 80))
             (checkdoc-create-error
              "Some lines are over 80 columns wide"
-             s (save-excursion (goto-char s) (end-of-line) (point)) ))))
+             s (save-excursion (goto-char s) (line-end-position))))))
      ;; Here we deviate to tests based on a variable or function.
      ;; We must do this before checking for symbols in quotes because there
      ;; is a chance that just such a symbol might really be an argument.
@@ -1776,9 +1757,8 @@ function,command,variable,option or symbol." ms1))))))
                                 (end-of-line)
                                 ;; check string-continuation
                                 (if (checkdoc-char= (preceding-char) ?\\)
-                                    (progn (forward-line 1)
-                                           (end-of-line)))
-                                (point)))
+                                    (line-end-position 2)
+                                  (point))))
                          (rs nil) replace original (case-fold-search t))
                      (while (and (not rs)
                                  (re-search-forward
@@ -2004,49 +1984,45 @@ internally skip over no answers.
 If the offending word is in a piece of quoted text, then it is skipped."
   (save-excursion
     (let ((case-fold-search nil)
-         (errtxt nil) bb be
-         (old-syntax-table (syntax-table)))
-      (unwind-protect
-         (progn
-           (set-syntax-table checkdoc-syntax-table)
-           (goto-char begin)
-           (while (re-search-forward checkdoc-proper-noun-regexp end t)
-             (let ((text (match-string 1))
-                   (b (match-beginning 1))
-                   (e (match-end 1)))
-               (if (and (not (save-excursion
-                               (goto-char b)
-                               (forward-char -1)
-                               (looking-at "`\\|\"\\|\\.\\|\\\\")))
-                        ;; surrounded by /, as in a URL or filename: /emacs/
-                        (not (and (= ?/ (char-after e))
-                                  (= ?/ (char-before b))))
-                        (not (checkdoc-in-example-string-p begin end))
-                        ;; info or url links left alone
-                        (not (thing-at-point-looking-at
-                              help-xref-info-regexp))
-                        (not (thing-at-point-looking-at
-                              help-xref-url-regexp)))
-                   (if (checkdoc-autofix-ask-replace
-                        b e (format "Text %s should be capitalized.  Fix? "
-                                    text)
-                        (capitalize text) t)
-                       nil
-                     (if errtxt
-                         ;; If there is already an error, then generate
-                         ;; the warning output if applicable
-                         (if checkdoc-generate-compile-warnings-flag
-                             (checkdoc-create-error
-                              (format
-                               "Name %s should appear capitalized as %s"
-                               text (capitalize text))
-                              b e))
-                       (setq errtxt
-                             (format
-                              "Name %s should appear capitalized as %s"
-                              text (capitalize text))
-                             bb b be e)))))))
-       (set-syntax-table old-syntax-table))
+         (errtxt nil) bb be)
+      (with-syntax-table checkdoc-syntax-table
+        (goto-char begin)
+        (while (re-search-forward checkdoc-proper-noun-regexp end t)
+          (let ((text (match-string 1))
+                (b (match-beginning 1))
+                (e (match-end 1)))
+            (if (and (not (save-excursion
+                            (goto-char b)
+                            (forward-char -1)
+                            (looking-at "`\\|\"\\|\\.\\|\\\\")))
+                     ;; surrounded by /, as in a URL or filename: /emacs/
+                     (not (and (= ?/ (char-after e))
+                               (= ?/ (char-before b))))
+                     (not (checkdoc-in-example-string-p begin end))
+                     ;; info or url links left alone
+                     (not (thing-at-point-looking-at
+                           help-xref-info-regexp))
+                     (not (thing-at-point-looking-at
+                           help-xref-url-regexp)))
+                (if (checkdoc-autofix-ask-replace
+                     b e (format "Text %s should be capitalized.  Fix? "
+                                 text)
+                     (capitalize text) t)
+                    nil
+                  (if errtxt
+                      ;; If there is already an error, then generate
+                      ;; the warning output if applicable
+                      (if checkdoc-generate-compile-warnings-flag
+                          (checkdoc-create-error
+                           (format
+                            "Name %s should appear capitalized as %s"
+                            text (capitalize text))
+                           b e))
+                    (setq errtxt
+                          (format
+                           "Name %s should appear capitalized as %s"
+                           text (capitalize text))
+                          bb b be e)))))))
       (if errtxt (checkdoc-create-error errtxt bb be)))))
 
 (defun checkdoc-sentencespace-region-engine (begin end)
@@ -2054,43 +2030,39 @@ If the offending word is in a piece of quoted text, then it is skipped."
   (if sentence-end-double-space
       (save-excursion
        (let ((case-fold-search nil)
-             (errtxt nil) bb be
-             (old-syntax-table (syntax-table)))
-         (unwind-protect
-             (progn
-               (set-syntax-table checkdoc-syntax-table)
-               (goto-char begin)
-               (while (re-search-forward "[^ .0-9]\\(\\. \\)[^ \n]" end t)
-                 (let ((b (match-beginning 1))
-                       (e (match-end 1)))
-                   (unless (or (checkdoc-in-sample-code-p begin end)
-                               (checkdoc-in-example-string-p begin end)
-                               (save-excursion
-                                 (goto-char b)
-                                 (condition-case nil
-                                     (progn
-                                       (forward-sexp -1)
-                                       ;; piece of an abbreviation
-                                       ;; FIXME etc
-                                       (looking-at
-                                        "\\([a-z]\\|[iI]\\.?e\\|[eE]\\.?g\\)\\."))
-                                   (error t))))
-                     (if (checkdoc-autofix-ask-replace
-                          b e
-                          "There should be two spaces after a period.  Fix? "
-                          ".  ")
-                         nil
-                       (if errtxt
-                           ;; If there is already an error, then generate
-                           ;; the warning output if applicable
-                           (if checkdoc-generate-compile-warnings-flag
-                               (checkdoc-create-error
-                                "There should be two spaces after a period"
-                                b e))
-                         (setq errtxt
-                               "There should be two spaces after a period"
-                               bb b be e)))))))
-           (set-syntax-table old-syntax-table))
+             (errtxt nil) bb be)
+         (with-syntax-table checkdoc-syntax-table
+            (goto-char begin)
+            (while (re-search-forward "[^ .0-9]\\(\\. \\)[^ \n]" end t)
+              (let ((b (match-beginning 1))
+                    (e (match-end 1)))
+                (unless (or (checkdoc-in-sample-code-p begin end)
+                            (checkdoc-in-example-string-p begin end)
+                            (save-excursion
+                              (goto-char b)
+                              (condition-case nil
+                                  (progn
+                                    (forward-sexp -1)
+                                    ;; piece of an abbreviation
+                                    ;; FIXME etc
+                                    (looking-at
+                                     "\\([a-z]\\|[iI]\\.?e\\|[eE]\\.?g\\)\\."))
+                                (error t))))
+                  (if (checkdoc-autofix-ask-replace
+                       b e
+                       "There should be two spaces after a period.  Fix? "
+                       ".  ")
+                      nil
+                    (if errtxt
+                        ;; If there is already an error, then generate
+                        ;; the warning output if applicable
+                        (if checkdoc-generate-compile-warnings-flag
+                            (checkdoc-create-error
+                             "There should be two spaces after a period"
+                             b e))
+                      (setq errtxt
+                            "There should be two spaces after a period"
+                            bb b be e)))))))
          (if errtxt (checkdoc-create-error errtxt bb be))))))
 
 ;;; Ispell engine
@@ -2258,8 +2230,8 @@ Code:, and others referenced in the style guide."
                 (insert ";;; " fn fe " --- " (read-string "Summary: ") "\n"))
             (checkdoc-create-error
              "The first line should be of the form: \";;; package --- Summary\""
-             (point-min) (save-excursion (goto-char (point-min)) (end-of-line)
-                                         (point))))
+             (point-min) (save-excursion (goto-char (point-min))
+                                         (line-end-position))))
         nil))
       (setq
        err
@@ -2670,8 +2642,7 @@ function called to create the messages."
        (setq checkdoc-pending-errors nil)
        nil)))
 
-(custom-add-option 'emacs-lisp-mode-hook
-                  (lambda () (checkdoc-minor-mode 1)))
+(custom-add-option 'emacs-lisp-mode-hook 'checkdoc-minor-mode)
 
 (add-to-list 'debug-ignored-errors
             "Argument `.*' should appear (as .*) in the doc string")
@@ -2681,5 +2652,4 @@ function called to create the messages."
 
 (provide 'checkdoc)
 
-;; arch-tag: c49a7ec8-3bb7-46f2-bfbc-d5f26e033b26
 ;;; checkdoc.el ends here