summaryrefslogtreecommitdiff
path: root/lisp/emacs-lisp/checkdoc.el
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/emacs-lisp/checkdoc.el')
-rw-r--r--lisp/emacs-lisp/checkdoc.el345
1 files changed, 158 insertions, 187 deletions
diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el
index e7455b3fbb7..0a3b3c94ff6 100644
--- a/lisp/emacs-lisp/checkdoc.el
+++ b/lisp/emacs-lisp/checkdoc.el
@@ -1,7 +1,7 @@
;;; checkdoc.el --- check documentation strings for style requirements
-;; Copyright (C) 1997, 1998, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 1998, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
+;; 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Version: 0.6.2
@@ -201,9 +201,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 +250,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 +429,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 +511,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 +618,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 +708,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 +822,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 +943,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 +966,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 +1203,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 +1362,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 +1370,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 +1380,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 +1478,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 +1498,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 +1513,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 +1613,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 +1758,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
@@ -2002,49 +1983,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)
@@ -2052,43 +2029,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
@@ -2256,8 +2229,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
@@ -2668,8 +2641,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")
@@ -2679,5 +2651,4 @@ function called to create the messages."
(provide 'checkdoc)
-;; arch-tag: c49a7ec8-3bb7-46f2-bfbc-d5f26e033b26
;;; checkdoc.el ends here
generated by cgit v1.2.3 (git 2.39.1) at 2025-04-23 20:12:09 +0000