diff options
Diffstat (limited to 'lisp/emacs-lisp/checkdoc.el')
| -rw-r--r-- | lisp/emacs-lisp/checkdoc.el | 152 |
1 files changed, 105 insertions, 47 deletions
diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el index 9c5b408637f..bf1a21acaf1 100644 --- a/lisp/emacs-lisp/checkdoc.el +++ b/lisp/emacs-lisp/checkdoc.el @@ -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-2013 Free Software Foundation, Inc. +;; Copyright (C) 1997-1998, 2001-2015 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam <zappo@gnu.org> ;; Version: 0.6.2 @@ -267,6 +267,11 @@ 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'." + :type 'boolean) + (define-obsolete-variable-alias 'checkdoc-style-hooks 'checkdoc-style-functions "24.3") (defvar checkdoc-style-functions nil @@ -315,6 +320,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 +747,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 +767,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 +791,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 +813,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,11 +872,20 @@ 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. Only documentation strings are checked. @@ -1404,7 +1419,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 @@ -1524,7 +1539,7 @@ may require more formatting") ;; Instead, use the `\\[...]' construct to stand for them. (save-excursion (let ((f nil) (m nil) (start (point)) - (re "[^`A-Za-z0-9_]\\([CMA]-[a-zA-Z]\\|\\(\\([CMA]-\\)?\ + (re "[^`‘A-Za-z0-9_]\\([CMA]-[a-zA-Z]\\|\\(\\([CMA]-\\)?\ mouse-[0-3]\\)\\)\\>")) ;; Find the first key sequence not in a sample (while (and (not f) (setq m (re-search-forward re e t))) @@ -1554,7 +1569,8 @@ mouse-[0-3]\\)\\)\\>")) (save-excursion (let ((case-fold-search t) (ret nil) mb me) - (while (and (re-search-forward "`\\(\\sw\\(\\sw\\|\\s_\\)+\\)'" e t) + (while (and (re-search-forward + "[`‘]\\(\\sw\\(\\sw\\|\\s_\\)+\\)['’]" e t) (not ret)) (let* ((ms1 (match-string 1)) (sym (intern-soft ms1))) @@ -1615,8 +1631,8 @@ function,command,variable,option or symbol." ms1)))))) (or ;; * The documentation string for a variable that is a ;; yes-or-no flag should start with words such as Non-nil - ;; means..., to make it clear that all non-`nil' values are - ;; equivalent and indicate explicitly what `nil' and non-`nil' + ;; means..., to make it clear that all non-nil values are + ;; equivalent and indicate explicitly what nil and non-nil ;; mean. ;; * If a user option variable records a true-or-false ;; condition, give it a name that ends in `-flag'. @@ -1663,14 +1679,15 @@ function,command,variable,option or symbol." ms1)))))) ;; Addendum: Make sure they appear in the doc in the same ;; order that they are found in the arg list. - (let ((args (cdr (cdr (cdr (cdr fp))))) + (let ((args (nthcdr 4 fp)) (last-pos 0) (found 1) (order (and (nth 3 fp) (car (nth 3 fp)))) (nocheck (append '("&optional" "&rest") (nth 3 fp))) (inopts nil)) (while (and args found (> found last-pos)) - (if (member (car args) nocheck) + (if (or (member (car args) nocheck) + (string-match "\\`_" (car args))) (setq args (cdr args) inopts t) (setq last-pos found @@ -1697,7 +1714,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) @@ -1723,7 +1740,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))) @@ -1784,16 +1801,17 @@ Replace with \"%s\"? " original replace) ))) ;;* When a documentation string refers to a Lisp symbol, write it as ;; it would be printed (which usually means in lower case), with - ;; single-quotes around it. For example: `lambda'. There are two - ;; exceptions: write t and nil without single-quotes. (In this - ;; manual, we normally do use single-quotes for those symbols.) + ;; single-quotes around it. For example: ‘lambda’. There are two + ;; exceptions: write t and nil without single-quotes. (For + ;; compatibility with an older Emacs style, quoting with ` and ' + ;; also works, e.g., `lambda' is treated like ‘lambda’.) (save-excursion (let ((found nil) (start (point)) (msg nil) (ms nil)) (while (and (not msg) (re-search-forward ;; Ignore manual page references like ;; git-config(1). - "[^-([`':a-zA-Z]\\(\\w+[:-]\\(\\w\\|\\s_\\)+\\)[^](']" + "[^-([`'‘’:a-zA-Z]\\(\\w+[:-]\\(\\w\\|\\s_\\)+\\)[^]('’]" e t)) (setq ms (match-string 1)) ;; A . is a \s_ char, so we must remove periods from @@ -1806,16 +1824,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) @@ -1823,7 +1841,7 @@ Replace with \"%s\"? " original replace) nil))) ;; t and nil case (save-excursion - (if (re-search-forward "\\(`\\(t\\|nil\\)'\\)" e t) + (if (re-search-forward "\\([`‘]\\(t\\|nil\\)['’]\\)" e t) (if (checkdoc-autofix-ask-replace (match-beginning 1) (match-end 1) (format "%s should not appear in quotes. Remove? " @@ -1831,7 +1849,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) @@ -1936,7 +1954,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 @@ -1988,7 +2006,7 @@ If the offending word is in a piece of quoted text, then it is skipped." (if (and (not (save-excursion (goto-char b) (forward-char -1) - (looking-at "`\\|\"\\|\\.\\|\\\\"))) + (looking-at "[`\".‘]\\|\\\\"))) ;; surrounded by /, as in a URL or filename: /emacs/ (not (and (= ?/ (char-after e)) (= ?/ (char-before b)))) @@ -2404,7 +2422,7 @@ Argument END is the maximum bounds to search in." According to the documentation for the function `error', the error list should not end with a period, and should start with a capital letter. The function `y-or-n-p' has similar constraints. -Argument TYPE specifies the type of question, such as `error or `y-or-n-p." +Argument TYPE specifies the type of question, such as `error' or `y-or-n-p'." ;; If type is nil, then attempt to derive it. (if (not type) (save-excursion @@ -2469,7 +2487,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 @@ -2480,7 +2499,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 @@ -2492,7 +2512,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 @@ -2608,28 +2629,65 @@ 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) - (goto-char (point-max)) - (let ((inhibit-read-only t)) - (apply #'insert text))))) + (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." (if checkdoc-pending-errors - (let ((b (get-buffer checkdoc-diagnostic-buffer))) - (if b (progn (pop-to-buffer b) - (goto-char (point-max)) - (re-search-backward "\C-l" nil t) - (beginning-of-line) - (forward-line 1) - (recenter 0))) - (other-window -1) + (let* ((b (get-buffer checkdoc-diagnostic-buffer)) + (win (if b (display-buffer b)))) + (when win + (with-selected-window win + (goto-char (point-max)) + (re-search-backward "\C-l" nil t) + (beginning-of-line) + (forward-line 1) + (recenter 0))) (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) |