Mercurial > emacs
changeset 22674:f72e7540940a
(checkdoc): Updated commentary.
(checkdoc-autofix-flag): Updated doc.
(checkdoc-force-docstrings-flag): Updated doc.
(checkdoc-force-history-flag): New flag.
(checkdoc-triple-semi-comment-check-flag): Fixed name.
(checkdoc-spellcheck-documentation-flag): Fixed doc.
(checkdoc-ispell-lisp-words): Update default value.
(checkdoc-generate-compile-warnings-flag, checkdoc-proper-noun-list,
checkdoc-proper-noun-regexp, checkdoc-symbol-words): New variables.
(princ-list): Function created if it isn't bound.
(checkdoc-interactive): parts removed to `checkdoc-interactive-loop'.
(checkdoc,checkdoc-message-interactive): New function.
(checkdoc-interactive-loop): was in `checkdoc-interactive', then
added better keybindings, and better autofixing behavior,
Cursor now sits next to the error, forcing scrolling if needed,
and using a better centering algorithm, and much better error
navigation after choosing "f"ix.
(checkdoc-next-error): Added parameter ENABLE-FIX.
(checkdoc-next-message-error,checkdoc-recursive-edit): New functions.
(checkdoc-start): was `checkdoc', uses new note taking system.
(checkdoc-current-buffer, checkdoc-continue, checkdoc-comments):
Updated to use new note taking system.
(checkdoc-rogue-spaces, checkdoc-rogue-space-check-engine):
Added INTERACT parameter, uses new warnings functions.
(checkdoc-message-text, checkdoc-defun):
Updated to use new note taking system.
(checkdoc-ispell-current-buffer, checkdoc-ispell-interactive): fix doc.
(checkdoc-ispell-message-text, checkdoc-ispell-start): New function.
(checkdoc-create-error, checkdoc-error-text, checkdoc-error-start,
checkdoc-error-end, checkdoc-error-unfixable): New functions.
(checkdoc-minor-keymap): Updated keybinds to new interactive functions,
completely re-arranged the minor-mode menu.
(checkdoc-this-string-valid): Moved no doc-string warning here,
and added autofix if a comment already exists there.
(checkdoc-this-string-valid-engine): fix doc, robusted doc finder.
All previously returned errors now call `checkdoc-create-error'.
Moved no doc string warning out. Update allowed punctuation at
end of first line. Fixed up sentence joining. Verb checking flag
now only checks the first line of a function. Added more safe
conditions to ambiguous symbols. Moved symbol quoting to end.
Added autofix for variables that should end in `-flag'.
Replaced use of `y-or-n-p' with `checkdoc-y-or-n-p'.
Reading checkdoc-param comment no longer depends on list syntax.
Fixed various error string spelling & format.
(checkdoc-in-sample-code-p): List starting with all caps word is
now condsidered sample code.
(checkdoc-in-example-string-p, checkdoc-proper-noun-region-engine,
checkdoc-sentencespace-region-engine): New functions.
(checkdoc-ispell-docstring-engine): Disable spell checking during
if user never wants interaction. We don't have a non-interactive
spell checking method yet.
(checkdoc-file-comments-engine): Now set up to check all possible
conditions even after encountering an error. Added auto-fixes
for history and commentary. All previously returned errors now call
`checkdoc-create-error'. Message spelling and format.
(checkdoc-message-text-search):
Moved parts to `checkdoc-message-text-next-string'.
(checkdoc-message-text-next-string): New function
(checkdoc-message-text-engine): All previously returned errors
now call `checkdoc-create-error'. Can find/skip 'format' call
after the call we are checking. Added sentence/propernoun scans.
`y-or-n-p' checks and fixes are now more robust.
(checkdoc-y-or-n-p): New function.
(checkdoc-autofix-ask-replace): Update doc. Protect match-data.
Correctly handle `checkdoc-autofix-flag' of 'never. New behavior
with `checkdoc-autofix-flag' of 'automatic-then-never. Better
overlay handling.
(checkdoc-output-font-lock-keywords): Updated to new output format.
(checkdoc-pending-errors): New variable.
(checkdoc-find-error): Updated to new output format.
(checkdoc-start-section, checkdoc-error): Improved the output.
(checkdoc-show-diagnostics): Smarter show algorithm.
| author | Eric M. Ludlam <zappo@gnu.org> |
|---|---|
| date | Fri, 03 Jul 1998 15:15:27 +0000 |
| parents | e61968818555 |
| children | cbab915f61bb |
| files | lisp/emacs-lisp/checkdoc.el |
| diffstat | 1 files changed, 1368 insertions(+), 562 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/emacs-lisp/checkdoc.el Fri Jul 03 04:39:22 1998 +0000 +++ b/lisp/emacs-lisp/checkdoc.el Fri Jul 03 15:15:27 1998 +0000 @@ -3,7 +3,7 @@ ;;; Copyright (C) 1997, 1998 Free Software Foundation ;; Author: Eric M. Ludlam <zappo@gnu.org> -;; Version: 0.5.1 +;; Version: 0.6.1 ;; Keywords: docs, maint, lisp ;; This file is part of GNU Emacs. @@ -32,8 +32,9 @@ ;; checks needed to make sure these styles are remembered. ;; ;; There are two ways to use checkdoc: -;; 1) Periodically use `checkdoc'. `checkdoc-current-buffer' and -;; `checkdoc-defun' to check your documentation. +;; 1) Periodically use `checkdoc' or `checkdoc-current-buffer'. +;; `checkdoc' is a more interactive version of +;; `checkdoc-current-buffer' ;; 2) Use `checkdoc-minor-mode' to automatically check your ;; documentation whenever you evaluate Lisp code with C-M-x ;; or [menu-bar emacs-lisp eval-buffer]. Additional key-bindings @@ -42,6 +43,34 @@ ;; (add-hook 'emacs-lisp-mode-hook ;; '(lambda () (checkdoc-minor-mode 1))) ;; +;; Using `checkdoc': +;; +;; The commands `checkdoc' and `checkdoc-ispell' are the top-level +;; entry points to all of the different checks that are available. It +;; breaks examination of your Lisp file into four sections (comments, +;; documentation, messages, and spacing) and indicates its current +;; state in a status buffer. +;; +;; The Comments check examines your headers, footers, and +;; various tags (such as "Code:") to make sure that your code is ready +;; for easy integration into existing systems. +;; +;; The Documentation check deals with documentation strings +;; and their elements that help make Emacs easier to use. +;; +;; The Messages check ensures that the strings displayed in the +;; minibuffer by some commands (such as `error' and `y-or-n-p') +;; are consistent with the Emacs environment. +;; +;; The Spacing check cleans up white-space at the end of lines. +;; +;; The interface while working with documentation and messages is +;; slightly different when being run in the interactive mode. The +;; interface offers several options, including the ability to skip to +;; the next error, or back up to previous errors. Auto-fixing is +;; turned off at this stage, but you can use the `f' or `F' key to fix +;; a given error (if the fix is available.) +;; ;; Auto-fixing: ;; ;; There are four classifications of style errors in terms of how @@ -57,7 +86,7 @@ ;; variable `checkdoc-autofix-flag' controls how these types of errors ;; are fixed. ;; -;; Spell checking doc strings: +;; Spell checking text: ;; ;; The variable `checkdoc-spellcheck-documentation-flag' can be set ;; to customize how spell checking is to be done. Since spell @@ -74,7 +103,7 @@ ;; running. Use `ispell-kill-ispell' to make checkdoc restart it with ;; these words enabled. ;; -;; Checking parameters +;; Checking parameters: ;; ;; You might not always want a function to have its parameters listed ;; in order. When this is the case, put the following comment just in @@ -87,9 +116,9 @@ ;; skip looking for it by putting the following comment just in front ;; of the documentation string: "; checkdoc-params: (args go here)" ;; -;; Checking message strings +;; Checking message strings: ;; -;; The text that follows the `error', and `y-or-n-p' commands is +;; The text that follows the `error' and `y-or-n-p' commands is ;; also checked. The documentation for `error' clearly states some ;; simple style rules to follow which checkdoc will auto-fix for you. ;; `y-or-n-p' also states that it should end in a space. I added that @@ -102,11 +131,36 @@ ;; Return a string which is the error you wish to report. The cursor ;; position should be preserved. ;; -;; This file requires lisp-mnt (Lisp maintenance routines) for the -;; comment checkers. +;; Error errors: +;; +;; Checkdoc does not always flag errors correctly. There are a +;; couple ways you can coax your file into passing all of checkdoc's +;; tests through buffer local variables. +;; +;; The variable `checkdoc-verb-check-experimental-flag' can be used +;; to turn off the check for verb-voice in case you use words that are +;; not semantically verbs, but are still in the incomplete list. +;; +;; The variable `checkdoc-symbol-words' can be a list of words that +;; happen to also be symbols. This is not a problem for one-word +;; symbols, but if you use a hyphenated word that is also a symbol, +;; then you may need this. +;; +;; The symbol `checkdoc-force-docstrings-flag' can be set to nil if +;; you have many undocumented functions you don't wish to document. +;; +;; See the above section "Checking Parameters" for details about +;; parameter checking. +;; +;; Dependencies: +;; +;; This file requires lisp-mnt (Lisp maintenance routines) for the +;; comment checkers. +;; +;; Requires custom for Emacs v20. ;;; TO DO: -;; Hook into the byte compiler on a defun/defver level to generate +;; Hook into the byte compiler on a defun/defvar level to generate ;; warnings in the byte-compiler's warning/error buffer. ;; Better ways to override more typical `eval' functions. Advice ;; might be good but hard to turn on/off as a minor mode. @@ -117,7 +171,7 @@ ;; not specifically docstring related. Would this even be useful? ;;; Code: -(defvar checkdoc-version "0.5.1" +(defvar checkdoc-version "0.6.1" "Release version of checkdoc you are currently running.") ;; From custom web page for compatibility between versions of custom: @@ -140,7 +194,7 @@ If this value is the symbol `query', then the user is queried before any change is made. If the value is `automatic', then all changes are made without asking unless the change is very-complex. If the value -is `semiautomatic', or any other value, then simple fixes are made +is `semiautomatic' or any other value, then simple fixes are made 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 @@ -159,12 +213,27 @@ (defcustom checkdoc-force-docstrings-flag t "*Non-nil means that all checkable definitions should have documentation. Style guide dictates that interactive functions MUST have documentation, -and that its good but not required practice to make non user visible items +and that it's good but not required practice to make non user visible items have doc strings." :group 'checkdoc :type 'boolean) -(defcustom checkdoc-tripple-semi-comment-check-flag t +(defcustom checkdoc-force-history-flag t + "*Non-nil means that files should have a History section or ChangeLog file. +This helps document the evolution of, and recent changes to, the package." + :group 'checkdoc + :type 'boolean) + +(defcustom checkdoc-permit-comma-termination-flag nil + "*Non-nil means the first line of a docstring may end with a comma. +Ordinarily, a full sentence is required. This may be misleading when +there is a substantial caveat to the one-line description -- the comma +should be used when the first part could stand alone as a sentence, but +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: @@ -178,14 +247,14 @@ :type 'boolean) (defcustom checkdoc-spellcheck-documentation-flag nil - "*Non-nil means run Ispell on doc strings based on value. + "*Non-nil means run Ispell on text based on value. This is automatically set to nil if Ispell does not exist on your system. Possible values are: nil - Don't spell-check during basic style checks. defun - Spell-check when style checking a single defun - buffer - Spell-check only when style checking the whole buffer - interactive - Spell-check only during `checkdoc-interactive' + buffer - Spell-check when style checking the whole buffer + interactive - Spell-check during any interactive check. t - Always spell-check" :group 'checkdoc :type '(choice (const nil) @@ -195,7 +264,7 @@ (const t))) (defvar checkdoc-ispell-lisp-words - '("alist" "etags" "iff" "keymap" "paren" "regexp" "sexp" "emacs" "xemacs") + '("alist" "emacs" "etags" "iff" "keymap" "paren" "regexp" "sexp" "xemacs") "List of words that are correct when spell-checking Lisp documentation.") (defcustom checkdoc-max-keyref-before-warn 10 @@ -244,6 +313,31 @@ :group 'checkdoc :type 'boolean) +(defvar checkdoc-generate-compile-warnings-flag nil + "Non-nil means generage warnings in a buffer for browsing. +Do not set this by hand, use a function like `checkdoc-current-buffer' +with a universal argument.") + +(defcustom checkdoc-symbol-words nil + "A list of symbols which also happen to make good words. +These symbol-words are ignored when unquoted symbols are searched for. +This should be set in an Emacs Lisp file's local variables." + :group 'checkdoc + :type '(repeat (symbol :tag "Word"))) + +(defvar checkdoc-proper-noun-list + '("ispell" "xemacs" "emacs" "lisp") + "List of words (not capitalized) which should be capitalized.") + +(defvar checkdoc-proper-noun-regexp + (let ((expr "\\<\\(") + (l checkdoc-proper-noun-list)) + (while l + (setq expr (concat expr (car l) (if (cdr l) "\\|" "")) + l (cdr l))) + (concat expr "\\)\\>")) + "Regular expression derived from `checkdoc-proper-noun-regexp'.") + (defvar checkdoc-common-verbs-regexp nil "Regular expression derived from `checkdoc-common-verbs-regexp'.") @@ -338,7 +432,7 @@ (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 encompased + ;; 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) @@ -366,7 +460,13 @@ (defalias 'checkdoc-call-eval-buffer 'eval-current-buffer) ) -;; Emacs 20s have MULE characters which dont equate to numbers. +;; 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= '=)) @@ -390,6 +490,329 @@ ;;; 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 +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))) + ;; if the user set autofix to never, then that breaks the + ;; obviously requested asking implied by using this function. + ;; Set it to paranoia level. + (checkdoc-autofix-flag (if (or (not checkdoc-autofix-flag) + (eq checkdoc-autofix-flag 'never)) + 'query + checkdoc-autofix-flag)) + tmp) + (checkdoc-display-status-buffer status) + ;; check the comments + (if (not buffer-file-name) + (setcar status "Not checked") + (if (checkdoc-file-comments-engine) + (setcar status "Errors") + (setcar status "Ok"))) + (setcar (cdr status) "Checking...") + (checkdoc-display-status-buffer status) + ;; Check the documentation + (setq tmp (checkdoc-interactive nil t)) + (if tmp + (setcar (cdr status) (format "%d Errors" (length tmp))) + (setcar (cdr status) "Ok")) + (setcar (cdr (cdr status)) "Checking...") + (checkdoc-display-status-buffer status) + ;; Check the message text + (if (setq tmp (checkdoc-message-interactive nil t)) + (setcar (cdr (cdr status)) (format "%d Errors" (length tmp))) + (setcar (cdr (cdr status)) "Ok")) + (setcar (cdr (cdr (cdr status))) "Checking...") + (checkdoc-display-status-buffer status) + ;; Rogue spacing + (if (condition-case nil + (checkdoc-rogue-spaces nil t) + (error t)) + (setcar (cdr (cdr (cdr status))) "Errors") + (setcar (cdr (cdr (cdr status))) "Ok")) + (checkdoc-display-status-buffer status))) + +(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) + )) + (shrink-window-if-larger-than-buffer + (get-buffer-window " *Checkdoc Status*")) + (message nil) + (sit-for 0)) + +;;;###autoload +(defun checkdoc-interactive (&optional start-here showstatus) + "Interactively check the current buffer for doc string errors. +Prefix argument START-HERE will start the checking from the current +point, otherwise the check starts at the beginning of the current +buffer. Allows navigation forward and backwards through document +errors. Does not check for comment or space warnings. +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))) + +;;;###autoload +(defun checkdoc-message-interactive (&optional start-here showstatus) + "Interactively check the current buffer for message string errors. +Prefix argument START-HERE will start the checking from the current +point, otherwise the check starts at the beginning of the current +buffer. Allows navigation forward and backwards through document +errors. Does not check for comment or space warnings. +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))) + +(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. +FINDFUNC is a symbol representing a function that will position the +cursor, and return error message text to present the 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." + ;; Determine where to start the test + (let* ((begin (prog1 (point) + (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))) + ;; Fetch the error list + (err-list (list (funcall findfunc nil))) + (cdo nil) + (returnme nil) + c) + (save-window-excursion + (if (not (car err-list)) (setq err-list nil)) + ;; Include whatever function point is in for good measure. + (beginning-of-defun) + (while err-list + (goto-char (cdr (car err-list))) + ;; The cursor should be just in front of the offending doc string + (if (stringp (car (car err-list))) + (setq cdo (save-excursion (checkdoc-make-overlay + (point) (progn (forward-sexp 1) + (point))))) + (setq cdo (checkdoc-make-overlay + (checkdoc-error-start (car (car err-list))) + (checkdoc-error-end (car (car err-list)))))) + (unwind-protect + (progn + (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))) + (message "%s (C-h,%se,n,p,q)" (checkdoc-error-text + (car (car err-list))) + (if (checkdoc-error-unfixable (car (car err-list))) + "" "f,")) + (save-excursion + (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 + (if (not (integerp c)) (setq c ??)) + (cond + ;; Exit condition + ((checkdoc-char= c ?\C-g) (signal 'quit nil)) + ;; Request an auto-fix + ((or (checkdoc-char= c ?y) (checkdoc-char= c ?f)) + (checkdoc-delete-overlay cdo) + (setq cdo nil) + (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 + ;; the checker to return a different error. + (let ((checkdoc-autofix-flag 'automatic-then-never) + (fixed nil)) + (funcall findfunc t) + (setq fixed (not (eq checkdoc-autofix-flag + 'automatic-then-never))) + (if (not fixed) + (progn + (message "A Fix was not available.") + (sit-for 2)) + (setq err-list (cdr err-list)))) + (beginning-of-defun) + (let ((pe (car err-list)) + (ne (funcall findfunc nil))) + (if ne + (setq err-list (cons ne err-list)) + (cond ((not err-list) + (message "No More Stylistic Errors.") + (sit-for 2)) + (t + (message + "No Additional style errors. Continuing...") + (sit-for 2)))))) + ;; Move to the next error (if available) + ((or (checkdoc-char= c ?n) (checkdoc-char= c ?\ )) + (let ((ne (funcall findfunc nil))) + (if (not ne) + (if showstatus + (setq returnme err-list + err-list nil) + (if (not err-list) + (message "No More Stylistic Errors.") + (message "No Additional style errors. Continuing...")) + (sit-for 2)) + (setq err-list (cons ne err-list))))) + ;; Go backwards in the list of errors + ((or (checkdoc-char= c ?p) (checkdoc-char= c ?\C-?)) + (if (/= (length err-list) 1) + (progn + (setq err-list (cdr err-list)) + (goto-char (cdr (car err-list))) + (beginning-of-defun)) + (message "No Previous Errors.") + (sit-for 2))) + ;; Edit the buffer recursively. + ((checkdoc-char= c ?e) + (checkdoc-recursive-edit + (checkdoc-error-text (car (car err-list)))) + (checkdoc-delete-overlay cdo) + (setq err-list (cdr err-list)) ;back up the error found. + (beginning-of-defun) + (let ((ne (funcall findfunc nil))) + (if (not ne) + (if showstatus + (setq returnme err-list + err-list nil) + (message "No More Stylistic Errors.") + (sit-for 2)) + (setq err-list (cons ne err-list))))) + ;; Quit checkdoc + ((checkdoc-char= c ?q) + (setq returnme err-list + err-list nil + begin (point))) + ;; Goofy s tuff + (t + (if (get-buffer-window "*Checkdoc Help*") + (progn + (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\ + 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.")) + (shrink-window-if-larger-than-buffer + (get-buffer-window "*Checkdoc Help*")))))) + (if cdo (checkdoc-delete-overlay cdo))))) + (goto-char begin) + (if (get-buffer "*Checkdoc Help*") (kill-buffer "*Checkdoc Help*")) + (message "Checkdoc: Done.") + returnme)) + +(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. +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." + (if enable-fix + (checkdoc-this-string-valid) + (let ((msg nil) (p (point)) + (checkdoc-autofix-flag nil)) + (condition-case nil + (while (and (not msg) (checkdoc-next-docstring)) + (message "Searching for doc string error...%d%%" + (/ (* 100 (point)) (point-max))) + (if (setq msg (checkdoc-this-string-valid)) + (setq msg (cons msg (point))))) + ;; Quit.. restore position, Other errors, leave alone + (quit (goto-char p))) + msg))) + +(defun checkdoc-next-message-error (enable-fix) + "Find and return the next checkdoc mesasge 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 +assumes that the cursor is already positioned to perform the fix." + (if enable-fix + (checkdoc-message-text-engine) + (let ((msg nil) (p (point)) (type nil) + (checkdoc-autofix-flag nil)) + (condition-case nil + (while (and (not msg) + (setq type + (checkdoc-message-text-next-string (point-max)))) + (message "Searching for message string error...%d%%" + (/ (* 100 (point)) (point-max))) + (if (setq msg (checkdoc-message-text-engine type)) + (setq msg (cons msg (point))))) + ;; Quit.. restore position, Other errors, leave alone + (quit (goto-char p))) + msg))) + +(defun checkdoc-recursive-edit (msg) + "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.")) + (shrink-window-if-larger-than-buffer + (get-buffer-window "*Checkdoc Help*")) + (message "When you're done editing press C-M-c to continue.") + (unwind-protect + (recursive-edit) + (if (get-buffer-window "*Checkdoc Help*") + (progn + (delete-window (get-buffer-window "*Checkdoc Help*")) + (kill-buffer "*Checkdoc Help*"))))) + +;;;###autoload (defun checkdoc-eval-current-buffer () "Evaluate and check documentation for the current buffer. Evaluation is done first because good documentation for something that @@ -409,120 +832,35 @@ (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)))) + (memq checkdoc-spellcheck-documentation-flag '(buffer t))) + (checkdoc-autofix-flag (if take-notes 'never + checkdoc-autofix-flag)) + (checkdoc-generate-compile-warnings-flag + (or take-notes checkdoc-generate-compile-warnings-flag))) + (if take-notes + (checkdoc-start-section "checkdoc-current-buffer")) ;; every test is responsible for returning the cursor. (or (and buffer-file-name ;; only check comments in a file - (checkdoc-comments take-notes)) - (checkdoc take-notes) - (checkdoc-message-text take-notes) - (checkdoc-rogue-spaces take-notes) + (checkdoc-comments)) + (checkdoc-start) + (checkdoc-message-text) + (checkdoc-rogue-spaces) (not (interactive-p)) + (if take-notes (checkdoc-show-diagnostics)) (message "Checking buffer for style...Done.")))) ;;;###autoload -(defun checkdoc-interactive (&optional start-here) - "Interactively check the current buffers for errors. -Prefix argument START-HERE will start the checking from the current -point, otherwise the check starts at the beginning of the current -buffer. Allows navigation forward and backwards through document -errors. Does not check for comment or space warnings." - (interactive "P") - ;; Determine where to start the test - (let* ((begin (prog1 (point) - (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))) - ;; Fetch the error list - (err-list (list (checkdoc-next-error)))) - (if (not (car err-list)) (setq err-list nil)) - ;; Include whatever function point is in for good measure. - (beginning-of-defun) - (while err-list - (goto-char (cdr (car err-list))) - ;; The cursor should be just in front of the offending doc string - (let ((cdo (save-excursion - (checkdoc-make-overlay (point) - (progn (forward-sexp 1) - (point))))) - c) - (unwind-protect - (progn - (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))) - (recenter)) - (message "%s(? e n p q)" (car (car err-list))) - (setq c (checkdoc-read-event)) - (if (not (integerp c)) (setq c ??)) - (cond ((or (checkdoc-char= c ?n) (checkdoc-char= c ?\ )) - (let ((ne (checkdoc-next-error))) - (if (not ne) - (progn - (message "No More Stylistic Errors.") - (sit-for 2)) - (setq err-list (cons ne err-list))))) - ((or (checkdoc-char= c ?p) (checkdoc-char= c ?\C-?)) - (if (/= (length err-list) 1) - (progn - (setq err-list (cdr err-list)) - ;; This will just re-ask fixup questions if - ;; it was skipped the last time. - (checkdoc-next-error)) - (message "No Previous Errors.") - (sit-for 2))) - ((checkdoc-char= c ?e) - (message "Edit the docstring, and press C-M-c to exit.") - (recursive-edit) - (checkdoc-delete-overlay cdo) - (setq err-list (cdr err-list)) ;back up the error found. - (beginning-of-defun) - (let ((ne (checkdoc-next-error))) - (if (not ne) - (progn - (message "No More Stylistic Errors.") - (sit-for 2)) - (setq err-list (cons ne err-list))))) - ((checkdoc-char= c ?q) - (setq err-list nil - begin (point))) - (t - (message "[E]dit [SPC|n] next error [DEL|p] prev error\ - [q]uit [?] help: ") - (sit-for 5)))) - (checkdoc-delete-overlay cdo)))) - (goto-char begin) - (message "Checkdoc: Done."))) - -(defun checkdoc-next-error () - "Find and return the next checkdoc error list, or nil. -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." - (let ((msg nil) (p (point))) - (condition-case nil - (while (and (not msg) (checkdoc-next-docstring)) - (message "Searching for doc string error...%d%%" - (/ (* 100 (point)) (point-max))) - (if (setq msg (checkdoc-this-string-valid)) - (setq msg (cons msg (point))))) - ;; Quit.. restore position, Other errors, leave alone - (quit (goto-char p))) - msg)) - -;;;###autoload -(defun checkdoc (&optional take-notes) - "Use `checkdoc-continue' starting at the beginning of the current buffer. +(defun checkdoc-start (&optional take-notes) + "Start scanning the current buffer for documentation string style errors. +Only documentation strings are checked. +Use `checkdoc-continue' to continue checking if an error cannot be fixed. Prefix argument TAKE-NOTES means to collect all the warning messages into a separate buffer." (interactive "P") (let ((p (point))) (goto-char (point-min)) + (if (and take-notes (interactive-p)) + (checkdoc-start-section "checkdoc-start")) (checkdoc-continue take-notes) ;; Go back since we can't be here without success above. (goto-char p) @@ -530,37 +868,35 @@ ;;;###autoload (defun checkdoc-continue (&optional take-notes) - "Find the next docstring in the current buffer which is stylisticly poor. + "Find the next doc string in the current buffer which has a style error. Prefix argument TAKE-NOTES means to continue through the whole buffer and -save warnings in a separate buffer." +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) ;; Assign a flag to spellcheck flag (checkdoc-spellcheck-documentation-flag (member checkdoc-spellcheck-documentation-flag - '(buffer t)))) + '(buffer t))) + (checkdoc-autofix-flag (if take-notes 'never + checkdoc-autofix-flag)) + (checkdoc-generate-compile-warnings-flag + (or take-notes checkdoc-generate-compile-warnings-flag))) (save-excursion ;; If we are taking notes, encompass the whole buffer, otherwise ;; the user is navigating down through the buffer. - (if take-notes (checkdoc-start-section "checkdoc")) (while (and (not wrong) (checkdoc-next-docstring)) - ;; OK, lets look at the doc string. + ;; OK, let's look at the doc string. (setq msg (checkdoc-this-string-valid)) - (if msg - ;; Oops - (if take-notes - (progn - (checkdoc-error (point) msg) - (setq errors t)) - (setq wrong (point)))))) + (if msg (setq wrong (point))))) (if wrong (progn (goto-char wrong) - (error msg))) - (if (and take-notes errors) - (checkdoc-show-diagnostics) - (if (interactive-p) - (message "No style warnings."))))) + (if (not take-notes) + (error (checkdoc-error-text msg))))) + (checkdoc-show-diagnostics) + (if (interactive-p) + (message "No style warnings.")))) (defun checkdoc-next-docstring () "Move to the next doc string after point, and return t. @@ -586,36 +922,57 @@ (let* ((checkdoc-spellcheck-documentation-flag (member checkdoc-spellcheck-documentation-flag '(buffer t))) - (e (checkdoc-file-comments-engine))) - (if e - (if take-notes - (checkdoc-error nil e) - (error e))) - (if (and e take-notes) - (checkdoc-show-diagnostics)) + (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))) + (if e (error (checkdoc-error-text e))) + (checkdoc-show-diagnostics) e)) ;;;###autoload -(defun checkdoc-rogue-spaces (&optional take-notes) +(defun checkdoc-rogue-spaces (&optional take-notes interact) "Find extra spaces at the end of lines in the current file. Prefix argument TAKE-NOTES non-nil means to save warnings in a separate buffer. Otherwise print a message. This returns the error -if there is one." +if there is one. +Optional argument INTERACT permits more interactive fixing." (interactive "P") (if take-notes (checkdoc-start-section "checkdoc-rogue-spaces")) - (let ((e (checkdoc-rogue-space-check-engine))) - (if e - (if take-notes - (checkdoc-error nil e) - (message e))) - (if (and e take-notes) - (checkdoc-show-diagnostics)) + (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))) (if (not (interactive-p)) e - (if e (message e) (message "Space Check: done."))))) - + (if e + (message (checkdoc-error-text e)) + (checkdoc-show-diagnostics) + (message "Space Check: done."))))) ;;;###autoload +(defun checkdoc-message-text (&optional take-notes) + "Scan the buffer for occurrences of the error function, and verify text. +Optional argument TAKE-NOTES causes all errors to be logged." + (interactive "P") + (if take-notes (checkdoc-start-section "checkdoc-message-text")) + (let* ((p (point)) e + (checkdoc-autofix-flag (if take-notes 'never checkdoc-autofix-flag)) + (checkdoc-generate-compile-warnings-flag + (or take-notes checkdoc-generate-compile-warnings-flag))) + (setq e (checkdoc-message-text-search)) + (if (not (interactive-p)) + e + (if e + (error (checkdoc-error-text e)) + (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. Evaluation is done first so the form will be read before the @@ -638,7 +995,7 @@ (if (not (looking-at checkdoc-defun-regexp)) ;; I found this more annoying than useful. ;;(if (not no-error) - ;; (message "Cannot check this sexp's docstring.")) + ;; (message "Cannot check this sexp's doc string.")) nil ;; search drops us after the identifier. The next sexp is either ;; the argument list or the value of the variable. skip it. @@ -651,19 +1008,34 @@ (beg (save-excursion (beginning-of-defun) (point))) (end (save-excursion (end-of-defun) (point))) (msg (checkdoc-this-string-valid))) - (if msg (if no-error (message msg) (error msg)) + (if msg (if no-error + (message (checkdoc-error-text msg)) + (error (checkdoc-error-text msg))) (setq msg (checkdoc-message-text-search beg end)) - (if msg (if no-error (message msg) (error msg)) + (if msg (if no-error + (message (checkdoc-error-text msg)) + (error (checkdoc-error-text msg))) (setq msg (checkdoc-rogue-space-check-engine beg end)) - (if msg (if no-error (message msg) (error msg))))) + (if msg (if no-error + (message (checkdoc-error-text msg)) + (error (checkdoc-error-text msg)))))) (if (interactive-p) (message "Checkdoc: done.")))))) ;;; Ispell interface for forcing a spell check ;; ;;;###autoload +(defun checkdoc-ispell (&optional take-notes) + "Check the style and spelling of everything interactively. +Calls `checkdoc' with spell-checking turned on. +Prefix argument TAKE-NOTES is the same as for `checkdoc'" + (interactive) + (let ((checkdoc-spellcheck-documentation-flag t)) + (call-interactively 'checkdoc nil current-prefix-arg))) + +;;;###autoload (defun checkdoc-ispell-current-buffer (&optional take-notes) - "Check the style and spelling of the current buffer interactively. + "Check the style and spelling of the current buffer. Calls `checkdoc-current-buffer' with spell-checking turned on. Prefix argument TAKE-NOTES is the same as for `checkdoc-current-buffer'" (interactive) @@ -674,19 +1046,37 @@ (defun checkdoc-ispell-interactive (&optional take-notes) "Check the style and spelling of the current buffer interactively. Calls `checkdoc-interactive' with spell-checking turned on. -Prefix argument TAKE-NOTES is the same as for `checkdoc-interacitve'" +Prefix argument TAKE-NOTES is the same as for `checkdoc-interactive'" (interactive) (let ((checkdoc-spellcheck-documentation-flag t)) (call-interactively 'checkdoc-interactive nil current-prefix-arg))) ;;;###autoload -(defun checkdoc-ispell (&optional take-notes) - "Check the style and spelling of the current buffer. -Calls `checkdoc' with spell-checking turned on. -Prefix argument TAKE-NOTES is the same as for `checkdoc'" +(defun checkdoc-ispell-message-interactive (&optional take-notes) + "Check the style and spelling of message text interactively. +Calls `checkdoc-message-interactive' with spell-checking turned on. +Prefix argument TAKE-NOTES is the same as for `checkdoc-message-interactive'" (interactive) (let ((checkdoc-spellcheck-documentation-flag t)) - (call-interactively 'checkdoc nil current-prefix-arg))) + (call-interactively 'checkdoc-message-interactive nil current-prefix-arg))) + +;;;###autoload +(defun checkdoc-ispell-message-text (&optional take-notes) + "Check the style and spelling of message text interactively. +Calls `checkdoc-message-text' with spell-checking turned on. +Prefix argument TAKE-NOTES is the same as for `checkdoc-message-text'" + (interactive) + (let ((checkdoc-spellcheck-documentation-flag t)) + (call-interactively 'checkdoc-message-text nil current-prefix-arg))) + +;;;###autoload +(defun checkdoc-ispell-start (&optional take-notes) + "Check the style and spelling of the current buffer. +Calls `checkdoc-start' with spell-checking turned on. +Prefix argument TAKE-NOTES is the same as for `checkdoc-start'" + (interactive) + (let ((checkdoc-spellcheck-documentation-flag t)) + (call-interactively 'checkdoc-start nil current-prefix-arg))) ;;;###autoload (defun checkdoc-ispell-continue (&optional take-notes) @@ -715,6 +1105,45 @@ (let ((checkdoc-spellcheck-documentation-flag t)) (call-interactively 'checkdoc-defun nil current-prefix-arg))) +;;; Error Management +;; +;; Errors returned from checkdoc functions can have various +;; features and behaviors, so we need some ways of specifying +;; them, and making them easier to use in the wacked-out interfaces +;; people are requesting +(defun checkdoc-create-error (text start end &optional unfixable) + "Used to create the return error text returned from all engines. +TEXT is the descriptive text of the error. START and END define the region +it is sensible to highlight when describing the problem. +Optional argument UNFIXABLE means that the error has no auto-fix available. + +A list of the form (TEXT START END UNFIXABLE) is returned if we are not +generating a buffered list of errors." + (if checkdoc-generate-compile-warnings-flag + (progn (checkdoc-error start text) + nil) + (list text start end unfixable))) + +(defun checkdoc-error-text (err) + "Return the text specified in the checkdoc ERR." + ;; string-p part is for backwards compatibility + (if (stringp err) err (car err))) + +(defun checkdoc-error-start (err) + "Return the start point specified in the checkdoc ERR." + ;; string-p part is for backwards compatibility + (if (stringp err) nil (nth 1 err))) + +(defun checkdoc-error-end (err) + "Return the end point specified in the checkdoc ERR." + ;; string-p part is for backwards compatibility + (if (stringp err) nil (nth 2 err))) + +(defun checkdoc-error-unfixable (err) + "Return the t if we cannot autofix the error specified in the checkdoc ERR." + ;; string-p part is for backwards compatibility + (if (stringp err) nil (nth 3 err))) + ;;; Minor Mode specification ;; (defvar checkdoc-minor-mode nil @@ -728,21 +1157,24 @@ (pmap (make-sparse-keymap))) ;; Override some bindings (define-key map "\C-\M-x" 'checkdoc-eval-defun) + (define-key map "\C-x`" 'checkdoc-continue) (if (not (string-match "XEmacs" emacs-version)) (define-key map [menu-bar emacs-lisp eval-buffer] 'checkdoc-eval-current-buffer)) + ;; Add some new bindings under C-c ? (define-key pmap "x" 'checkdoc-defun) (define-key pmap "X" 'checkdoc-ispell-defun) (define-key pmap "`" 'checkdoc-continue) (define-key pmap "~" 'checkdoc-ispell-continue) + (define-key pmap "s" 'checkdoc-start) + (define-key pmap "S" 'checkdoc-ispell-start) (define-key pmap "d" 'checkdoc) (define-key pmap "D" 'checkdoc-ispell) - (define-key pmap "i" 'checkdoc-interactive) - (define-key pmap "I" 'checkdoc-ispell-interactive) (define-key pmap "b" 'checkdoc-current-buffer) (define-key pmap "B" 'checkdoc-ispell-current-buffer) (define-key pmap "e" 'checkdoc-eval-current-buffer) (define-key pmap "m" 'checkdoc-message-text) + (define-key pmap "M" 'checkdoc-ispell-message-text) (define-key pmap "c" 'checkdoc-comments) (define-key pmap "C" 'checkdoc-ispell-comments) (define-key pmap " " 'checkdoc-rogue-spaces) @@ -758,23 +1190,31 @@ (easy-menu-define checkdoc-minor-menu checkdoc-minor-keymap "Checkdoc Minor Mode Menu" '("CheckDoc" - ["First Style Error" checkdoc t] - ["First Style or Spelling Error " checkdoc-ispell t] + ["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 Style Check" checkdoc-interactive t] - ["Interactive Style and Spelling Check" checkdoc-ispell-interactive 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 Buffer" checkdoc-current-buffer t] - ["Check and Spell Buffer" checkdoc-ispell-current-buffer t] ["Check and Evaluate Buffer" checkdoc-eval-current-buffer t] - ["Check Comment Style" checkdoc-comments buffer-file-name] - ["Check Comment Style and Spelling" checkdoc-ispell-comments - buffer-file-name] - ["Check message text" checkdoc-message-text t] - ["Check for Rogue Spaces" checkdoc-rogue-spaces t] ))) ;; XEmacs requires some weird stuff to add this menu in a minor mode. ;; What is it? @@ -853,25 +1293,88 @@ (beginning-of-line) (skip-chars-forward " \n\t")) - (if (not (looking-at "[ \t\n]*\"")) - nil - (let ((old-syntax-table (syntax-table))) - (unwind-protect - (progn - (set-syntax-table checkdoc-syntax-table) - (checkdoc-this-string-valid-engine)) - (set-syntax-table old-syntax-table))))) + (let ((fp (checkdoc-defun-info)) + (err nil)) + (setq + err + ;; * Every command, function, or variable intended for users to know + ;; about should have a documentation string. + ;; + ;; * An internal variable or subroutine of a Lisp program might as well + ;; have a documentation string. In earlier Emacs versions, you could + ;; save space by using a comment instead of a documentation string, + ;; but that is no longer the case. + (if (and (not (nth 1 fp)) ; not a variable + (or (nth 2 fp) ; is interactive + checkdoc-force-docstrings-flag) ;or we always complain + (not (checkdoc-char= (following-char) ?\"))) ; no doc string + ;; Sometimes old code has comments where the documentation should + ;; be. Lets see if we can find the comment, and offer to turn it + ;; into documentation for them. + (let ((have-comment nil)) + (condition-case nil + (progn + (forward-sexp -1) + (forward-sexp 1) + (skip-chars-forward "\n \t") + (setq have-comment (looking-at comment-start))) + (error nil)) + (if have-comment + (if (or (eq checkdoc-autofix-flag + 'automatic-then-never) + (checkdoc-y-or-n-p + "Convert comment to documentation? ")) + (save-excursion + ;; Our point is at the beginning of the comment! + ;; Insert a quote, then remove the comment chars. + (insert "\"") + (while (looking-at comment-start) + (while (looking-at comment-start) + (delete-char 1)) + (if (looking-at "[ \t]+") + (delete-region (match-beginning 0) (match-end 0))) + (forward-line 1) + (beginning-of-line) + (skip-chars-forward " \t") + (if (looking-at comment-start) + (progn + (beginning-of-line) + (zap-to-char 1 ?\;)))) + (beginning-of-line) + (forward-char -1) + (insert "\"") + (if (eq checkdoc-autofix-flag 'automatic-then-never) + (setq checkdoc-autofix-flag 'never))) + (checkdoc-create-error + "You should convert this comment to documentation" + (point) (save-excursion (end-of-line) (point)))) + (checkdoc-create-error + (if (nth 2 fp) + "All interactive functions should have documentation" + "All variables and subroutines might as well have a \ +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))) + err))) -(defun checkdoc-this-string-valid-engine () - "Return a message string if the current doc string is invalid. +(defun checkdoc-this-string-valid-engine (fp) + "Return an error list or string if the current doc string is invalid. Depends on `checkdoc-this-string-valid' to reset the syntax table so that -regexp short cuts work." +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 ;; end-of doc string whitespace to also delete the " char. - (e (save-excursion (forward-sexp 1) (point-marker))) - (fp (checkdoc-defun-info))) + (s (point)) + (e (if (looking-at "\"") + (save-excursion (forward-sexp 1) (point-marker)) + (point)))) (or ;; * *Do not* indent subsequent lines of a documentation string so that ;; the text is lined up in the source code with the text of the first @@ -888,7 +1391,10 @@ "Remove this whitespace? " "") nil - "Second line should not have indentation"))) + (checkdoc-create-error + "Second line should not have indentation" + (match-beginning 1) + (match-end 1))))) ;; * Do not start or end a documentation string with whitespace. (let (start end) (if (or (if (looking-at "\"\\([ \t\n]+\\)") @@ -903,22 +1409,9 @@ (if (checkdoc-autofix-ask-replace start end "Remove this whitespace? " "") nil - "Documentation strings should not start or end with whitespace"))) - ;; * Every command, function, or variable intended for users to know - ;; about should have a documentation string. - ;; - ;; * An internal variable or subroutine of a Lisp program might as well - ;; have a documentation string. In earlier Emacs versions, you could - ;; save space by using a comment instead of a documentation string, - ;; but that is no longer the case. - (if (and (not (nth 1 fp)) ; not a variable - (or (nth 2 fp) ; is interactive - checkdoc-force-docstrings-flag) ;or we always complain - (not (checkdoc-char= (following-char) ?\"))) ; no doc string - (if (nth 2 fp) - "All interactive functions should have documentation" - "All variables and subroutines might as well have a \ -documentation string")) + (checkdoc-create-error + "Documentation strings should not start or end with whitespace" + start end)))) ;; * The first line of the documentation string should consist of one ;; or two complete sentences that stand on their own as a summary. ;; `M-x apropos' displays just the first line, and if it doesn't @@ -942,12 +1435,16 @@ (point) (1+ (point)) "Add period to sentence? " ".\"" t) nil - "First sentence should end with punctuation."))) + (checkdoc-create-error + "First sentence should end with punctuation" + (point) (1+ (point)))))) ((looking-at "[\\!;:.)]") ;; These are ok nil) + ((and checkdoc-permit-comma-termination-flag (looking-at ",")) + nil) (t - ;; If it is not a complete sentence, lets see if we can + ;; If it is not a complete sentence, let's see if we can ;; predict a clever way to make it one. (let ((msg "First line is not a complete sentence") (e (point))) @@ -973,16 +1470,17 @@ ;; with a space. (delete-char 1) (insert " ") (setq msg nil)))) - ;; Lets see if there is enough room to draw the next + ;; Let's see if there is enough room to draw the next ;; line's sentence up here. I often get hit w/ ;; auto-fill moving my words around. (let ((numc (progn (end-of-line) (- 80 (current-column)))) (p (point))) (forward-line 1) (beginning-of-line) - (if (and (re-search-forward "[.!:\"][ \n\"]" (save-excursion - (end-of-line) - (point)) + (if (and (re-search-forward "[.!:\"]\\([ \t\n]+\\|\"\\)" + (save-excursion + (end-of-line) + (point)) t) (< (current-column) numc)) (if (checkdoc-autofix-ask-replace @@ -991,10 +1489,16 @@ " " t) (progn ;; They said yes. We have more fill work to do... - (delete-char 1) + (goto-char (match-beginning 1)) + (delete-region (point) (match-end 1)) (insert "\n") (setq msg nil)))))) - msg)))) + (if msg + (checkdoc-create-error msg s (save-excursion + (goto-char s) + (end-of-line) + (point))) + nil) )))) ;; Continuation of above. Make sure our sentence is capitalized. (save-excursion (skip-chars-forward "\"\\*") @@ -1004,54 +1508,10 @@ "Capitalize your sentence? " (upcase (match-string 0)) t) nil - "First line should be capitalized") + (checkdoc-create-error + "First line should be capitalized" + (match-beginning 0) (match-end 0))) nil)) - ;; * For consistency, phrase the verb in the first sentence of a - ;; documentation string as an infinitive with "to" omitted. 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 if they have proper subjects. - ;; - ;; For our purposes, just check to first sentence. A more robust - ;; grammar checker would be preferred for the rest of the - ;; documentation string. - (and checkdoc-verb-check-experimental-flag - (save-excursion - ;; Maybe rebuild the monster-regex - (checkdoc-create-common-verbs-regexp) - (let ((lim (save-excursion - (end-of-line) - ;; check string-continuation - (if (checkdoc-char= (preceding-char) ?\\) - (progn (forward-line 1) - (end-of-line))) - (point))) - (rs nil) replace original (case-fold-search t)) - (while (and (not rs) - (re-search-forward checkdoc-common-verbs-regexp - lim t)) - (setq original (buffer-substring-no-properties - (match-beginning 1) (match-end 1)) - rs (assoc (downcase original) - checkdoc-common-verbs-wrong-voice)) - (if (not rs) (error "Verb voice alist corrupted")) - (setq replace (let ((case-fold-search nil)) - (save-match-data - (if (string-match "^[A-Z]" original) - (capitalize (cdr rs)) - (cdr rs))))) - (if (checkdoc-autofix-ask-replace - (match-beginning 1) (match-end 1) - (format "Wrong voice for verb `%s'. Replace with `%s'? " - original replace) - replace t) - (setq rs nil))) - (if rs - ;; there was a match, but no replace - (format - "Incorrect voice in sentence. Use `%s' instead of `%s'" - replace original))))) ;; * Don't write key sequences directly in documentation strings. ;; Instead, use the `\\[...]' construct to stand for them. (save-excursion @@ -1062,10 +1522,12 @@ (while (and (not f) (setq m (re-search-forward re e t))) (setq f (not (checkdoc-in-sample-code-p start e)))) (if m - (concat - "Keycode " (match-string 1) - " embedded in doc string. Use \\\\<keymap> & \\\\[function] " - "instead")))) + (checkdoc-create-error + (concat + "Keycode " (match-string 1) + " embedded in doc string. Use \\\\<keymap> & \\\\[function] " + "instead") + (match-beginning 1) (match-end 1) t)))) ;; It is not practical to use `\\[...]' very many times, because ;; display of the documentation string will become slow. So use this ;; to describe the most important commands in your major mode, and @@ -1073,26 +1535,31 @@ (save-excursion (if (re-search-forward "\\\\\\\\\\[\\w+" e t (1+ checkdoc-max-keyref-before-warn)) - "Too many occurrences of \\[function]. Use \\{keymap} instead")) + (checkdoc-create-error + "Too many occurrences of \\[function]. Use \\{keymap} instead" + s (marker-position e)))) ;; Ambiguous quoted symbol. When a symbol is both bound and fbound, ;; and is referred to in documentation, it should be prefixed with ;; something to disambiguate it. This check must be before the ;; 80 column check because it will probably break that. (save-excursion (let ((case-fold-search t) - (ret nil)) - (while (and - (re-search-forward - "\\(\\<\\(variable\\|option\\|function\\|command\\|symbol\\)\ -\\s-+\\)?`\\(\\sw\\(\\sw\\|\\s_\\)+\\)'" e t) - (not ret)) - (let ((sym (intern-soft (match-string 3))) - (mb (match-beginning 3))) - (if (and sym (boundp sym) (fboundp sym) (not (match-string 1))) + (ret nil) mb me) + (while (and (re-search-forward "`\\(\\sw\\(\\sw\\|\\s_\\)+\\)'" e t) + (not ret)) + (let* ((ms1 (match-string 1)) + (sym (intern-soft ms1))) + (setq mb (match-beginning 1) + me (match-end 1)) + (if (and sym (boundp sym) (fboundp sym) + (save-excursion + (goto-char mb) + (forward-word -1) + (not (looking-at + "variable\\|option\\|function\\|command\\|symbol")))) (if (checkdoc-autofix-ask-replace - mb (match-end 3) "Prefix this ambiguous symbol? " - (match-string 3) t) - ;; We didn't actuall replace anything. Here we find + mb me "Prefix this ambiguous symbol? " ms1 t) + ;; We didn't actually replace anything. Here we find ;; out what special word form they wish to use as ;; a prefix. (let ((disambiguate @@ -1105,74 +1572,41 @@ (insert disambiguate " ") (forward-word 1)) (setq ret - (format "Disambiguate %s by preceeding w/ \ -function,command,variable,option or symbol." (match-string 3))))))) - ret)) + (format "Disambiguate %s by preceding w/ \ +function,command,variable,option or symbol." ms1)))))) + (if ret + (checkdoc-create-error ret mb me) + nil))) ;; * Format the documentation string so that it fits in an ;; Emacs window on an 80-column screen. It is a good idea ;; for most lines to be no wider than 60 characters. The ;; first line can be wider if necessary to fit the ;; information that ought to be there. (save-excursion - (let ((start (point))) + (let ((start (point)) + (eol nil)) (while (and (< (point) e) - (or (progn (end-of-line) (< (current-column) 80)) + (or (progn (end-of-line) (setq eol (point)) + (< (current-column) 80)) (progn (beginning-of-line) (re-search-forward "\\\\\\\\[[<{]" - (save-excursion - (end-of-line) - (point)) t)) + eol t)) (checkdoc-in-sample-code-p start e))) (forward-line 1)) (end-of-line) (if (and (< (point) e) (> (current-column) 80)) - "Some lines are over 80 columns wide"))) - ;;* 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.) - (save-excursion - (let ((found nil) (start (point)) (msg nil) (ms nil)) - (while (and (not msg) - (re-search-forward - "[^([`':]\\(\\w\+[:-]\\(\\w\\|\\s_\\)+\\)[^]']" - e t)) - (setq ms (match-string 1)) - (save-match-data - ;; A . is a \s_ char, so we must remove periods from - ;; sentences more carefully. - (if (string-match "\\.$" ms) - (setq ms (substring ms 0 (1- (length ms)))))) - (if (and (not (checkdoc-in-sample-code-p start e)) - (setq found (intern-soft ms)) - (or (boundp found) (fboundp found))) - (progn - (setq msg (format "Add quotes around Lisp symbol `%s'? " - ms)) - (if (checkdoc-autofix-ask-replace - (match-beginning 1) (+ (match-beginning 1) - (length ms)) - msg (concat "`" ms "'") t) - (setq msg nil))))) - msg)) - ;; t and nil case - (save-excursion - (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)) - (match-string 2) t) - nil - "Symbols t and nil should not appear in `quotes'"))) + (checkdoc-create-error + "Some lines are over 80 columns wide" + s (save-excursion (goto-char s) (end-of-line) (point)) )))) ;; 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. (cond ((eq (nth 1 fp) t) ;; This is if we are in a variable (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 + ;; 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' ;; mean. ;; * If a user option variable records a true-or-false @@ -1181,11 +1615,24 @@ ;; 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-+"))) - "Flag variable doc strings should start: Non-nil means") + (checkdoc-create-error + "Flag variable doc strings should 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)))) - "Flag variables should end in `-flag'") + (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)))) ;; Done with variables )) (t @@ -1221,7 +1668,7 @@ e t))) (if (not found) (let ((case-fold-search t)) - ;; If the symbol was not found, lets see if we + ;; If the symbol was not found, let's see if we ;; can find it with a different capitalization ;; and see if the user wants to capitalize it. (if (save-excursion @@ -1243,9 +1690,10 @@ (if (not found) ;; It wasn't found at all! Offer to attach this new symbol ;; to the end of the documentation string. - (if (y-or-n-p - (format "Add %s documentation to end of doc string?" - (upcase (car args)))) + (if (checkdoc-y-or-n-p + (format + "Add %s documentation to end of doc string? " + (upcase (car args)))) ;; Now do some magic and invent a doc string. (save-excursion (goto-char e) (forward-char -1) @@ -1258,17 +1706,124 @@ (looking-at "[.?!]"))) (insert ".")) nil) - (format - "Argument `%s' should appear as `%s' in the doc string" - (car args) (upcase (car args)))) + (checkdoc-create-error + (format + "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)) (and (not order) checkdoc-arguments-in-order-flag)) (if (< found last-pos) - "Arguments occur in the doc string out of order")))) + (checkdoc-create-error + "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 + ;; 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 + ;; if they have proper subjects. + ;; + ;; This is the least important of the above tests. Make sure + ;; it occurs last. + (and checkdoc-verb-check-experimental-flag + (save-excursion + ;; Maybe rebuild the monster-regex + (checkdoc-create-common-verbs-regexp) + (let ((lim (save-excursion + (end-of-line) + ;; check string-continuation + (if (checkdoc-char= (preceding-char) ?\\) + (progn (forward-line 1) + (end-of-line))) + (point))) + (rs nil) replace original (case-fold-search t)) + (while (and (not rs) + (re-search-forward + checkdoc-common-verbs-regexp + lim t)) + (setq original (buffer-substring-no-properties + (match-beginning 1) (match-end 1)) + rs (assoc (downcase original) + checkdoc-common-verbs-wrong-voice)) + (if (not rs) (error "Verb voice alist corrupted")) + (setq replace (let ((case-fold-search nil)) + (save-match-data + (if (string-match "^[A-Z]" original) + (capitalize (cdr rs)) + (cdr rs))))) + (if (checkdoc-autofix-ask-replace + (match-beginning 1) (match-end 1) + (format "Use the infinitive 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'" + original replace) + (match-beginning 1) (match-end 1)))))) ;; Done with functions ))) - ;; Make sure the doc string has correctly spelled english words - ;; in it. This functions is extracted due to its complexity, + ;;* 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.) + (save-excursion + (let ((found nil) (start (point)) (msg nil) (ms nil)) + (while (and (not msg) + (re-search-forward + "[^([`':a-zA-Z]\\(\\w+[:-]\\(\\w\\|\\s_\\)+\\)[^]']" + e t)) + (setq ms (match-string 1)) + (save-match-data + ;; A . is a \s_ char, so we must remove periods from + ;; sentences more carefully. + (if (string-match "\\.$" ms) + (setq ms (substring ms 0 (1- (length ms)))))) + (if (and (not (checkdoc-in-sample-code-p start e)) + (not (checkdoc-in-example-string-p start e)) + (not (member ms checkdoc-symbol-words)) + (setq found (intern-soft ms)) + (or (boundp found) (fboundp found))) + (progn + (setq msg (format "Add quotes around Lisp symbol `%s'? " + ms)) + (if (checkdoc-autofix-ask-replace + (match-beginning 1) (+ (match-beginning 1) + (length ms)) + msg (concat "`" ms "'") t) + (setq msg nil) + (setq msg + (format "Lisp symbol `%s' should appear in quotes" + ms)))))) + (if msg + (checkdoc-create-error msg (match-beginning 1) + (+ (match-beginning 1) + (length ms))) + nil))) + ;; t and nil case + (save-excursion + (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)) + (match-string 2) t) + nil + (checkdoc-create-error + "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) + ;; Here are common proper nouns that should always appear capitalized. + (checkdoc-proper-noun-region-engine (point) e) + ;; Make sure the doc string has correctly spelled English words + ;; in it. This function is extracted due to its complexity, ;; and reliance on the Ispell program. (checkdoc-ispell-docstring-engine e) ;; User supplied checks @@ -1337,14 +1892,20 @@ t) (let ((sl nil)) (goto-char (match-end 0)) - (setq lst (read (current-buffer))) + (condition-case nil + (setq lst (read (current-buffer))) + (error (setq lst nil))) ; error in text + (if (not (listp lst)) ; not a list of args + (setq lst (list lst))) + (if (and lst (not (symbolp (car lst)))) ;weird arg + (setq lst nil)) (while lst (setq sl (cons (symbol-name (car lst)) sl) lst (cdr lst))) (setq sl1 (append sl1 sl)))) sl1) ret))) - ;; Read the list of paramters, but do not put the symbols in + ;; Read the list of parameters, but do not put the symbols in ;; the standard obarray. (setq lst (read bss))) ;; This is because read will intern nil if it doesn't into the @@ -1359,9 +1920,9 @@ (defun checkdoc-in-sample-code-p (start limit) "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 parenthesis that is quoted with the ' -character. Only the region from START to LIMIT is is allowed while -searching for the bounding parenthesis." +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 +is is allowed while searching for the bounding parenthesis." (save-match-data (save-restriction (narrow-to-region start limit) @@ -1377,8 +1938,107 @@ ;; the name, then it is probably supposed to be bound ;; but isn't yet. (or (fboundp (intern-soft ms)) + (let ((case-fold-search nil)) + (string-match "^[A-Z-]+$" ms)) (string-match "\\w[-:_]+\\w" ms)))))))))) +(defun checkdoc-in-example-string-p (start limit) + "Return non-nil if the current point is in an \"example string\". +This string is identified by the characters \\\" surrounding the text. +The text checked is between START and LIMIT." + (save-match-data + (save-excursion + (let ((p (point)) + (c 0)) + (goto-char start) + (while (and (< (point) p) (re-search-forward "\\\\\"" limit t)) + (setq c (1+ c))) + (and (< 0 c) (= (% c 2) 0)))))) + +(defun checkdoc-proper-noun-region-engine (begin end) + "Check all text between BEGIN and END for lower case proper nouns. +These are Emacs centric proper nouns which should be capitalized for +consistency. Return an error list if any are not fixed, but +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 "`\\|\"\\|\\.\\|\\\\"))) + (not (checkdoc-in-example-string-p begin end))) + (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)) + (if errtxt (checkdoc-create-error errtxt bb be))))) + +(defun checkdoc-sentencespace-region-engine (begin end) + "Make sure all sentences have double spaces between BEGIN and END." + (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))) + (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)) + (forward-sexp -1) + ;; piece of an abbreviation + (looking-at "\\([a-z]\\|[ie]\\.?g\\)\\.") + ))) + (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))))) + + ;;; Ispell engine ;; (eval-when-compile (require 'ispell)) @@ -1407,7 +2067,11 @@ "Run the Ispell tools on the doc string between point and END. Since Ispell isn't Lisp-smart, we must pre-process the doc string before using the Ispell engine on it." - (if (not checkdoc-spellcheck-documentation-flag) + (if (or (not checkdoc-spellcheck-documentation-flag) + ;; If the user wants no questions or fixing, then we must + ;; disable spell checking as not useful. + (not checkdoc-autofix-flag) + (eq checkdoc-autofix-flag 'never)) nil (checkdoc-ispell-init) (save-excursion @@ -1423,12 +2087,12 @@ (point))) sym (intern-soft word)) (if (and sym (or (boundp sym) (fboundp sym))) - ;; This is probably repetative in most cases, but not always. + ;; This is probably repetitive in most cases, but not always. nil ;; Find out how we spell-check this word. (if (or ;; All caps w/ option th, or s tacked on the end - ;; for pluralization or nuberthness. + ;; for pluralization or numberthness. (string-match "^[A-Z][A-Z]+\\(s\\|th\\)?$" word) (looking-at "}") ; a keymap expression ) @@ -1448,41 +2112,51 @@ ;;; Rogue space checking engine ;; -(defun checkdoc-rogue-space-check-engine (&optional start end) - "Return a message string if there is a line with white space at the end. +(defun checkdoc-rogue-space-check-engine (&optional start end interact) + "Return a message list if there is a line with white space at the end. If `checkdoc-autofix-flag' permits, delete that whitespace instead. If optional arguments START and END are non nil, bound the check to -this region." +this region. +Optional argument INTERACT may permit the user to fix problems on the fly." (let ((p (point)) - (msg nil)) + (msg nil) s e (f nil)) (if (not start) (setq start (point-min))) ;; If end is nil, it means end of buffer to search anyway (or - ;; Checkfor and error if `? ' or `?\ ' is used at the end of a line. + ;; Check for an error if `? ' or `?\ ' is used at the end of a line. ;; (It's dangerous) (progn (goto-char start) - (if (re-search-forward "\\?\\\\?[ \t][ \t]*$" end t) - (setq msg - "Don't use `? ' at the end of a line. \ -Some editors & news agents may remove it"))) - ;; Check for, and pottentially remove whitespace appearing at the + (while (and (not msg) (re-search-forward "\\?\\\\?[ \t][ \t]*$" end t)) + (setq msg + "Don't use `? ' at the end of a line. \ +News agents may remove it" + s (match-beginning 0) e (match-end 0) f t) + ;; If interactive is passed down, give them a chance to fix things. + (if (and interact (y-or-n-p (concat msg ". Fix? "))) + (progn + (checkdoc-recursive-edit msg) + (setq msg nil) + (goto-char s) + (beginning-of-line))))) + ;; Check for, and potentially remove whitespace appearing at the ;; end of different lines. (progn (goto-char start) ;; There is no documentation in the Emacs Lisp manual about this check, ;; it is intended to help clean up messy code and reduce the file size. - (while (and (not msg) (re-search-forward "[^ \t\n]\\([ \t]+\\)$" end t)) + (while (and (not msg) (re-search-forward "[^ \t\n;]\\([ \t]+\\)$" end t)) ;; This is not a complex activity (if (checkdoc-autofix-ask-replace (match-beginning 1) (match-end 1) "White space at end of line. Remove? " "") nil - (setq msg "White space found at end of line"))))) + (setq msg "White space found at end of line" + s (match-beginning 1) e (match-end 1)))))) ;; Return an error and leave the cursor at that spot, or restore ;; the cursor. (if msg - msg + (checkdoc-create-error msg s e f) (goto-char p) nil))) @@ -1490,131 +2164,205 @@ ;; (eval-when-compile ;; We must load this to: - ;; a) get symbols for comple and + ;; a) get symbols for compile and ;; b) determine if we have lm-history symbol which doesn't always exist (require 'lisp-mnt)) (defun checkdoc-file-comments-engine () - "Return a message string if this file does not match the Emacs standard. + "Return a message list if this file does not match the Emacs standard. This checks for style only, such as the first line, Commentary:, Code:, and others referenced in the style guide." (if (featurep 'lisp-mnt) nil (require 'lisp-mnt) - ;; Old Xemacs don't have `lm-commentary-mark' + ;; Old XEmacs don't have `lm-commentary-mark' (if (and (not (fboundp 'lm-commentary-mark)) (boundp 'lm-commentary)) (defalias 'lm-commentary-mark 'lm-commentary))) (save-excursion (let* ((f1 (file-name-nondirectory (buffer-file-name))) (fn (file-name-sans-extension f1)) - (fe (substring f1 (length fn)))) + (fe (substring f1 (length fn))) + (err nil)) (goto-char (point-min)) - (or + ;; This file has been set up where ERR is a variable. Each check is + ;; asked, and the function will make sure that if the user does not + ;; auto-fix some error, that we still move on to the next auto-fix, + ;; AND we remember the past errors. + (setq + err ;; Lisp Maintenance checks first ;; Was: (lm-verify) -> not flexible enough for some people ;; * Summary at the beginning of the file: (if (not (lm-summary)) ;; This certifies as very complex so always ask unless ;; it's set to never - (if (and checkdoc-autofix-flag - (not (eq checkdoc-autofix-flag 'never)) - (y-or-n-p "There is no first line summary! Add one? ")) + (if (checkdoc-y-or-n-p "There is no first line summary! Add one? ") (progn (goto-char (point-min)) (insert ";;; " fn fe " --- " (read-string "Summary: ") "\n")) - "The first line should be of the form: \";;; package --- Summary\"") - nil) - ;; * Commentary Section - (if (not (lm-commentary-mark)) - "You should have a section marked \";;; Commentary:\"" - nil) - ;; * History section. Say nothing if there is a file ChangeLog - (if (or (file-exists-p "ChangeLog") - (let ((fn 'lm-history-mark)) ;bestill byte-compiler - (and (fboundp fn) (funcall fn)))) - nil - "You should have a section marked \";;; History:\" or use a ChangeLog") - ;; * Code section - (if (not (lm-code-mark)) - (let ((cont t)) - (goto-char (point-min)) - (while (and cont (re-search-forward "^(" nil t)) - (setq cont (looking-at "require\\s-+"))) - (if (and (not cont) - checkdoc-autofix-flag - (not (eq checkdoc-autofix-flag 'never)) - (y-or-n-p "There is no ;;; Code: marker. Insert one? ")) - (progn (beginning-of-line) - (insert ";;; Code:\n") - nil) - "You should have a section marked \";;; Code:\"")) - nil) - ;; * A footer. Not compartamentalized from lm-verify: too bad. - ;; The following is partially clipped from lm-verify - (save-excursion - (goto-char (point-max)) - (if (not (re-search-backward - (concat "^;;;[ \t]+" fn "\\(" (regexp-quote fe) - "\\)?[ \t]+ends here[ \t]*$" - "\\|^;;;[ \t]+ End of file[ \t]+" - fn "\\(" (regexp-quote fe) "\\)?") - nil t)) - (if (and checkdoc-autofix-flag - (not (eq checkdoc-autofix-flag 'never)) - (y-or-n-p "No identifiable footer! Add one? ")) - (progn - (goto-char (point-max)) - (insert "\n(provide '" fn ")\n;;; " fn fe " ends here\n")) - (format "The footer should be (provide '%s)\\n;;; %s%s ends here" - fn fn fe)))) - ;; Ok, now lets look for multiple occurances of ;;;, and offer - ;; to remove the extra ";" if applicable. This pre-supposes - ;; that the user has semiautomatic fixing on to be useful. + (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)))) + nil)) + (setq + err + (or + ;; * Commentary Section + (if (not (lm-commentary-mark)) + (progn + (goto-char (point-min)) + (cond + ((re-search-forward + "write\\s-+to\\s-+the\\s-+Free Software Foundation, Inc." + nil t) + (re-search-forward "^;;\\s-*\n\\|^\n" nil t)) + ((or (re-search-forward "^;;; History" nil t) + (re-search-forward "^;;; Code" nil t) + (re-search-forward "^(require" nil t) + (re-search-forward "^(")) + (beginning-of-line))) + (if (checkdoc-y-or-n-p + "You should have a \";;; Commentary:\", add one? ") + (insert "\n;;; Commentary:\n;; \n\n") + (checkdoc-create-error + "You should have a section marked \";;; Commentary:\"" + nil nil t))) + nil) + err)) + (setq + err + (or + ;; * History section. Say nothing if there is a file ChangeLog + (if (or (not checkdoc-force-history-flag) + (file-exists-p "ChangeLog") + (file-exists-p "../ChangeLog") + (let ((fn 'lm-history-mark)) ;bestill byte-compiler + (and (fboundp fn) (funcall fn)))) + nil + (progn + (goto-char (or (lm-commentary-mark) (point-min))) + (cond + ((re-search-forward + "write\\s-+to\\s-+the\\s-+Free Software Foundation, Inc." + nil t) + (re-search-forward "^;;\\s-*\n\\|^\n" nil t)) + ((or (re-search-forward "^;;; Code" nil t) + (re-search-forward "^(require" nil t) + (re-search-forward "^(")) + (beginning-of-line))) + (if (checkdoc-y-or-n-p + "You should have a \";;; History:\", add one? ") + (insert "\n;;; History:\n;; \n\n") + (checkdoc-create-error + "You should have a section marked \";;; History:\" or use a ChangeLog" + (point) nil)))) + err)) + (setq + err + (or + ;; * Code section + (if (not (lm-code-mark)) + (let ((cont t)) + (goto-char (point-min)) + (while (and cont (re-search-forward "^(" nil t)) + (setq cont (looking-at "require\\s-+"))) + (if (and (not cont) + (checkdoc-y-or-n-p + "There is no ;;; Code: marker. Insert one? ")) + (progn (beginning-of-line) + (insert ";;; Code:\n") + nil) + (checkdoc-create-error + "You should have a section marked \";;; Code:\"" + (point) nil))) + nil) + err)) + (setq + err + (or + ;; * A footer. Not compartmentalized from lm-verify: too bad. + ;; The following is partially clipped from lm-verify + (save-excursion + (goto-char (point-max)) + (if (not (re-search-backward + (concat "^;;;[ \t]+" fn "\\(" (regexp-quote fe) + "\\)?[ \t]+ends here[ \t]*$" + "\\|^;;;[ \t]+ End of file[ \t]+" + fn "\\(" (regexp-quote fe) "\\)?") + nil t)) + (if (checkdoc-y-or-n-p "No identifiable footer! Add one? ") + (progn + (goto-char (point-max)) + (insert "\n(provide '" fn ")\n\n;;; " fn fe " ends here\n")) + (checkdoc-create-error + (format "The footer should be: (provide '%s)\\n;;; %s%s ends here" + fn fn fe) + (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))))) - ;; 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-tripple-semi-comment-check-flag - (not msg) (re-search-forward "^;;;[^;]" nil t)) - ;; We found a triple, lets check all following lines. - (if (not (bolp)) (progn (beginning-of-line) (forward-line 1))) - (let ((complex-replace t)) - (while (looking-at ";;\\(;\\)[^;]") - (if (and (checkdoc-outside-major-sexp) ;in code is ok. - (checkdoc-autofix-ask-replace - (match-beginning 1) (match-end 1) - "Multiple occurances 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)) - (beginning-of-line) - (forward-line 1))))) - ;; Lets 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) - (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. - (checkdoc-ispell-docstring-engine (save-excursion - (re-search-forward "^[^;]" nil t) - (point)))) + ;; 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) - ;; Generic Full-file checks (should be comment related) - (checkdoc-run-hooks 'checkdoc-comment-style-hooks) - ;; Done with full file comment checks - )))) + (setq + err + (or + ;; Generic Full-file checks (should be comment related) + (checkdoc-run-hooks 'checkdoc-comment-style-hooks) + err)) + ;; Done with full file comment checks + err))) (defun checkdoc-outside-major-sexp () "Return t if point is outside the bounds of a valid sexp." @@ -1626,56 +2374,60 @@ ;;; `error' and `message' text verifier. ;; -(defun checkdoc-message-text (&optional take-notes) - "Scan the buffer for occurrences of the error function, and verify text. -Optional argument TAKE-NOTES causes all errors to be logged." - (interactive "P") - (if take-notes (checkdoc-start-section "checkdoc-message-text")) - (let ((p (point)) - (e (checkdoc-message-text-search))) - (if e (if take-notes (checkdoc-error (point) e) (error e))) - (if (and take-notes e) (checkdoc-show-diagnostics)) - (goto-char p)) - (if (interactive-p) (message "Checking error message text...done."))) - (defun checkdoc-message-text-search (&optional beg end) - "Search between BEG and END for an error with `error'. + "Search between BEG and END for a style error with message text. Optional arguments BEG and END represent the boundary of the check. The default boundary is the entire buffer." - (let ((e nil)) + (let ((e nil) + (type nil)) (if (not (or beg end)) (setq beg (point-min) end (point-max))) (goto-char beg) - (while (and (not e) (re-search-forward "(\\s-*error[ \t\n]" end t)) - (if (looking-at "\"") - (setq e (checkdoc-message-text-engine 'error)))) - (goto-char beg) - (while (and (not e) (re-search-forward - "\\<y-or-n-p\\(-with-timeout\\)?[ \t\n]" end t)) - ;; Format is common as a first arg.. - (if (looking-at "(format[ \t\n]") (goto-char (match-end 0))) - (if (looking-at "\"") - (setq e (checkdoc-message-text-engine 'y-or-n-p)))) - (goto-char beg) - ;; this is cheating for checkdoc only. - (while (and (not e) (re-search-forward - "(checkdoc-autofix-ask-replace[ \t\n]" - end t)) - (forward-sexp 2) - (skip-chars-forward " \t\n") - (if (looking-at "(format[ \t\n]") (goto-char (match-end 0))) - (if (looking-at "\"") - (setq e (checkdoc-message-text-engine 'y-or-n-p)))) - ;; Is it worth adding checks for read commands too? That would - ;; require fixing up `interactive' which could be unpleasant. - ;; Most people get that right by accident anyway. + (while (setq type (checkdoc-message-text-next-string end)) + (setq e (checkdoc-message-text-engine type))) e)) -(defun checkdoc-message-text-engine (type) +(defun checkdoc-message-text-next-string (end) + "Move cursor to the next checkable message string after point. +Return the message classification. +Argument END is the maximum bounds to search in." + (let ((return nil)) + (while (and (not return) + (re-search-forward + "(\\s-*\\(\\(\\w\\|\\s_\\)*error\\|\ +\\(\\w\\|\\s_\\)*y-or-n-p\\(-with-timeout\\)?\ +\\|checkdoc-autofix-ask-replace\\)[ \t\n]+" end t)) + (let* ((fn (match-string 1)) + (type (cond ((string-match "error" fn) + 'error) + (t 'y-or-n-p)))) + (if (string-match "checkdoc-autofix-ask-replace" fn) + (progn (forward-sexp 2) + (skip-chars-forward " \t\n"))) + (if (and (eq type 'y-or-n-p) + (looking-at "(format[ \t\n]+")) + (goto-char (match-end 0))) + (skip-chars-forward " \t\n") + (if (not (looking-at "\"")) + nil + (setq return type)))) + return)) + +(defun checkdoc-message-text-engine (&optional type) "Return or fix errors found in strings passed to a message display function. -According to the documentation for the function `error', the error string -should not end with a period, and should start with a capitol letter. +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." + ;; If type is nil, then attempt to derive it. + (if (not type) + (save-excursion + (up-list -1) + (if (looking-at "(format") + (up-list -1)) + (setq type + (cond ((looking-at "(error") + 'error) + (t 'y-or-n-p))))) (let ((case-fold-search nil)) (or ;; From the documentation of the symbol `error': @@ -1689,8 +2441,19 @@ "Capitalize your message text? " (capitalize (match-string 0)) t))) - "Messages should start with a capitol letter" + (checkdoc-create-error + "Messages should start with a capital letter" + (match-beginning 0) (match-end 0)) nil) + ;; In general, sentences should have two spaces after the period. + (checkdoc-sentencespace-region-engine (point) + (save-excursion (forward-sexp 1) + (point))) + ;; Look for proper nouns in this region too. + (checkdoc-proper-noun-region-engine (point) + (save-excursion (forward-sexp 1) + (point))) + ;; Here are message type specific questions. (if (and (eq type 'error) (save-excursion (forward-sexp 1) (forward-char -2) @@ -1700,50 +2463,72 @@ "Remove period from error? " "" t))) - "Error messages should *not* end with a period" + (checkdoc-create-error + "Error messages should *not* end with a period" + (match-beginning 0) (match-end 0)) nil) ;; `y-or-n-p' documentation explicitly says: ;; It should end in a space; `y-or-n-p' adds `(y or n) ' to it. ;; I added the ? requirement. Without it, it is unclear that we ;; ask a question and it appears to be an undocumented style. - (if (and (eq type 'y-or-n-p) - (save-excursion (forward-sexp 1) - (forward-char -3) - (not (looking-at "\\? "))) - (if (save-excursion (forward-sexp 1) - (forward-char -2) - (looking-at "\\?")) - ;; If we see a ?, then replace with "? ". - (if (checkdoc-autofix-ask-replace - (match-beginning 0) (match-end 0) - "y-or-n-p text should endwith \"? \". Fix? " - "? " t) - nil - "y-or-n-p text should endwith \"? \".") - (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 endwith \"? \". Fix? " - "? " t) - nil - "y-or-n-p text should endwith \"? \".") - (if (and ;; if this isn't true, we have a problem. - (save-excursion (forward-sexp 1) - (forward-char -1) - (looking-at "\"")) - (checkdoc-autofix-ask-replace - (match-beginning 0) (match-end 0) - "y-or-n-p text should endwith \"? \". Fix? " - "? \"" t)) - nil - "y-or-n-p text should endwith \"? \".")))) - nil) + (if (eq type 'y-or-n-p) + (if (not (save-excursion (forward-sexp 1) + (forward-char -3) + (not (looking-at "\\? ")))) + nil + (if (save-excursion (forward-sexp 1) + (forward-char -2) + (looking-at "\\?")) + ;; 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? " + "? " t) + nil + (checkdoc-create-error + "y-or-n-p text 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? " + "? " t) + nil + (checkdoc-create-error + "y-or-n-p text 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) + (forward-char -1) + (looking-at "\"")) + (checkdoc-autofix-ask-replace + (match-beginning 0) (match-end 0) + "y-or-n-p text should end with \"? \". Fix? " + "? \"" t)) + nil + (checkdoc-create-error + "y-or-n-p text 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) + (point))) ))) ;;; Auto-fix helper functions ;; +(defun checkdoc-y-or-n-p (question) + "Like `y-or-n-p', but pays attention to `checkdoc-autofix-flag'. +Argument QUESTION is the prompt passed to `y-or-n-p'." + (prog1 + (if (or (not checkdoc-autofix-flag) + (eq checkdoc-autofix-flag 'never)) + nil + (y-or-n-p question)) + (if (eq checkdoc-autofix-flag 'automatic-then-never) + (setq checkdoc-autofix-flag 'never)))) + (defun checkdoc-autofix-ask-replace (start end question replacewith &optional complex) "Highlight between START and END and queries the user with QUESTION. @@ -1756,14 +2541,19 @@ will pause near the fixed code so the user will briefly see what happened. -This function returns non-nil if the text was replaced." - (if checkdoc-autofix-flag +This function returns non-nil if the text was replaced. + +This function will not modify `match-data'." + (if (and checkdoc-autofix-flag + (not (eq checkdoc-autofix-flag 'never))) (let ((o (checkdoc-make-overlay start end)) - (ret nil)) + (ret nil) + (md (match-data))) (unwind-protect (progn (checkdoc-overlay-put o 'face 'highlight) (if (or (eq checkdoc-autofix-flag 'automatic) + (eq checkdoc-autofix-flag 'automatic-then-never) (and (eq checkdoc-autofix-flag 'semiautomatic) (not complex)) (and (or (eq checkdoc-autofix-flag 'query) complex) @@ -1771,28 +2561,37 @@ (save-excursion (goto-char start) ;; On the off chance this is automatic, display - ;; the question anyway so the user knows whats + ;; the question anyway so the user knows what's ;; going on. (if checkdoc-bouncy-flag (message "%s -> done" question)) (delete-region start end) (insert replacewith) (if checkdoc-bouncy-flag (sit-for 0)) (setq ret t))) - (checkdoc-delete-overlay o)) - (checkdoc-delete-overlay o)) + (checkdoc-delete-overlay o) + (set-match-data md)) + (checkdoc-delete-overlay o) + (set-match-data md)) + (if (eq checkdoc-autofix-flag 'automatic-then-never) + (setq checkdoc-autofix-flag 'never)) ret))) ;;; Warning management ;; (defvar checkdoc-output-font-lock-keywords - '(("\\(\\w+\\.el\\):" 1 font-lock-function-name-face) - ("style check: \\(\\w+\\)" 1 font-lock-comment-face) - ("^\\([0-9]+\\):" 1 font-lock-constant-face)) + '(("\\(\\w+\\.el\\): \\(\\w+\\)" + (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)) "Keywords used to highlight a checkdoc diagnostic buffer.") (defvar checkdoc-output-mode-map nil "Keymap used in `checkdoc-output-mode'.") +(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)) @@ -1830,11 +2629,9 @@ "In a checkdoc diagnostic buffer, find the error under point." (interactive) (beginning-of-line) - (if (looking-at "[0-9]+") - (let ((l (string-to-int (match-string 0))) - (f (save-excursion - (re-search-backward " \\(\\(\\w+\\|\\s_\\)+\\.el\\):") - (match-string 1)))) + (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)) @@ -1845,14 +2642,17 @@ 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*** " (current-time-string) " " - (file-name-nondirectory (buffer-file-name)) ": style check: " check-type + "\n\n\C-l\n*** " + (file-name-nondirectory (buffer-file-name)) ": " 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" (int-to-string (count-lines (point-min) (or point 1))) ": " + "\n" + (file-name-nondirectory (buffer-file-name)) ":" + (int-to-string (count-lines (point-min) (or point 1))) ": " msg)) (defun checkdoc-output-to-error-buffer (&rest text) @@ -1864,11 +2664,17 @@ (defun checkdoc-show-diagnostics () "Display the checkdoc diagnostic buffer in a temporary window." - (let ((b (get-buffer checkdoc-diagnostic-buffer))) - (if b (progn (pop-to-buffer b) - (beginning-of-line))) - (other-window -1) - (shrink-window-if-larger-than-buffer))) + (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) + (setq checkdoc-pending-errors nil) + nil))) (defgroup checkdoc nil "Support for doc string checking in Emacs Lisp."