X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/1a553b8be1276270cc0b78b516f93fc4300a6c11..937640a621a4ce2e5e56eaecca37a2a28a584318:/lisp/emacs-lisp/checkdoc.el diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el index 5fd428a904..cc2be89065 100644 --- a/lisp/emacs-lisp/checkdoc.el +++ b/lisp/emacs-lisp/checkdoc.el @@ -1,6 +1,6 @@ -;;; checkdoc --- Check documentation strings for style requirements +;;; checkdoc.el --- check documentation strings for style requirements -;;; Copyright (C) 1997, 1998 Free Software Foundation +;;; Copyright (C) 1997, 1998, 2001, 2004 Free Software Foundation ;; Author: Eric M. Ludlam ;; Version: 0.6.2 @@ -91,7 +91,7 @@ ;; The variable `checkdoc-spellcheck-documentation-flag' can be set ;; to customize how spell checking is to be done. Since spell ;; checking can be quite slow, you can optimize how best you want your -;; checking done. The default is 'defun, which spell checks each time +;; checking done. The default is `defun', which spell checks each time ;; `checkdoc-defun' or `checkdoc-eval-defun' is used. Setting to nil ;; prevents spell checking during normal usage. ;; Setting this variable to nil does not mean you cannot take @@ -176,18 +176,18 @@ ;; From custom web page for compatibility between versions of custom: (eval-and-compile - (condition-case () - (require 'custom) - (error nil)) - (if (and (featurep 'custom) (fboundp 'custom-declare-variable)) - nil ;; We've got what we needed - ;; We have the old custom-library, hack around it! - (defmacro defgroup (&rest args) - nil) - (defmacro custom-add-option (&rest args) - nil) - (defmacro defcustom (var value doc &rest args) - (` (defvar (, var) (, value) (, doc)))))) + (condition-case () + (require 'custom) + (error nil)) + (if (and (featurep 'custom) (fboundp 'custom-declare-variable)) + nil ;; We've got what we needed + ;; We have the old custom-library, hack around it! + (defmacro defgroup (&rest args) + nil) + (defmacro custom-add-option (&rest args) + nil) + (defmacro defcustom (var value doc &rest args) + `(defvar ,var ,value ,doc)))) (defcustom checkdoc-autofix-flag 'semiautomatic "*Non-nil means attempt auto-fixing of doc strings. @@ -233,19 +233,6 @@ it indicates that a modifying clause follows." :group 'checkdoc :type 'boolean) -(defcustom checkdoc-triple-semi-comment-check-flag t - "*Non-nil means to check for multiple adjacent occurrences of ;;; comments. -According to the style of Emacs code in the Lisp libraries, a block -comment can look like this: -;;; Title -;; text -;; text -But when inside a function, code can be commented out using the ;;; -construct for all lines. When this variable is nil, the ;;; construct -is ignored regardless of its location in the code." - :group 'checkdoc - :type 'boolean) - (defcustom checkdoc-spellcheck-documentation-flag nil "*Non-nil means run Ispell on text based on value. This is automatically set to nil if Ispell does not exist on your @@ -314,7 +301,7 @@ variable `checkdoc-common-verbs-wrong-voice' if you wish to add your own." :type 'boolean) (defvar checkdoc-generate-compile-warnings-flag nil - "Non-nil means generage warnings in a buffer for browsing. + "Non-nil means generate warnings in a buffer for browsing. Do not set this by hand, use a function like `checkdoc-current-buffer' with a universal argument.") @@ -353,6 +340,7 @@ This should be set in an Emacs Lisp file's local variables." ("changes" . "change") ("checks" . "check") ("contains" . "contain") + ("converts" . "convert") ("creates" . "create") ("destroys" . "destroy") ("disables" . "disable") @@ -382,6 +370,7 @@ This should be set in an Emacs Lisp file's local variables." ("makes" . "make") ("marks" . "mark") ("matches" . "match") + ("moves" . "move") ("notifies" . "notify") ("offers" . "offer") ("parses" . "parse") @@ -437,7 +426,7 @@ be re-created.") ;; end of a word in a conglomerate. (modify-syntax-entry ?- "w" checkdoc-syntax-table) ) - + ;;; Compatibility ;; @@ -460,45 +449,26 @@ be re-created.") (defalias 'checkdoc-call-eval-buffer 'eval-current-buffer) ) -;; Emacs 20 has this handy function. -(if (not (fboundp 'princ-list)) - (defun princ-list (&rest args) - "Call `princ' on ARGS." - (mapcar 'princ args))) - ;; Emacs 20s have MULE characters which don't equate to numbers. (if (fboundp 'char=) (defalias 'checkdoc-char= 'char=) (defalias 'checkdoc-char= '=)) -;; Emacs 19.28 and earlier don't have the handy 'add-to-list function -(if (fboundp 'add-to-list) - - (defalias 'checkdoc-add-to-list 'add-to-list) - - (defun checkdoc-add-to-list (list-var element) - "Add to the value of LIST-VAR the element ELEMENT if it isn't there yet." - (if (not (member element (symbol-value list-var))) - (set list-var (cons element (symbol-value list-var))))) - ) - -;; To be safe in new Emacsen, we want to read events, not characters -(if (fboundp 'read-event) - (defalias 'checkdoc-read-event 'read-event) - (defalias 'checkdoc-read-event 'read-char)) +;; Read events, not characters +(defalias 'checkdoc-read-event 'read-event) ;;; User level commands ;; ;;;###autoload (defun checkdoc () - "Interactivly check the entire buffer for style errors. -The current status of the ckeck will be displayed in a buffer which + "Interactively check the entire buffer for style errors. +The current status of the check will be displayed in a buffer which the users will view as each check is completed." (interactive) (let ((status (list "Checking..." "-" "-" "-")) (checkdoc-spellcheck-documentation-flag - (member checkdoc-spellcheck-documentation-flag - '(buffer interactive t))) + (car (memq checkdoc-spellcheck-documentation-flag + '(buffer interactive t)))) ;; if the user set autofix to never, then that breaks the ;; obviously requested asking implied by using this function. ;; Set it to paranoia level. @@ -539,15 +509,16 @@ the users will view as each check is completed." (defun checkdoc-display-status-buffer (check) "Display and update the status buffer for the current checkdoc mode. -CHECK is a vector stating the current status of each test as an -element is the status of that level of teset." - (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) - )) +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) + ))) (shrink-window-if-larger-than-buffer (get-buffer-window " *Checkdoc Status*")) (message nil) @@ -564,9 +535,15 @@ Optional argument SHOWSTATUS indicates that we should update the checkdoc status window instead of the usual behavior." (interactive "P") (let ((checkdoc-spellcheck-documentation-flag - (member checkdoc-spellcheck-documentation-flag - '(interactive t)))) - (checkdoc-interactive-loop start-here showstatus 'checkdoc-next-error))) + (car (memq checkdoc-spellcheck-documentation-flag + '(interactive t))))) + (prog1 + ;; Due to a design flaw, this will never spell check + ;; docstrings. + (checkdoc-interactive-loop start-here showstatus + 'checkdoc-next-error) + ;; This is a workaround to perform spell checking. + (checkdoc-interactive-ispell-loop start-here)))) ;;;###autoload (defun checkdoc-message-interactive (&optional start-here showstatus) @@ -579,17 +556,25 @@ Optional argument SHOWSTATUS indicates that we should update the checkdoc status window instead of the usual behavior." (interactive "P") (let ((checkdoc-spellcheck-documentation-flag - (member checkdoc-spellcheck-documentation-flag - '(interactive t)))) - (checkdoc-interactive-loop start-here showstatus - 'checkdoc-next-message-error))) + (car (memq checkdoc-spellcheck-documentation-flag + '(interactive t))))) + (prog1 + ;; Due to a design flaw, this will never spell check messages. + (checkdoc-interactive-loop start-here showstatus + 'checkdoc-next-message-error) + ;; This is a workaround to perform spell checking. + (checkdoc-message-interactive-ispell-loop start-here)))) (defun checkdoc-interactive-loop (start-here showstatus findfunc) - "Interactivly loop over all errors that can be found by a given method. -Searching starts at START-HERE. SHOWSTATUS expresses the verbosity -of the search, and wether ending the search will auto-exit this function. + "Interactively loop over all errors that can be found by a given method. + +If START-HERE is nil, searching starts at the beginning of the current +buffer, otherwise searching starts at START-HERE. SHOWSTATUS +expresses the verbosity of the search, and whether ending the search +will auto-exit this function. + FINDFUNC is a symbol representing a function that will position the -cursor, and return error message text to present the the user. It is +cursor, and return error message text to present to the user. It is assumed that the cursor will stop just before a major sexp, which will be highlighted to present the user with feedback as to the offending style." @@ -598,8 +583,8 @@ style." (if (not start-here) (goto-char (point-min))))) ;; Assign a flag to spellcheck flag (checkdoc-spellcheck-documentation-flag - (member checkdoc-spellcheck-documentation-flag - '(buffer interactive t))) + (car (memq checkdoc-spellcheck-documentation-flag + '(buffer interactive t)))) ;; Fetch the error list (err-list (list (funcall findfunc nil))) (cdo nil) @@ -624,17 +609,17 @@ style." (checkdoc-overlay-put cdo 'face 'highlight) ;; Make sure the whole doc string is visible if possible. (sit-for 0) - (if (not (pos-visible-in-window-p - (save-excursion (forward-sexp 1) (point)) - (selected-window))) - (if (looking-at "\"") - (let ((l (count-lines (point) - (save-excursion - (forward-sexp 1) (point))))) - (if (> l (window-height)) - (recenter 1) - (recenter (/ (- (window-height) l) 2)))) - (recenter))) + (if (and (looking-at "\"") + (not (pos-visible-in-window-p + (save-excursion (forward-sexp 1) (point)) + (selected-window)))) + (let ((l (count-lines (point) + (save-excursion + (forward-sexp 1) (point))))) + (if (> l (window-height)) + (recenter 1) + (recenter (/ (- (window-height) l) 2)))) + (recenter)) (message "%s (C-h,%se,n,p,q)" (checkdoc-error-text (car (car err-list))) (if (checkdoc-error-unfixable (car (car err-list))) @@ -643,7 +628,7 @@ style." (goto-char (checkdoc-error-start (car (car err-list)))) (if (not (pos-visible-in-window-p)) (recenter (- (window-height) 2))) - (setq c (checkdoc-read-event)))1 + (setq c (checkdoc-read-event))) (if (not (integerp c)) (setq c ??)) (cond ;; Exit condition @@ -655,7 +640,7 @@ style." (goto-char (cdr (car err-list))) ;; `automatic-then-never' tells the autofix function ;; to only allow one fix to be automatic. The autofix - ;; function will than set the flag to 'never, allowing + ;; function will then set the flag to 'never, allowing ;; the checker to return a different error. (let ((checkdoc-autofix-flag 'automatic-then-never) (fixed nil)) @@ -668,8 +653,7 @@ style." (sit-for 2)) (setq err-list (cdr err-list)))) (beginning-of-defun) - (let ((pe (car err-list)) - (ne (funcall findfunc nil))) + (let ((ne (funcall findfunc nil))) (if ne (setq err-list (cons ne err-list)) (cond ((not err-list) @@ -720,7 +704,7 @@ style." (setq returnme err-list err-list nil begin (point))) - ;; Goofy s tuff + ;; Goofy stuff (t (if (get-buffer-window "*Checkdoc Help*") (progn @@ -749,13 +733,54 @@ style." (message "Checkdoc: Done.") returnme)) +(defun checkdoc-interactive-ispell-loop (start-here) + "Interactively spell check doc strings in the current buffer. +If START-HERE is nil, searching starts at the beginning of the current +buffer, otherwise searching starts at START-HERE." + (when checkdoc-spellcheck-documentation-flag + (save-excursion + ;; Move point to where we need to start. + (if start-here + ;; Include whatever function point is in for good measure. + (beginning-of-defun) + (goto-char (point-min))) + ;; Loop over docstrings. + (while (checkdoc-next-docstring) + (message "Searching for doc string spell error...%d%%" + (/ (* 100 (point)) (point-max))) + (if (looking-at "\"") + (checkdoc-ispell-docstring-engine + (save-excursion (forward-sexp 1) (point-marker))))) + (message "Checkdoc: Done.")))) + +(defun checkdoc-message-interactive-ispell-loop (start-here) + "Interactively spell check messages in the current buffer. +If START-HERE is nil, searching starts at the beginning of the current +buffer, otherwise searching starts at START-HERE." + (when checkdoc-spellcheck-documentation-flag + (save-excursion + ;; Move point to where we need to start. + (if start-here + ;; Include whatever function point is in for good measure. + (beginning-of-defun) + (goto-char (point-min))) + ;; Loop over message strings. + (while (checkdoc-message-text-next-string (point-max)) + (message "Searching for message string spell error...%d%%" + (/ (* 100 (point)) (point-max))) + (if (looking-at "\"") + (checkdoc-ispell-docstring-engine + (save-excursion (forward-sexp 1) (point-marker))))) + (message "Checkdoc: Done.")))) + + (defun checkdoc-next-error (enable-fix) "Find and return the next checkdoc error list, or nil. Only documentation strings are checked. -Add error vector is of the form (WARNING . POSITION) where WARNING -is the warning text, and POSITION is the point in the buffer where the -error was found. We can use points and not markers because we promise -not to edit the buffer before point without re-executing this check. +An error list is of the form (WARNING . POSITION) where WARNING is the +warning text, and POSITION is the point in the buffer where the error +was found. We can use points and not markers because we promise not +to edit the buffer before point without re-executing this check. Argument ENABLE-FIX will enable auto-fixing while looking for the next error. This argument assumes that the cursor is already positioned to perform the fix." @@ -774,7 +799,7 @@ perform the fix." msg))) (defun checkdoc-next-message-error (enable-fix) - "Find and return the next checkdoc mesasge related error list, or nil. + "Find and return the next checkdoc message related error list, or nil. Only text for error and `y-or-n-p' strings are checked. See `checkdoc-next-error' for details on the return value. Argument ENABLE-FIX turns on the auto-fix feature. This argument @@ -832,7 +857,8 @@ otherwise stop after the first error." (if (interactive-p) (message "Checking buffer for style...")) ;; Assign a flag to spellcheck flag (let ((checkdoc-spellcheck-documentation-flag - (memq checkdoc-spellcheck-documentation-flag '(buffer t))) + (car (memq checkdoc-spellcheck-documentation-flag + '(buffer t)))) (checkdoc-autofix-flag (if take-notes 'never checkdoc-autofix-flag)) (checkdoc-generate-compile-warnings-flag @@ -873,11 +899,11 @@ Prefix argument TAKE-NOTES means to continue through the whole buffer and save warnings in a separate buffer. Second optional argument START-POINT is the starting location. If this is nil, `point-min' is used instead." (interactive "P") - (let ((wrong nil) (msg nil) (errors nil) + (let ((wrong nil) (msg nil) ;; Assign a flag to spellcheck flag (checkdoc-spellcheck-documentation-flag - (member checkdoc-spellcheck-documentation-flag - '(buffer t))) + (car (memq checkdoc-spellcheck-documentation-flag + '(buffer t)))) (checkdoc-autofix-flag (if take-notes 'never checkdoc-autofix-flag)) (checkdoc-generate-compile-warnings-flag @@ -909,7 +935,7 @@ Return nil if there are no more doc strings." (skip-chars-forward " \n\t") t)) -;;; ###autoload +;;;###autoload (defun checkdoc-comments (&optional take-notes) "Find missing comment sections in the current Emacs Lisp file. Prefix argument TAKE-NOTES non-nil means to save warnings in a @@ -920,12 +946,9 @@ if there is one." (if (not buffer-file-name) (error "Can only check comments for a file buffer")) (let* ((checkdoc-spellcheck-documentation-flag - (member checkdoc-spellcheck-documentation-flag - '(buffer t))) + (car (memq checkdoc-spellcheck-documentation-flag + '(buffer t)))) (checkdoc-autofix-flag (if take-notes 'never checkdoc-autofix-flag)) - ;; This is just irritating when taking notes. - (checkdoc-triple-semi-comment-check-flag - (if take-notes nil checkdoc-triple-semi-comment-check-flag)) (e (checkdoc-file-comments-engine)) (checkdoc-generate-compile-warnings-flag (or take-notes checkdoc-generate-compile-warnings-flag))) @@ -971,7 +994,7 @@ Optional argument TAKE-NOTES causes all errors to be logged." (checkdoc-show-diagnostics))) (goto-char p)) (if (interactive-p) (message "Checking interactive message text...done."))) - + ;;;###autoload (defun checkdoc-eval-defun () "Evaluate the current form with `eval-defun' and check its documentation. @@ -979,7 +1002,7 @@ Evaluation is done first so the form will be read before the documentation is checked. If there is a documentation error, then the display of what was evaluated will be overwritten by the diagnostic message." (interactive) - (eval-defun nil) + (call-interactively 'eval-defun) (checkdoc-defun)) ;;;###autoload @@ -1003,8 +1026,8 @@ space at the end of each line." (forward-sexp 1) (skip-chars-forward " \n\t") (let* ((checkdoc-spellcheck-documentation-flag - (member checkdoc-spellcheck-documentation-flag - '(defun t))) + (car (memq checkdoc-spellcheck-documentation-flag + '(defun t)))) (beg (save-excursion (beginning-of-defun) (point))) (end (save-excursion (end-of-defun) (point))) (msg (checkdoc-this-string-valid))) @@ -1146,13 +1169,8 @@ generating a buffered list of errors." ;;; Minor Mode specification ;; -(defvar checkdoc-minor-mode nil - "Non-nil in `emacs-lisp-mode' for automatic documentation checking.") -(make-variable-buffer-local 'checkdoc-minor-mode) -(checkdoc-add-to-list 'minor-mode-alist '(checkdoc-minor-mode " CDoc")) - -(defvar checkdoc-minor-keymap +(defvar checkdoc-minor-mode-map (let ((map (make-sparse-keymap)) (pmap (make-sparse-keymap))) ;; Override some bindings @@ -1184,63 +1202,56 @@ generating a buffered list of errors." map) "Keymap used to override evaluation key-bindings for documentation checking.") +(defvaralias 'checkdoc-minor-keymap 'checkdoc-minor-mode-map) +(make-obsolete-variable 'checkdoc-minor-keymap + 'checkdoc-minor-mode-map) + ;; Add in a menubar with easy-menu -(if checkdoc-minor-keymap - (easy-menu-define - checkdoc-minor-menu checkdoc-minor-keymap "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] - ))) +(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] + )) ;; XEmacs requires some weird stuff to add this menu in a minor mode. ;; What is it? -;; Allow re-insertion of a new keymap -(let ((a (assoc 'checkdoc-minor-mode minor-mode-map-alist))) - (if a - (setcdr a checkdoc-minor-keymap) - (checkdoc-add-to-list 'minor-mode-map-alist (cons 'checkdoc-minor-mode - checkdoc-minor-keymap)))) - ;;;###autoload -(defun checkdoc-minor-mode (&optional arg) +(define-minor-mode checkdoc-minor-mode "Toggle Checkdoc minor mode, a mode for checking Lisp doc strings. With prefix ARG, turn Checkdoc minor mode on iff ARG is positive. In Checkdoc minor mode, the usual bindings for `eval-defun' which is -bound to \\ \\[checkdoc-eval-defun] and `checkdoc-eval-current-buffer' are overridden to include +bound to \\\\[checkdoc-eval-defun] and `checkdoc-eval-current-buffer' are overridden to include checking of documentation strings. -\\{checkdoc-minor-keymap}" - (interactive "P") - (setq checkdoc-minor-mode - (not (or (and (null arg) checkdoc-minor-mode) - (<= (prefix-numeric-value arg) 0)))) - (checkdoc-mode-line-update)) +\\{checkdoc-minor-mode-map}" + nil " CDoc" nil + :group 'checkdoc) ;;; Subst utils ;; @@ -1311,7 +1322,8 @@ See the style guide in the Emacs Lisp manual for more details." ;; Sometimes old code has comments where the documentation should ;; be. Let's see if we can find the comment, and offer to turn it ;; into documentation for them. - (let ((have-comment nil)) + (let ((have-comment nil) + (comment-start ";")) ; in case it's not default (condition-case nil (progn (forward-sexp -1) @@ -1400,6 +1412,17 @@ regexp short cuts work. FP is the function defun information." "Second line should not have indentation" (match-beginning 1) (match-end 1))))) + ;; * Check for '(' in column 0. + (save-excursion + (when (re-search-forward "^(" e t) + (if (checkdoc-autofix-ask-replace (match-beginning 0) + (match-end 0) + "Escape this '('? " + "\\(") + nil + (checkdoc-create-error + "Open parenthesis in column 0 should be escaped" + (match-beginning 0) (match-end 0))))) ;; * Do not start or end a documentation string with whitespace. (let (start end) (if (or (if (looking-at "\"\\([ \t\n]+\\)") @@ -1538,8 +1561,9 @@ mouse-[0-3]\\)\\)\\>")) ;; to describe the most important commands in your major mode, and ;; then use `\\{...}' to display the rest of the mode's keymap. (save-excursion - (if (re-search-forward "\\\\\\\\\\[\\w+" e t - (1+ checkdoc-max-keyref-before-warn)) + (if (and (re-search-forward "\\\\\\\\\\[\\w+" e t + (1+ checkdoc-max-keyref-before-warn)) + (not (re-search-forward "\\\\\\\\{\\w+}" e t))) (checkdoc-create-error "Too many occurrences of \\[function]. Use \\{keymap} instead" s (marker-position e)))) @@ -1621,23 +1645,27 @@ function,command,variable,option or symbol." ms1)))))) (if (and (string-match "-flag$" (car fp)) (not (looking-at "\"\\*?Non-nil\\s-+means\\s-+"))) (checkdoc-create-error - "Flag variable doc strings should start: Non-nil means" + "Flag variable doc strings should usually start: Non-nil means" s (marker-position e) t)) ;; If the doc string starts with "Non-nil means" (if (and (looking-at "\"\\*?Non-nil\\s-+means\\s-+") (not (string-match "-flag$" (car fp)))) - (if (checkdoc-y-or-n-p - (format - "Rename to %s and Query-Replace all occurances? " - (concat (car fp) "-flag"))) - (progn - (beginning-of-defun) - (query-replace-regexp - (concat "\\<" (regexp-quote (car fp)) "\\>") - (concat (car fp) "-flag"))) - (checkdoc-create-error - "Flag variables should end in `-flag'" s - (marker-position e)))) + (let ((newname + (if (string-match "-p$" (car fp)) + (concat (substring (car fp) 0 -2) "-flag") + (concat (car fp) "-flag")))) + (if (checkdoc-y-or-n-p + (format + "Rename to %s and Query-Replace all occurrences? " + newname)) + (progn + (beginning-of-defun) + (query-replace-regexp + (concat "\\<" (regexp-quote (car fp)) "\\>") + newname)) + (checkdoc-create-error + "Flag variable names should normally end in `-flag'" s + (marker-position e))))) ;; Done with variables )) (t @@ -1669,7 +1697,7 @@ function,command,variable,option or symbol." ms1)))))) ;; Require whitespace OR ;; ITEMth OR ;; ITEMs - "\\(\\>\\|th\\>\\|s\\>\\)") + "\\(\\>\\|th\\>\\|s\\>\\|[.,;:]\\)") e t))) (if (not found) (let ((case-fold-search t)) @@ -1687,7 +1715,7 @@ function,command,variable,option or symbol." ms1)))))) (if (checkdoc-autofix-ask-replace (match-beginning 1) (match-end 1) (format - "Argument `%s' should appear as `%s'. Fix? " + "If this is the argument `%s', it should appear as %s. Fix? " (car args) (upcase (car args))) (upcase (car args)) t) (setq found (match-beginning 1)))))) @@ -1713,7 +1741,7 @@ function,command,variable,option or symbol." ms1)))))) nil) (checkdoc-create-error (format - "Argument `%s' should appear (as `%s') in the doc string" + "Argument `%s' should appear (as %s) in the doc string" (car args) (upcase (car args))) s (marker-position e))) (if (or (and order (eq order 'yes)) @@ -1723,8 +1751,8 @@ function,command,variable,option or symbol." ms1)))))) "Arguments occur in the doc string out of order" s (marker-position e) t))))) ;; * For consistency, phrase the verb in the first sentence of a - ;; documentation string for functions as an infinitive with - ;; "to" omitted. For instance, use `Return the cons of A and + ;; documentation string for functions as an imperative. + ;; For instance, use `Return the cons of A and ;; B.' in preference to `Returns the cons of A and B.' ;; Usually it looks good to do likewise for the rest of the ;; first paragraph. Subsequent paragraphs usually look better @@ -1734,7 +1762,7 @@ function,command,variable,option or symbol." ms1)))))) ;; it occurs last. (and checkdoc-verb-check-experimental-flag (save-excursion - ;; Maybe rebuild the monster-regex + ;; Maybe rebuild the monster-regexp (checkdoc-create-common-verbs-regexp) (let ((lim (save-excursion (end-of-line) @@ -1760,15 +1788,15 @@ function,command,variable,option or symbol." ms1)))))) (cdr rs))))) (if (checkdoc-autofix-ask-replace (match-beginning 1) (match-end 1) - (format "Use the infinitive for `%s'. \ -Replace with `%s'? " original replace) + (format "Use the imperative for \"%s\". \ +Replace with \"%s\"? " original replace) replace t) (setq rs nil))) (if rs ;; there was a match, but no replace (checkdoc-create-error (format - "Infinitive `%s' should be replaced with `%s'" + "Probably \"%s\" should be imperative \"%s\"" original replace) (match-beginning 1) (match-end 1)))))) ;; Done with functions @@ -1782,7 +1810,7 @@ Replace with `%s'? " original replace) (let ((found nil) (start (point)) (msg nil) (ms nil)) (while (and (not msg) (re-search-forward - "[^([`':a-zA-Z]\\(\\w+[:-]\\(\\w\\|\\s_\\)+\\)[^]']" + "[^-([`':a-zA-Z]\\(\\w+[:-]\\(\\w\\|\\s_\\)+\\)[^]']" e t)) (setq ms (match-string 1)) (save-match-data @@ -1821,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 `...' quotes" (match-beginning 1) (match-end 1))))) ;; Here is some basic sentence formatting (checkdoc-sentencespace-region-engine (point) e) @@ -1868,7 +1896,7 @@ from the comment." ;; Interactive (save-excursion (setq ret (cons - (re-search-forward "(interactive" + (re-search-forward "^\\s-*(interactive" (save-excursion (end-of-defun) (point)) t) ret))) @@ -2019,35 +2047,35 @@ If the offending word is in a piece of quoted text, then it is skipped." (progn (set-syntax-table checkdoc-syntax-table) (goto-char begin) - (while (re-search-forward "[^.0-9]\\(\\. \\)[^ \n]" end t) + (while (re-search-forward "[^ .0-9]\\(\\. \\)[^ \n]" end t) (let ((b (match-beginning 1)) (e (match-end 1))) - (if (and (not (checkdoc-in-sample-code-p begin end)) - (not (checkdoc-in-example-string-p begin end)) - (not (save-excursion - (goto-char (match-beginning 1)) - (condition-case nil - (progn - (forward-sexp -1) - ;; piece of an abbreviation - (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))))))) + (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 + (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)) (if errtxt (checkdoc-create-error errtxt bb be)))))) @@ -2232,7 +2260,7 @@ Code:, and others referenced in the style guide." ((or (re-search-forward "^;;; History" nil t) (re-search-forward "^;;; Code" nil t) (re-search-forward "^(require" nil t) - (re-search-forward "^(")) + (re-search-forward "^(" nil t)) (beginning-of-line))) (if (checkdoc-y-or-n-p "You should have a \";;; Commentary:\", add one? ") @@ -2261,7 +2289,7 @@ Code:, and others referenced in the style guide." (re-search-forward "^;;\\s-*\n\\|^\n" nil t)) ((or (re-search-forward "^;;; Code" nil t) (re-search-forward "^(require" nil t) - (re-search-forward "^(")) + (re-search-forward "^(" nil t)) (beginning-of-line))) (if (checkdoc-y-or-n-p "You should have a \";;; History:\", add one? ") @@ -2313,60 +2341,21 @@ Code:, and others referenced in the style guide." (1- (point-max)) (point-max))))) err)) ;; The below checks will not return errors if the user says NO - - ;; Ok, now let's look for multiple occurrences of ;;;, and offer - ;; to remove the extra ";" if applicable. This pre-supposes - ;; that the user has semiautomatic fixing on to be useful. - - ;; In the info node (elisp)Library Headers a header is three ; - ;; (the header) followed by text of only two ; - ;; In (elisp)Comment Tips, however it says this: - ;; * Another use for triple-semicolon comments is for commenting out - ;; lines within a function. We use triple-semicolons for this - ;; precisely so that they remain at the left margin. - (let ((msg nil)) - (goto-char (point-min)) - (while (and checkdoc-triple-semi-comment-check-flag - (not msg) (re-search-forward "^;;;[^;]" nil t)) - ;; We found a triple, let's check all following lines. - (if (not (bolp)) (progn (beginning-of-line) (forward-line 1))) - (let ((complex-replace t) - (dont-replace nil)) - (while (looking-at ";;\\(;\\)[^;#]") - (if (and (not dont-replace) - (checkdoc-outside-major-sexp) ;in code is ok. - (checkdoc-autofix-ask-replace - (match-beginning 1) (match-end 1) - "Multiple occurrences of ;;; found. Use ;; instead? " - "" complex-replace)) - ;; Learn that, yea, the user did want to do this a - ;; whole bunch of times. - (setq complex-replace nil) - ;; In this case, skip all this crap - (setq dont-replace t)) - (beginning-of-line) - (forward-line 1))))) ;; Let's spellcheck the commentary section. This is the only ;; section that is easy to pick out, and it is also the most ;; visible section (with the finder). (let ((cm (lm-commentary-mark))) - (if cm - (save-excursion - (goto-char (lm-commentary-mark)) - ;; Spellcheck between the commentary, and the first - ;; non-comment line. We could use lm-commentary, but that - ;; returns a string, and Ispell wants to talk to a buffer. - ;; Since the comments talk about Lisp, use the specialized - ;; spell-checker we also used for doc strings. - (let ((e (save-excursion (re-search-forward "^[^;]" nil t) - (point)))) - (checkdoc-sentencespace-region-engine (point) e) - (checkdoc-proper-noun-region-engine (point) e) - (checkdoc-ispell-docstring-engine e))))) -;;; test comment out code -;;; (foo 1 3) -;;; (bar 5 7) + (when cm + (save-excursion + (goto-char cm) + (let ((e (copy-marker (lm-commentary-end)))) + ;; Since the comments talk about Lisp, use the + ;; specialized spell-checker we also used for doc + ;; strings. + (checkdoc-sentencespace-region-engine (point) e) + (checkdoc-proper-noun-region-engine (point) e) + (checkdoc-ispell-docstring-engine e))))) (setq err (or @@ -2397,7 +2386,7 @@ The default boundary is the entire buffer." (while (setq type (checkdoc-message-text-next-string end)) (setq e (checkdoc-message-text-engine type))) e)) - + (defun checkdoc-message-text-next-string (end) "Move cursor to the next checkable message string after point. Return the message classification. @@ -2494,22 +2483,22 @@ 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 text should end with \"? \". Fix? " + "`y-or-n-p' argument should end with \"? \". Fix? " "? " t) nil (checkdoc-create-error - "y-or-n-p text should end with \"? \"" + "`y-or-n-p' argument should end with \"? \"" (match-beginning 0) (match-end 0))) (if (save-excursion (forward-sexp 1) (forward-char -2) (looking-at " ")) (if (checkdoc-autofix-ask-replace (match-beginning 0) (match-end 0) - "y-or-n-p text should end with \"? \". Fix? " + "`y-or-n-p' argument should end with \"? \". Fix? " "? " t) nil (checkdoc-create-error - "y-or-n-p text should end with \"? \"" + "`y-or-n-p' argument should end with \"? \"" (match-beginning 0) (match-end 0))) (if (and ;; if this isn't true, we have a problem. (save-excursion (forward-sexp 1) @@ -2517,11 +2506,11 @@ 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 text should end with \"? \". Fix? " + "`y-or-n-p' argument should end with \"? \". Fix? " "? \"" t)) nil (checkdoc-create-error - "y-or-n-p text should end with \"? \"" + "`y-or-n-p' argument should end with \"? \"" (match-beginning 0) (match-end 0))))))) ;; Now, let's just run the spell checker on this guy. (checkdoc-ispell-docstring-engine (save-excursion (forward-sexp 1) @@ -2591,92 +2580,52 @@ This function will not modify `match-data'." ;;; Warning management ;; (defvar checkdoc-output-font-lock-keywords - '(("\\(\\w+\\.el\\): \\(\\w+\\)" + '(("^\\*\\*\\* \\(.+\\.el\\): \\([^ \n]+\\)" (1 font-lock-function-name-face) - (2 font-lock-comment-face)) - ("^\\(\\w+\\.el\\):" 1 font-lock-function-name-face) - (":\\([0-9]+\\):" 1 font-lock-constant-face)) + (2 font-lock-comment-face))) "Keywords used to highlight a checkdoc diagnostic buffer.") -(defvar checkdoc-output-mode-map nil - "Keymap used in `checkdoc-output-mode'.") +(defvar checkdoc-output-error-regex-alist + '(("^\\(.+\\.el\\):\\([0-9]+\\): " 1 2))) (defvar checkdoc-pending-errors nil "Non-nil when there are errors that have not been displayed yet.") -(if checkdoc-output-mode-map - nil - (setq checkdoc-output-mode-map (make-sparse-keymap)) - (if (not (string-match "XEmacs" emacs-version)) - (define-key checkdoc-output-mode-map [mouse-2] - 'checkdoc-find-error-mouse)) - (define-key checkdoc-output-mode-map "\C-c\C-c" 'checkdoc-find-error) - (define-key checkdoc-output-mode-map "\C-m" 'checkdoc-find-error)) - -(defun checkdoc-output-mode () - "Create and setup the buffer used to maintain checkdoc warnings. -\\\\[checkdoc-find-error] - Go to this error location -\\[checkdoc-find-error-mouse] - Goto the error clicked on." - (if (get-buffer checkdoc-diagnostic-buffer) - (get-buffer checkdoc-diagnostic-buffer) - (save-excursion - (set-buffer (get-buffer-create checkdoc-diagnostic-buffer)) - (kill-all-local-variables) - (setq mode-name "Checkdoc" - major-mode 'checkdoc-output-mode) - (set (make-local-variable 'font-lock-defaults) - '((checkdoc-output-font-lock-keywords) t t ((?- . "w") (?_ . "w")))) - (use-local-map checkdoc-output-mode-map) - (run-hooks 'checkdoc-output-mode-hook) - (current-buffer)))) - -(defun checkdoc-find-error-mouse (e) - ;; checkdoc-params: (e) - "Call `checkdoc-find-error' where the user clicks the mouse." - (interactive "e") - (mouse-set-point e) - (checkdoc-find-error)) - -(defun checkdoc-find-error () - "In a checkdoc diagnostic buffer, find the error under point." - (interactive) - (beginning-of-line) - (if (looking-at "\\(\\(\\w+\\|\\s_\\)+\\.el\\):\\([0-9]+\\):") - (let ((l (string-to-int (match-string 3))) - (f (match-string 1))) - (if (not (get-buffer f)) - (error "Can't find buffer %s" f)) - (switch-to-buffer-other-window (get-buffer f)) - (goto-line l)))) +(define-derived-mode checkdoc-output-mode compilation-mode "Checkdoc" + "Set up the major mode for the buffer containing the list of errors." + (set (make-local-variable 'compilation-error-regexp-alist) + checkdoc-output-error-regex-alist) + (set (make-local-variable 'compilation-mode-font-lock-keywords) + checkdoc-output-font-lock-keywords)) (defun checkdoc-buffer-label () "The name to use for a checkdoc buffer in the error list." (if (buffer-file-name) - (file-name-nondirectory (buffer-file-name)) + (file-relative-name (buffer-file-name)) (concat "#"))) (defun checkdoc-start-section (check-type) "Initialize the checkdoc diagnostic buffer for a pass. Create the header so that the string CHECK-TYPE is displayed as the function called to create the messages." - (checkdoc-output-to-error-buffer - "\n\n\C-l\n*** " - (checkdoc-buffer-label) ": " check-type " V " checkdoc-version)) + (let ((dir default-directory) + (label (checkdoc-buffer-label))) + (with-current-buffer (get-buffer-create checkdoc-diagnostic-buffer) + (checkdoc-output-mode) + (setq default-directory dir) + (goto-char (point-max)) + (insert "\n\n\C-l\n*** " label ": " check-type " V " checkdoc-version)))) (defun checkdoc-error (point msg) "Store POINT and MSG as errors in the checkdoc diagnostic buffer." (setq checkdoc-pending-errors t) - (checkdoc-output-to-error-buffer - "\n" (checkdoc-buffer-label) ":" - (int-to-string (count-lines (point-min) (or point 1))) ": " - msg)) - -(defun checkdoc-output-to-error-buffer (&rest text) - "Place TEXT into the checkdoc diagnostic buffer." - (save-excursion - (set-buffer (checkdoc-output-mode)) - (goto-char (point-max)) - (apply 'insert text))) + (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)) + (apply 'insert text)))) (defun checkdoc-show-diagnostics () "Display the checkdoc diagnostic buffer in a temporary window." @@ -2701,6 +2650,13 @@ function called to create the messages." (custom-add-option 'emacs-lisp-mode-hook (lambda () (checkdoc-minor-mode 1))) +(add-to-list 'debug-ignored-errors + "Argument `.*' should appear (as .*) in the doc string") +(add-to-list 'debug-ignored-errors + "Lisp symbol `.*' should appear in quotes") +(add-to-list 'debug-ignored-errors "Disambiguate .* by preceding .*") + (provide 'checkdoc) +;;; arch-tag: c49a7ec8-3bb7-46f2-bfbc-d5f26e033b26 ;;; checkdoc.el ends here