]> code.delx.au - gnu-emacs/blobdiff - lisp/emacs-lisp/checkdoc.el
Update copyright year to 2016
[gnu-emacs] / lisp / emacs-lisp / checkdoc.el
index 4761ac5e6fc0879f59d46b700237f8ae2067a73b..ecf6f8203a21f3920ae2b5eeb3da822fc0aae60e 100644 (file)
@@ -1,6 +1,6 @@
-;;; checkdoc.el --- check documentation strings for style requirements
+;;; checkdoc.el --- check documentation strings for style requirements  -*- lexical-binding:t -*-
 
-;; Copyright (C) 1997-1998, 2001-2015 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1998, 2001-2016 Free Software Foundation, Inc.
 
 ;; Author: Eric M. Ludlam <zappo@gnu.org>
 ;; Version: 0.6.2
@@ -267,6 +267,12 @@ made in the style guide relating to order."
   :type 'boolean)
 ;;;###autoload(put 'checkdoc-arguments-in-order-flag 'safe-local-variable #'booleanp)
 
+(defcustom checkdoc-package-keywords-flag nil
+  "Non-nil means warn if this file's package keywords are not recognized.
+Currently, all recognized keywords must be on `finder-known-keywords'."
+  :version "25.1"
+  :type 'boolean)
+
 (define-obsolete-variable-alias 'checkdoc-style-hooks
   'checkdoc-style-functions "24.3")
 (defvar checkdoc-style-functions nil
@@ -315,6 +321,7 @@ This should be set in an Emacs Lisp file's local variables."
 
 ;;;###autoload
 (defun checkdoc-list-of-strings-p (obj)
+  "Return t when OBJ is a list of strings."
   ;; this is a function so it might be shared by checkdoc-proper-noun-list
   ;; and/or checkdoc-ispell-lisp-words in the future
   (and (listp obj)
@@ -741,7 +748,7 @@ buffer, otherwise searching starts at START-HERE."
       ;; Loop over docstrings.
       (while (checkdoc-next-docstring)
         (message "Searching for doc string spell error...%d%%"
-                 (/ (* 100 (point)) (point-max)))
+                 (floor (* 100.0 (point)) (point-max)))
         (if (looking-at "\"")
             (checkdoc-ispell-docstring-engine
              (save-excursion (forward-sexp 1) (point-marker)))))
@@ -761,7 +768,7 @@ buffer, otherwise searching starts at START-HERE."
       ;; Loop over message strings.
       (while (checkdoc-message-text-next-string (point-max))
         (message "Searching for message string spell error...%d%%"
-                 (/ (* 100 (point)) (point-max)))
+                 (floor (* 100.0 (point)) (point-max)))
         (if (looking-at "\"")
             (checkdoc-ispell-docstring-engine
              (save-excursion (forward-sexp 1) (point-marker)))))
@@ -785,7 +792,7 @@ perform the fix."
       (condition-case nil
          (while (and (not msg) (checkdoc-next-docstring))
            (message "Searching for doc string error...%d%%"
-                    (/ (* 100 (point)) (point-max)))
+                    (floor (* 100.0 (point)) (point-max)))
            (if (setq msg (checkdoc-this-string-valid))
                (setq msg (cons msg (point)))))
        ;; Quit.. restore position,  Other errors, leave alone
@@ -807,7 +814,7 @@ assumes that the cursor is already positioned to perform the fix."
                      (setq type
                            (checkdoc-message-text-next-string (point-max))))
            (message "Searching for message string error...%d%%"
-                    (/ (* 100 (point)) (point-max)))
+                    (floor (* 100.0 (point)) (point-max)))
            (if (setq msg (checkdoc-message-text-engine type))
                (setq msg (cons msg (point)))))
        ;; Quit.. restore position,  Other errors, leave alone
@@ -866,10 +873,19 @@ otherwise stop after the first error."
        (checkdoc-start)
        (checkdoc-message-text)
        (checkdoc-rogue-spaces)
+        (when checkdoc-package-keywords-flag
+          (checkdoc-package-keywords))
        (not (called-interactively-p 'interactive))
        (if take-notes (checkdoc-show-diagnostics))
        (message "Checking buffer for style...Done."))))
 
+;;;###autoload
+(defun checkdoc-file (file)
+  "Check FILE for document, comment, error style, and rogue spaces."
+  (with-current-buffer (find-file-noselect file)
+    (let ((checkdoc-diagnostic-buffer "*warn*"))
+      (checkdoc-current-buffer t))))
+
 ;;;###autoload
 (defun checkdoc-start (&optional take-notes)
   "Start scanning the current buffer for documentation string style errors.
@@ -1404,7 +1420,7 @@ regexp short cuts work.  FP is the function defun information."
        (when (re-search-forward "^(" e t)
         (if (checkdoc-autofix-ask-replace (match-beginning 0)
                                           (match-end 0)
-                                          "Escape this '('? "
+                                          (format-message "Escape this `('? ")
                                           "\\(")
             nil
           (checkdoc-create-error
@@ -1699,7 +1715,7 @@ function,command,variable,option or symbol." ms1))))))
                                e t))
                             (if (checkdoc-autofix-ask-replace
                                  (match-beginning 1) (match-end 1)
-                                 (format
+                                 (format-message
                                   "If this is the argument `%s', it should appear as %s.  Fix? "
                                   (car args) (upcase (car args)))
                                  (upcase (car args)) t)
@@ -1725,7 +1741,7 @@ function,command,variable,option or symbol." ms1))))))
                             (insert "."))
                         nil)
                     (checkdoc-create-error
-                     (format
+                     (format-message
                       "Argument `%s' should appear (as %s) in the doc string"
                       (car args) (upcase (car args)))
                      s (marker-position e)))
