-;;; 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
: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
;;;###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)
;; 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)))))
;; 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)))))
(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
(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
(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.
(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
;; 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)))
(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)))
(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'.
;; 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
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)
(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)))
)))
;;* 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
(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)
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? "
(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)
"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
(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))))
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
;; 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
(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
(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
"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."
(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)