X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/d4aca72ead4c1e53819e6e3249e26400a9879a0e..368cb23fe249334bf9d230755ae07b6410ac6852:/lisp/emacs-lisp/checkdoc.el diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el index 4761ac5e6f..3a81adeb6a 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-2015 Free Software Foundation, Inc. +;; Copyright (C) 1997-1998, 2001-2016 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam ;; 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 @@ -1564,7 +1580,7 @@ mouse-[0-3]\\)\\)\\>")) (if (and sym (boundp sym) (fboundp sym) (save-excursion (goto-char mb) - (forward-word -1) + (forward-word-strictly -1) (not (looking-at "variable\\|option\\|function\\|command\\|symbol")))) (if (checkdoc-autofix-ask-replace @@ -1580,7 +1596,7 @@ mouse-[0-3]\\)\\)\\>")) nil t nil nil "variable"))) (goto-char (1- mb)) (insert disambiguate " ") - (forward-word 1)) + (forward-word-strictly 1)) (setq ret (format "Disambiguate %s by preceding w/ \ function,command,variable,option or symbol." ms1)))))) @@ -1622,6 +1638,17 @@ function,command,variable,option or symbol." ms1)))))) ;; * If a user option variable records a true-or-false ;; condition, give it a name that ends in `-flag'. + ;; "True ..." should be "Non-nil ..." + (when (looking-at "\"\\*?\\(True\\)\\b") + (if (checkdoc-autofix-ask-replace + (match-beginning 1) (match-end 1) + "Say \"Non-nil\" instead of \"True\"? " + "Non-nil") + nil + (checkdoc-create-error + "\"True\" should usually be \"Non-nil\"" + (match-beginning 1) (match-end 1)))) + ;; If the variable has -flag in the name, make sure (if (and (string-match "-flag$" (car fp)) (not (looking-at "\"\\*?Non-nil\\s-+means\\s-+"))) @@ -1699,7 +1726,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 +1752,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))) @@ -1782,6 +1809,16 @@ Replace with \"%s\"? " original replace) "Probably \"%s\" should be imperative \"%s\"" original replace) (match-beginning 1) (match-end 1)))))) + ;; "Return true ..." should be "Return non-nil ..." + (when (looking-at "\"Return \\(true\\)\\b") + (if (checkdoc-autofix-ask-replace + (match-beginning 1) (match-end 1) + "Say \"non-nil\" instead of \"true\"? " + "non-nil") + nil + (checkdoc-create-error + "\"true\" should usually be \"non-nil\"" + (match-beginning 1) (match-end 1)))) ;; Done with functions ))) ;;* When a documentation string refers to a Lisp symbol, write it as @@ -1809,16 +1846,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 +1871,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 +1976,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 +2509,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 +2521,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 +2534,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 +2651,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 +2677,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)