@@ -1809,16 +1825,16 @@ Replace with \"%s\"? " original replace)
                    (setq found (intern-soft ms))
                    (or (boundp found) (fboundp found)))
               (progn
-                (setq msg (format "Add quotes around Lisp symbol `%s'? "
-                                  ms))
+                (setq msg (format-message
+                            "Add quotes around Lisp symbol `%s'? " ms))
                 (if (checkdoc-autofix-ask-replace
                      (match-beginning 1) (+ (match-beginning 1)
                                             (length ms))
-                     msg (concat "‘" ms "’") t)
+                     msg (format-message "`%s'" ms) t)
                     (setq msg nil)
                   (setq msg
-                        (format "Lisp symbol `%s' should appear in quotes"
-                                ms))))))
+                        (format-message
+                          "Lisp symbol `%s' should appear in quotes" ms))))))
         (if msg
             (checkdoc-create-error msg (match-beginning 1)
                                    (+ (match-beginning 1)
@@ -1834,7 +1850,7 @@ Replace with \"%s\"? " original replace)
                (match-string 2) t)
               nil
             (checkdoc-create-error
-             "Symbols t and nil should not appear in `...' quotes"
+             "Symbols t and nil should not appear in single quotes"
              (match-beginning 1) (match-end 1)))))
      ;; Here is some basic sentence formatting
      (checkdoc-sentencespace-region-engine (point) e)
@@ -1939,7 +1955,7 @@ from the comment."
   "Return non-nil if the current point is in a code fragment.
 A code fragment is identified by an open parenthesis followed by a
 symbol which is a valid function or a word in all CAPS, or a parenthesis
-that is quoted with the ' character.  Only the region from START to LIMIT
+that is quoted with the \\=' character.  Only the region from START to LIMIT
 is allowed while searching for the bounding parenthesis."
   (save-match-data
     (save-restriction
@@ -2472,7 +2488,8 @@ Argument TYPE specifies the type of question, such as `error' or `y-or-n-p'."
               ;; If we see a ?, then replace with "? ".
               (if (checkdoc-autofix-ask-replace
                    (match-beginning 0) (match-end 0)
-                   "`y-or-n-p' argument should end with \"? \".  Fix? "
+                    (format-message
+                     "`y-or-n-p' argument should end with \"? \".  Fix? ")
                    "? " t)
                   nil
                 (checkdoc-create-error
@@ -2483,7 +2500,8 @@ Argument TYPE specifies the type of question, such as `error' or `y-or-n-p'."
                                 (looking-at " "))
                 (if (checkdoc-autofix-ask-replace
                      (match-beginning 0) (match-end 0)
-                     "`y-or-n-p' argument should end with \"? \".  Fix? "
+                      (format-message
+                       "`y-or-n-p' argument should end with \"? \".  Fix? ")
                      "? " t)
                     nil
                   (checkdoc-create-error
@@ -2495,7 +2513,8 @@ Argument TYPE specifies the type of question, such as `error' or `y-or-n-p'."
                                    (looking-at "\""))
                    (checkdoc-autofix-ask-replace
                     (match-beginning 0) (match-end 0)
-                    "`y-or-n-p' argument should end with \"? \".  Fix? "
+                     (format-message
+                      "`y-or-n-p' argument should end with \"? \".  Fix? ")
                     "? \"" t))
                   nil
                 (checkdoc-create-error
@@ -2611,16 +2630,16 @@ function called to create the messages."
   "Store POINT and MSG as errors in the checkdoc diagnostic buffer."
   (setq checkdoc-pending-errors t)
   (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)
-      (let ((inhibit-read-only t)
-            (pt (point-max)))
-        (goto-char pt)
-        (apply #'insert text)
-        (when noninteractive
-          (warn (buffer-substring pt (point-max))))))))
+                    (int-to-string
+                     (count-lines (point-min) (or point (point-min))))
+                    ": " msg)))
+    (if (string= checkdoc-diagnostic-buffer "*warn*")
+        (warn (apply #'concat text))
+      (with-current-buffer (get-buffer checkdoc-diagnostic-buffer)
+          (let ((inhibit-read-only t)
+                (pt (point-max)))
+            (goto-char pt)
+            (apply #'insert text))))))
 
 (defun checkdoc-show-diagnostics ()
   "Display the checkdoc diagnostic buffer in a temporary window."
@@ -2637,6 +2656,39 @@ function called to create the messages."
        (setq checkdoc-pending-errors nil)
        nil)))
 
+(defun checkdoc-get-keywords ()
+  "Return a list of package keywords for the current file."
+  (save-excursion
+    (goto-char (point-min))
+    (when (re-search-forward "^;; Keywords: \\(.*\\)$" nil t)
+      (split-string (match-string-no-properties 1) ", " t))))
+
+(defvar finder-known-keywords)
+
+;;;###autoload
+(defun checkdoc-package-keywords ()
+  "Find package keywords that aren't in `finder-known-keywords'."
+  (interactive)
+  (require 'finder)
+  (let ((unrecognized-keys
+         (cl-remove-if
+          (lambda (x) (assoc (intern-soft x) finder-known-keywords))
+          (checkdoc-get-keywords))))
+    (if unrecognized-keys
+        (let* ((checkdoc-autofix-flag 'never)
+               (checkdoc-generate-compile-warnings-flag t))
+          (save-excursion
+            (goto-char (point-min))
+            (re-search-forward "^;; Keywords: \\(.*\\)$" nil t)
+            (checkdoc-start-section "checkdoc-package-keywords")
+            (checkdoc-create-error
+             (concat "Unrecognized keywords: "
+                     (mapconcat #'identity unrecognized-keys ", "))
+             (match-beginning 1) (match-end 1)))
+          (checkdoc-show-diagnostics))
+      (when (called-interactively-p 'any)
+        (message "No Package Keyword Errors.")))))
+
 (custom-add-option 'emacs-lisp-mode-hook 'checkdoc-minor-mode)
 
 (provide 'checkdoc)