-;;; checkdoc --- Check documentation strings for style requirements
+;;; checkdoc.el --- check documentation strings for style requirements
-;;; Copyright (C) 1997, 1998 Free Software Foundation
+;;; Copyright (C) 1997, 1998, 2001, 2004 Free Software Foundation
;; Author: Eric M. Ludlam <zappo@gnu.org>
-;; Version: 0.4.3
+;; Version: 0.6.2
;; Keywords: docs, maint, lisp
;; This file is part of GNU Emacs.
;;; Commentary:
;;
-;; The emacs lisp manual has a nice chapter on how to write
+;; The Emacs Lisp manual has a nice chapter on how to write
;; documentation strings. Many stylistic suggestions are fairly
;; deterministic and easy to check for syntactically, but also easy
;; to forget. The main checkdoc engine will perform the stylistic
;; 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
+;; documentation whenever you evaluate Lisp code with C-M-x
;; or [menu-bar emacs-lisp eval-buffer]. Additional key-bindings
;; are also provided under C-c ? KEY
;; (require 'checkdoc)
;; (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
;; 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
;; checking can be quite slow, you can optimize how best you want your
-;; checking done. The default is 'defun, which spell checks each time
+;; checking done. The default is `defun', which spell checks each time
;; `checkdoc-defun' or `checkdoc-eval-defun' is used. Setting to nil
;; prevents spell checking during normal usage.
;; Setting this variable to nil does not mean you cannot take
;; advantage of the spell checking. You can instead use the
;; interactive functions `checkdoc-ispell-*' to check the spelling of
;; your documentation.
-;; There is a list of lisp-specific words which checkdoc will
-;; install into ispell on the fly, but only if ispell is not already
+;; There is a list of Lisp-specific words which checkdoc will
+;; install into Ispell on the fly, but only if Ispell is not already
;; 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 it's parameters listed
+;; 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
;; front of the documentation string: "; checkdoc-order: nil" This
;; overrides the value of `checkdoc-arguments-in-order-flag'.
;; skip looking for it by putting the following comment just in front
;; of the documentation string: "; checkdoc-params: (args go here)"
;;
+;; Checking message strings:
+;;
+;; 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
+;; it should end in "? " since that is almost always used.
+;;
;; Adding your own checks:
;;
;; You can experiment with adding your own checks by setting the
;; 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:
;;
-;; Requires custom for emacs v20.
-
-;;; Change log:
-;; 0.1 Initial revision
-;; 0.2 Fixed comments in this file to match the emacs lisp standards.
-;; Added new doc checks for: variable-flags, function arguments
-;; Added autofix functionality for white-space, and quoted variables.
-;; Unquoted symbols are allowed after ( character. (Sample code)
-;; Check for use of `? ' at end of line and warn.
-;; Check for spaces at end of lines for whole file, or one defun.
-;; Check for comments standards, including headinds like Code:
-;; and use of triple semicolons versus double semicolons
-;; Check that interactive functions have a doc-string. Optionally
-;; set `checkdoc-force-docstrings-flag' to non-nil to make all
-;; definitions have a doc-string.
-;; 0.3 Regexp changse for accuracy on var checking and param checking.
-;; lm-verify check expanded to each sub-call w/ more descriptive
-;; messages, and two autofix-options.
-;; Suggestions/patches from Christoph Wedler <wedler@fmi.uni-passau.de>
-;; XEmacs support w/ extents/overlays.
-;; Better Whitespace finding regexps
-;; Added `checkdoc-arguments-in-order-flag' to optionally turn off
-;; warnings of arguments that do not appear in order in doc
-;; strings.
-;; 0.4 New fix routine when two lines can be joined to make the
-;; first line a comlete sentence.
-;; Added ispell code. Use `checkdoc-spellcheck-documentation-flag'
-;; to enable or disable this test in certain contexts.
-;; Added ispell interface functions `checkdoc-ispell',
-;; `checkdoc-ispell-continue', `checkdoc-ispell-defun'
-;; `checkdoc-ispell-interactive', `checkdoc-ispell-current-buffer'.
-;; Loop through all potential unquoted symbols.
-;; Auto-fixing no longer screws up the "end" of the doc-string.
-;; Maintain a different syntax table when examining arguments.
-;; Autofix enabled for parameters which are not uppercase iff they
-;; occur in lower case in the doc-string.
-;; Autofix enable if there is no Code: label.
-;; The comment text ";; checkdoc-order: nil|t" inside a defun to
-;; enable or disable the checking of argument order for one defun.
-;; The comment text ";; checkdoc-params: (arg1 arg2)" inside a defun
-;; (Such as just before the doc string) will list ARG1 and ARG2 as
-;; being paramters that need not show up in the doc string.
-;; Brought in suggestions from Jari Aalto <jaalto@tre.tele.nokia.fi>
-;; More robustness (comments in/around doc-strings/ arg lists)
-;; Don't offer to `quote'afy symbols or keystroke representations
-;; that are in lists (sample code) This added new fn
-;; `checkdoc-in-sample-code-p'
-;; Added more comments near the ;;; comment check about why it
-;; is being done. ;;; Are also now allowed inside a defun.
-;; This added the function `checkdoc-outside-major-sexp'
-;; Added `checkdoc-interactive' which permits interactive
-;; perusal of document warnings, and editing of strings.
-;; Fixed `checkdoc-defun-info' to be more robust when creating
-;; the paramter list.
-;; Added list of verbs in the wrong tense, and their fixes.
-;; Added defconst/subst/advice to checked items.
-;; Added `checkdoc-style-hooks' and `checkdoc-comment-style-hooks'
-;; for adding in user tests.
-;; Added `checkdoc-continue', a version of checkdoc that continues
-;; from point.
-;; [X]Emacs 20 support for extended characters.
-;; Only check comments on real files.
-;; Put `checkdoc' and `checkdoc-continue' into keymap/menu
-;; 0.4.1 Made `custom' friendly.
-;; C-m in warning buffer also goes to error.
-;; Shrink error buffer to size of text.
-;; Added `checkdoc-tripple-semi-comment-check-flag'.
-;; `checkdoc-spellcheck-documentation-flag' off by default.
-;; Re-sorted check order so white space is removed before adding a .
-;; 0.4.2 Added some more comments in the commentary.
-;; You can now `quote' symbols that look like keystrokes
-;; When spell checking, meta variables can end in `th' or `s'.
-;; 0.4.3 Fixed bug where multi-function checking skips defuns that
-;; have comments before the doc-string.
-;; Fixed bug where keystrokes were identified from a variable name
-;; like ASSOC-P.
+;; 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.
;; not specifically docstring related. Would this even be useful?
;;; Code:
-(defvar checkdoc-version "0.4.3"
+(defvar checkdoc-version "0.6.1"
"Release version of checkdoc you are currently running.")
;; From custom web page for compatibility between versions of custom:
(eval-and-compile
- (condition-case ()
- (require 'custom)
- (error nil))
- (if (and (featurep 'custom) (fboundp 'custom-declare-variable))
- nil ;; We've got what we needed
- ;; We have the old custom-library, hack around it!
- (defmacro defgroup (&rest args)
- nil)
- (defmacro custom-add-option (&rest args)
- nil)
- (defmacro defcustom (var value doc &rest args)
- (` (defvar (, var) (, value) (, doc))))))
+ (condition-case ()
+ (require 'custom)
+ (error nil))
+ (if (and (featurep 'custom) (fboundp 'custom-declare-variable))
+ nil ;; We've got what we needed
+ ;; We have the old custom-library, hack around it!
+ (defmacro defgroup (&rest args)
+ nil)
+ (defmacro custom-add-option (&rest args)
+ nil)
+ (defmacro defcustom (var value doc &rest args)
+ `(defvar ,var ,value ,doc))))
(defcustom checkdoc-autofix-flag 'semiautomatic
- "*Non-nil means attempt auto-fixing of doc-strings.
-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
+ "*Non-nil means attempt auto-fixing of doc strings.
+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."
+The value `never' is the same as nil, never ask or change anything."
:group 'checkdoc
:type '(choice (const automatic)
- (const semiautomatic)
(const query)
- (const never)))
+ (const never)
+ (other :tag "semiautomatic" semiautomatic)))
(defcustom checkdoc-bouncy-flag t
- "*Non-nil means to 'bounce' to auto-fix locations.
+ "*Non-nil means to \"bounce\" to auto-fix locations.
Setting this to nil will silently make fixes that require no user
interaction. See `checkdoc-autofix-flag' for auto-fixing details."
:group 'checkdoc
(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
-have doc-strings."
+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
- "*Non-nil means to check for multiple adjacent occurrences of ;;; comments.
-According to the style of emacs code in the lisp libraries, a block
-comment can look like this:
-;;; Title
-;; text
-;; text
-But when inside a function, code can be commented out using the ;;;
-construct for all lines. When this variable is nil, the ;;; construct
-is ignored regardless of it's location in the code."
+(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-spellcheck-documentation-flag nil
- "*Non-nil means run ispell on doc-strings based on value.
-This will be automatically set to nil if ispell does not exist on your
+ "*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'
- t - Always spell-check"
+ nil - Don't spell-check during basic style checks.
+ defun - Spell-check when style checking a single defun
+ 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)
(const defun)
(const t)))
(defvar checkdoc-ispell-lisp-words
- '("alist" "etags" "iff" "keymap" "paren" "regexp" "sexp" "xemacs")
- "List of words that are correct when spell-checking lisp documentation.")
+ '("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
- "*The number of \\ [command-to-keystroke] tokens allowed in a doc-string.
+ "*The number of \\ [command-to-keystroke] tokens allowed in a doc string.
Any more than this and a warning is generated suggesting that the construct
\\ {keymap} be used instead."
:group 'checkdoc
A search leaves the cursor in front of the parameter list.")
(defcustom checkdoc-verb-check-experimental-flag t
- "*Non-nil means to attempt to check the voice of the doc-string.
+ "*Non-nil means to attempt to check the voice of the doc string.
This check keys off some words which are commonly misused. See the
-variable `checkdoc-common-verbs-wrong-voice' if you wish to add your
-own."
+variable `checkdoc-common-verbs-wrong-voice' if you wish to add your own."
:group 'checkdoc
:type 'boolean)
+(defvar checkdoc-generate-compile-warnings-flag nil
+ "Non-nil means generate warnings in a buffer for browsing.
+Do not set this by hand, use a function like `checkdoc-current-buffer'
+with a universal argument.")
+
+(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'.")
'(("adds" . "add")
("allows" . "allow")
("appends" . "append")
- ("applies" "apply")
- ("arranges" "arrange")
+ ("applies" . "apply")
+ ("arranges" . "arrange")
("brings" . "bring")
("calls" . "call")
("catches" . "catch")
("changes" . "change")
("checks" . "check")
("contains" . "contain")
+ ("converts" . "convert")
("creates" . "create")
("destroys" . "destroy")
("disables" . "disable")
("executes" . "execute")
- ("evals" . "evaluate")
+ ("evals" . "evaluate")
("evaluates" . "evaluate")
("finds" . "find")
("forces" . "force")
("makes" . "make")
("marks" . "mark")
("matches" . "match")
+ ("moves" . "move")
("notifies" . "notify")
("offers" . "offer")
("parses" . "parse")
("tells" . "tell")
("tests" . "test")
("toggles" . "toggle")
- ("tries" . "try")
+ ("tries" . "try")
("turns" . "turn")
("undoes" . "undo")
("unloads" . "unload")
(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)
)
-
+
;;; Compatibility
;;
(defalias 'checkdoc-call-eval-buffer 'eval-current-buffer)
)
-;; Emacs 20s have MULE characters which dont equate to numbers.
+;; Emacs 20s have MULE characters which don't equate to numbers.
(if (fboundp 'char=)
(defalias 'checkdoc-char= 'char=)
(defalias 'checkdoc-char= '=))
-;; Emacs 19.28 and earlier don't have the handy 'add-to-list function
-(if (fboundp 'add-to-list)
-
- (defalias 'checkdoc-add-to-list 'add-to-list)
-
- (defun checkdoc-add-to-list (list-var element)
- "Add to the value of LIST-VAR the element ELEMENT if it isn't there yet."
- (if (not (member element (symbol-value list-var)))
- (set list-var (cons element (symbol-value list-var)))))
- )
-
-;; To be safe in new emacsen, we want to read events, not characters
-(if (fboundp 'read-event)
- (defalias 'checkdoc-read-event 'read-event)
- (defalias 'checkdoc-read-event 'read-char))
+;; Read events, not characters
+(defalias 'checkdoc-read-event 'read-event)
;;; User level commands
;;
;;;###autoload
-(defun checkdoc-eval-current-buffer ()
- "Evaluate and check documentation for the current buffer.
-Evaluation is done first because good documentation for something that
-doesn't work is just not useful. Comments, Doc-strings, and rogue
-spacing are all verified."
+(defun checkdoc ()
+ "Interactively check the entire buffer for style errors.
+The current status of the check will be displayed in a buffer which
+the users will view as each check is completed."
(interactive)
- (checkdoc-call-eval-buffer nil)
- (checkdoc-current-buffer t))
+ (let ((status (list "Checking..." "-" "-" "-"))
+ (checkdoc-spellcheck-documentation-flag
+ (car (memq checkdoc-spellcheck-documentation-flag
+ '(buffer interactive t))))
+ ;; if the user set autofix to never, then that breaks the
+ ;; obviously requested asking implied by using this function.
+ ;; Set it to paranoia level.
+ (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 list of four strings stating the current status of each
+test; the nth string describes the status of the nth test."
+ (let (temp-buffer-setup-hook)
+ (with-output-to-temp-buffer " *Checkdoc Status*"
+ (princ-list
+ "Buffer comments and tags: " (nth 0 check) "\n"
+ "Documentation style: " (nth 1 check) "\n"
+ "Message/Query text style: " (nth 2 check) "\n"
+ "Unwanted Spaces: " (nth 3 check)
+ )))
+ (shrink-window-if-larger-than-buffer
+ (get-buffer-window " *Checkdoc Status*"))
+ (message nil)
+ (sit-for 0))
;;;###autoload
-(defun checkdoc-current-buffer (&optional take-notes)
- "Check the current buffer for document style, comment style, and rogue spaces.
-Optional argument TAKE-NOTES non-nil will store all found errors in a
-warnings buffer, otherwise it stops after the first error."
+(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")
- (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))))
- ;; 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-rogue-spaces take-notes)
- (not (interactive-p))
- (message "Checking buffer for style...Done."))))
+ (car (memq checkdoc-spellcheck-documentation-flag
+ '(interactive t)))))
+ (prog1
+ ;; Due to a design flaw, this will never spell check
+ ;; docstrings.
+ (checkdoc-interactive-loop start-here showstatus
+ 'checkdoc-next-error)
+ ;; This is a workaround to perform spell checking.
+ (checkdoc-interactive-ispell-loop start-here))))
;;;###autoload
-(defun checkdoc-interactive (&optional start-here)
- "Interactively check the current buffers for errors.
+(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."
+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
+ (car (memq checkdoc-spellcheck-documentation-flag
+ '(interactive t)))))
+ (prog1
+ ;; Due to a design flaw, this will never spell check messages.
+ (checkdoc-interactive-loop start-here showstatus
+ 'checkdoc-next-message-error)
+ ;; This is a workaround to perform spell checking.
+ (checkdoc-message-interactive-ispell-loop start-here))))
+
+(defun checkdoc-interactive-loop (start-here showstatus findfunc)
+ "Interactively loop over all errors that can be found by a given method.
+
+If START-HERE is nil, searching starts at the beginning of the current
+buffer, otherwise searching starts at START-HERE. SHOWSTATUS
+expresses the verbosity of the search, and whether ending the search
+will auto-exit this function.
+
+FINDFUNC is a symbol representing a function that will position the
+cursor, and return error message text to present to the user. It is
+assumed that the cursor will stop just before a major sexp, which will
+be highlighted to present the user with feedback as to the offending
+style."
;; 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)))
+ (car (memq 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)
+ (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.
+ ;; 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 (and (looking-at "\"")
+ (not (pos-visible-in-window-p
+ (save-excursion (forward-sexp 1) (point))
+ (selected-window))))
+ (let ((l (count-lines (point)
+ (save-excursion
+ (forward-sexp 1) (point)))))
+ (if (> l (window-height))
+ (recenter 1)
+ (recenter (/ (- (window-height) l) 2))))
+ (recenter))
+ (message "%s (C-h,%se,n,p,q)" (checkdoc-error-text
+ (car (car err-list)))
+ (if (checkdoc-error-unfixable (car (car err-list)))
+ "" "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)))
(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))))
+ (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 then 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 ((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 stuff
+ (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)
- (message "Checkdoc: Done.")))
-
-(defun checkdoc-next-error ()
+ (if (get-buffer "*Checkdoc Help*") (kill-buffer "*Checkdoc Help*"))
+ (message "Checkdoc: Done.")
+ returnme))
+
+(defun checkdoc-interactive-ispell-loop (start-here)
+ "Interactively spell check doc strings in the current buffer.
+If START-HERE is nil, searching starts at the beginning of the current
+buffer, otherwise searching starts at START-HERE."
+ (when checkdoc-spellcheck-documentation-flag
+ (save-excursion
+ ;; Move point to where we need to start.
+ (if start-here
+ ;; Include whatever function point is in for good measure.
+ (beginning-of-defun)
+ (goto-char (point-min)))
+ ;; Loop over docstrings.
+ (while (checkdoc-next-docstring)
+ (message "Searching for doc string spell error...%d%%"
+ (/ (* 100 (point)) (point-max)))
+ (if (looking-at "\"")
+ (checkdoc-ispell-docstring-engine
+ (save-excursion (forward-sexp 1) (point-marker)))))
+ (message "Checkdoc: Done."))))
+
+(defun checkdoc-message-interactive-ispell-loop (start-here)
+ "Interactively spell check messages in the current buffer.
+If START-HERE is nil, searching starts at the beginning of the current
+buffer, otherwise searching starts at START-HERE."
+ (when checkdoc-spellcheck-documentation-flag
+ (save-excursion
+ ;; Move point to where we need to start.
+ (if start-here
+ ;; Include whatever function point is in for good measure.
+ (beginning-of-defun)
+ (goto-char (point-min)))
+ ;; Loop over message strings.
+ (while (checkdoc-message-text-next-string (point-max))
+ (message "Searching for message string spell error...%d%%"
+ (/ (* 100 (point)) (point-max)))
+ (if (looking-at "\"")
+ (checkdoc-ispell-docstring-engine
+ (save-excursion (forward-sexp 1) (point-marker)))))
+ (message "Checkdoc: Done."))))
+
+
+(defun checkdoc-next-error (enable-fix)
"Find and return the next checkdoc error list, or nil.
-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))
+Only documentation strings are checked.
+An error list is of the form (WARNING . POSITION) where WARNING is the
+warning text, and POSITION is the point in the buffer where the error
+was found. We can use points and not markers because we promise not
+to edit the buffer before point without re-executing this check.
+Argument ENABLE-FIX will enable auto-fixing while looking for the next
+error. This argument assumes that the cursor is already positioned to
+perform the fix."
+ (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 message related error list, or nil.
+Only text for error and `y-or-n-p' strings are checked. See
+`checkdoc-next-error' for details on the return value.
+Argument ENABLE-FIX turns on the auto-fix feature. This argument
+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
+doesn't work is just not useful. Comments, doc strings, and rogue
+spacing are all verified."
+ (interactive)
+ (checkdoc-call-eval-buffer nil)
+ (checkdoc-current-buffer t))
;;;###autoload
-(defun checkdoc (&optional take-notes)
- "Use `checkdoc-continue' starting at the beginning of the current buffer.
+(defun checkdoc-current-buffer (&optional take-notes)
+ "Check current buffer for document, comment, error style, and rogue spaces.
+With a prefix argument (in Lisp, the argument TAKE-NOTES),
+store all errors found in a warnings buffer,
+otherwise stop after the first error."
+ (interactive "P")
+ (if (interactive-p) (message "Checking buffer for style..."))
+ ;; Assign a flag to spellcheck flag
+ (let ((checkdoc-spellcheck-documentation-flag
+ (car (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))
+ (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-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)
;;;###autoload
(defun checkdoc-continue (&optional take-notes)
- "Find the next doc-string 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. Second optional argument START-POINT
is the starting location. If this is nil, `point-min' is used instead."
(interactive "P")
- (let ((wrong nil) (msg nil) (errors nil)
+ (let ((wrong nil) (msg nil)
;; Assign a flag to spellcheck flag
(checkdoc-spellcheck-documentation-flag
- (member checkdoc-spellcheck-documentation-flag
- '(buffer t))))
+ (car (memq checkdoc-spellcheck-documentation-flag
+ '(buffer t))))
+ (checkdoc-autofix-flag (if take-notes 'never
+ checkdoc-autofix-flag))
+ (checkdoc-generate-compile-warnings-flag
+ (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 ()
- "Find the next doc-string after point and return t.
-Return nil if there are no more doc-strings."
+ "Move to the next doc string after point, and return t.
+Return nil if there are no more doc strings."
(if (not (re-search-forward checkdoc-defun-regexp nil t))
nil
;; search drops us after the identifier. The next sexp is either
(skip-chars-forward " \n\t")
t))
-;;; ###autoload
+;;;###autoload
(defun checkdoc-comments (&optional take-notes)
- "Find missing comment sections in the current emacs lisp file.
+ "Find missing comment sections in the current Emacs Lisp 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."
(interactive "P")
(if take-notes (checkdoc-start-section "checkdoc-comments"))
(if (not buffer-file-name)
- (error "Can only check comments for a file buffer."))
+ (error "Can only check comments for a file buffer"))
(let* ((checkdoc-spellcheck-documentation-flag
- (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))
+ (car (memq checkdoc-spellcheck-documentation-flag
+ '(buffer t))))
+ (checkdoc-autofix-flag (if take-notes 'never checkdoc-autofix-flag))
+ (e (checkdoc-file-comments-engine))
+ (checkdoc-generate-compile-warnings-flag
+ (or take-notes checkdoc-generate-compile-warnings-flag)))
+ (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 (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 (message e) (message "Space Check: done.")))))
-
+ (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 it's documentation.
+ "Evaluate the current form with `eval-defun' and check its documentation.
Evaluation is done first so the form will be read before the
documentation is checked. If there is a documentation error, then the display
of what was evaluated will be overwritten by the diagnostic message."
(interactive)
- (eval-defun nil)
+ (call-interactively 'eval-defun)
(checkdoc-defun))
;;;###autoload
(defun checkdoc-defun (&optional no-error)
- "Examine the doc-string of the function or variable under point.
-Calls `error' if the doc-string produces diagnostics. If NO-ERROR is
+ "Examine the doc string of the function or variable under point.
+Call `error' if the doc string has problems. If NO-ERROR is
non-nil, then do not call error, but call `message' instead.
-If the document check passes, then check the function for rogue white
+If the doc string passes the test, then check the function for rogue white
space at the end of each line."
(interactive)
(save-excursion
(if (not (looking-at checkdoc-defun-regexp))
;; I found this more annoying than useful.
;;(if (not no-error)
- ;; (message "Cannot check this sexp's doc-string."))
+ ;; (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.
(forward-sexp 1)
(skip-chars-forward " \n\t")
(let* ((checkdoc-spellcheck-documentation-flag
- (member checkdoc-spellcheck-documentation-flag
- '(defun t)))
+ (car (memq checkdoc-spellcheck-documentation-flag
+ '(defun t))))
+ (beg (save-excursion (beginning-of-defun) (point)))
+ (end (save-excursion (end-of-defun) (point)))
(msg (checkdoc-this-string-valid)))
- (if msg (if no-error (message msg) (error msg))
- (setq msg (checkdoc-rogue-space-check-engine
- (save-excursion (beginning-of-defun) (point))
- (save-excursion (end-of-defun) (point))))
- (if msg (if no-error (message msg) (error msg))
- (if (interactive-p) (message "Checkdoc: done."))))))))
+ (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 (checkdoc-error-text msg))
+ (error (checkdoc-error-text msg)))
+ (setq msg (checkdoc-rogue-space-check-engine beg end))
+ (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)
(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)
+(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-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' with spell-checking turned on.
-Prefix argument TAKE-NOTES is the same as for `checkdoc'"
+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 nil current-prefix-arg)))
+ (call-interactively 'checkdoc-start nil current-prefix-arg)))
;;;###autoload
(defun checkdoc-ispell-continue (&optional take-notes)
;;;###autoload
(defun checkdoc-ispell-defun (&optional take-notes)
- "Check the style and spelling of the current defun with ispell.
+ "Check the style and spelling of the current defun with Ispell.
Calls `checkdoc-defun' with spell-checking turned on.
Prefix argument TAKE-NOTES is the same as for `checkdoc-defun'"
(interactive)
(let ((checkdoc-spellcheck-documentation-flag t))
(call-interactively 'checkdoc-defun nil current-prefix-arg)))
-;;; Minor Mode specification
+;;; Error Management
;;
-(defvar checkdoc-minor-mode nil
- "Non-nil in `emacs-lisp-mode' for automatic documentation checking.")
-(make-variable-buffer-local 'checkdoc-minor-mode)
+;; 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)))
-(checkdoc-add-to-list 'minor-mode-alist '(checkdoc-minor-mode " CDoc"))
+;;; Minor Mode specification
+;;
-(defvar checkdoc-minor-keymap
+(defvar checkdoc-minor-mode-map
(let ((map (make-sparse-keymap))
(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)
map)
"Keymap used to override evaluation key-bindings for documentation checking.")
+(defvaralias 'checkdoc-minor-keymap 'checkdoc-minor-mode-map)
+(make-obsolete-variable 'checkdoc-minor-keymap
+ 'checkdoc-minor-mode-map)
+
;; Add in a menubar with easy-menu
-(if checkdoc-minor-keymap
- (easy-menu-define
- checkdoc-minor-menu checkdoc-minor-keymap "Checkdoc Minor Mode Menu"
- '("CheckDoc"
- ["First Style Error" checkdoc t]
- ["First Style or Spelling Error " checkdoc-ispell 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]
- ["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 for Rogue Spaces" checkdoc-rogue-spaces t]
- )))
+(easy-menu-define
+ nil checkdoc-minor-mode-map "Checkdoc Minor Mode Menu"
+ '("CheckDoc"
+ ["Interactive Buffer Style Check" checkdoc t]
+ ["Interactive Buffer Style and Spelling Check" checkdoc-ispell t]
+ ["Check Buffer" checkdoc-current-buffer t]
+ ["Check and Spell Buffer" checkdoc-ispell-current-buffer t]
+ "---"
+ ["Interactive Style Check" checkdoc-interactive t]
+ ["Interactive Style and Spelling Check" checkdoc-ispell-interactive t]
+ ["Find First Style Error" checkdoc-start t]
+ ["Find First Style or Spelling Error" checkdoc-ispell-start t]
+ ["Next Style Error" checkdoc-continue t]
+ ["Next Style or Spelling Error" checkdoc-ispell-continue t]
+ ["Interactive Message Text Style Check" checkdoc-message-interactive t]
+ ["Interactive Message Text Style and Spelling Check"
+ checkdoc-ispell-message-interactive t]
+ ["Check Message Text" checkdoc-message-text t]
+ ["Check and Spell Message Text" checkdoc-ispell-message-text t]
+ ["Check Comment Style" checkdoc-comments buffer-file-name]
+ ["Check Comment Style and Spelling" checkdoc-ispell-comments
+ buffer-file-name]
+ ["Check for Rogue Spaces" checkdoc-rogue-spaces t]
+ "---"
+ ["Check Defun" checkdoc-defun t]
+ ["Check and Spell Defun" checkdoc-ispell-defun t]
+ ["Check and Evaluate Defun" checkdoc-eval-defun t]
+ ["Check and Evaluate Buffer" checkdoc-eval-current-buffer t]
+ ))
;; XEmacs requires some weird stuff to add this menu in a minor mode.
;; What is it?
-;; Allow re-insertion of a new keymap
-(let ((a (assoc 'checkdoc-minor-mode minor-mode-map-alist)))
- (if a
- (setcdr a checkdoc-minor-keymap)
- (checkdoc-add-to-list 'minor-mode-map-alist (cons 'checkdoc-minor-mode
- checkdoc-minor-keymap))))
-
;;;###autoload
-(defun checkdoc-minor-mode (&optional arg)
- "Toggle checkdoc minor mode. A mode for checking lisp doc-strings.
-With prefix ARG, turn checkdoc minor mode on iff ARG is positive.
+(define-minor-mode checkdoc-minor-mode
+ "Toggle Checkdoc minor mode, a mode for checking Lisp doc strings.
+With prefix ARG, turn Checkdoc minor mode on iff ARG is positive.
-In checkdoc minor mode, the usual bindings for `eval-defun' which is
-bound to \\<checkdoc-minor-keymap> \\[checkdoc-eval-defun] and `checkdoc-eval-current-buffer' are overridden to include
+In Checkdoc minor mode, the usual bindings for `eval-defun' which is
+bound to \\<checkdoc-minor-mode-map>\\[checkdoc-eval-defun] and `checkdoc-eval-current-buffer' are overridden to include
checking of documentation strings.
-\\{checkdoc-minor-keymap}"
- (interactive "P")
- (setq checkdoc-minor-mode
- (not (or (and (null arg) checkdoc-minor-mode)
- (<= (prefix-numeric-value arg) 0))))
- (checkdoc-mode-line-update))
+\\{checkdoc-minor-mode-map}"
+ nil " CDoc" nil
+ :group 'checkdoc)
;;; Subst utils
;;
(if (fboundp 'run-hook-with-args-until-success)
(apply 'run-hook-with-args-until-success hookvar args)
;; This method was similar to above. We ignore the warning
- ;; since we will use the above for future emacs versions
+ ;; since we will use the above for future Emacs versions
(apply 'run-hook-with-args hookvar args)))
(defsubst checkdoc-create-common-verbs-regexp ()
;;; Checking engines
;;
(defun checkdoc-this-string-valid ()
- "Return a message string if the current doc-string is invalid.
+ "Return a message string if the current doc string is invalid.
Check for style only, such as the first line always being a complete
sentence, whitespace restrictions, and making sure there are no
hard-coded key-codes such as C-[char] or mouse-[number] in the comment.
See the style guide in the Emacs Lisp manual for more details."
- ;; Jump over comments between the last object and the doc-string
+ ;; Jump over comments between the last object and the doc string
(while (looking-at "[ \t\n]*;")
(forward-line 1)
(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)))))
-
-(defun checkdoc-this-string-valid-engine ()
- "Return a message string if the current doc-string is invalid.
+ (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. Let's see if we can find the comment, and offer to turn it
+ ;; into documentation for them.
+ (let ((have-comment nil)
+ (comment-start ";")) ; in case it's not default
+ (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 "\"")
+ (let ((docstring-start-point (point)))
+ (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 "\"")
+ (forward-char -1)
+ ;; quote any double-quote characters in the comment.
+ (while (search-backward "\"" docstring-start-point t)
+ (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 (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)))
+ ;; end-of doc string whitespace to also delete the " char.
+ (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
(looking-at "\\([ \t]+\\)[^ \t\n]"))
(if (checkdoc-autofix-ask-replace (match-beginning 1)
(match-end 1)
- "Remove this whitespace?"
+ "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)))))
+ ;; * Check for '(' in column 0.
+ (save-excursion
+ (when (re-search-forward "^(" e t)
+ (if (checkdoc-autofix-ask-replace (match-beginning 0)
+ (match-end 0)
+ "Escape this '('? "
+ "\\(")
+ nil
+ (checkdoc-create-error
+ "Open parenthesis in column 0 should be escaped"
+ (match-beginning 0) (match-end 0)))))
;; * Do not start or end a documentation string with whitespace.
(let (start end)
(if (or (if (looking-at "\"\\([ \t\n]+\\)")
(setq start (point)
end (1- e)))))
(if (checkdoc-autofix-ask-replace
- start end "Remove this whitespace?" "")
+ 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
(not (checkdoc-char= (preceding-char) ?\\)))
;; We might have to add a period in this case
(forward-char -1)
- (if (looking-at "[.!]")
+ (if (looking-at "[.!?]")
nil
(forward-char 1)
(if (checkdoc-autofix-ask-replace
- (point) (1+ (point)) "Add period to sentence?"
+ (point) (1+ (point)) "Add period to sentence? "
".\"" t)
nil
- "First sentence should end with punctuation.")))
- ((looking-at "[\\!;:.)]")
+ (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)))
;; Here we have found a complete sentence, but no break.
(if (checkdoc-autofix-ask-replace
(1+ (match-beginning 0)) (match-end 0)
- "First line not a complete sentence. Add CR here?"
+ "First line not a complete sentence. Add RET here? "
"\n" t)
(let (l1 l2)
(forward-line 1)
(end-of-line)
(current-column)))
(if (> (+ l1 l2 1) 80)
- (setq msg "Incomplete auto-fix. Doc-string \
-may require more formatting.")
+ (setq msg "Incomplete auto-fix; doc string \
+may require more formatting")
;; We can merge these lines! Replace this CR
;; 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
p (1+ p)
- "1st line not a complete sentence. Join these lines?"
+ "1st line not a complete sentence. Join these lines? "
" " 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 "\"\\*")
(if (looking-at "[a-z]")
(if (checkdoc-autofix-ask-replace
(match-beginning 0) (match-end 0)
- "Capitalize your sentence?" (upcase (match-string 0))
+ "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
(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
;; then use `\\{...}' to display the rest of the mode's keymap.
(save-excursion
- (if (re-search-forward "\\\\\\\\\\[\\w+" e t
- (1+ checkdoc-max-keyref-before-warn))
- "Too many occurrences of \\[function]. Use \\{keymap} instead"))
+ (if (and (re-search-forward "\\\\\\\\\\[\\w+" e t
+ (1+ checkdoc-max-keyref-before-warn))
+ (not (re-search-forward "\\\\\\\\{\\w+}" e t)))
+ (checkdoc-create-error
+ "Too many occurrences of \\[function]. Use \\{keymap} instead"
+ s (marker-position e))))
+ ;; 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) 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 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
+ (completing-read
+ "Disambiguating Keyword (default: variable): "
+ '(("function") ("command") ("variable")
+ ("option") ("symbol"))
+ nil t nil nil "variable")))
+ (goto-char (1- mb))
+ (insert disambiguate " ")
+ (forward-word 1))
+ (setq 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 "Lisp symbol %s should appear in `quotes'"
- 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
;; 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")
- ;; If the doc-string starts with "Non-nil means"
+ (checkdoc-create-error
+ "Flag variable doc strings should usually start: Non-nil means"
+ s (marker-position e) t))
+ ;; If the doc string starts with "Non-nil means"
(if (and (looking-at "\"\\*?Non-nil\\s-+means\\s-+")
(not (string-match "-flag$" (car fp))))
- "Flag variables should end in: -flag")
+ (let ((newname
+ (if (string-match "-p$" (car fp))
+ (concat (substring (car fp) 0 -2) "-flag")
+ (concat (car fp) "-flag"))))
+ (if (checkdoc-y-or-n-p
+ (format
+ "Rename to %s and Query-Replace all occurrences? "
+ newname))
+ (progn
+ (beginning-of-defun)
+ (query-replace-regexp
+ (concat "\\<" (regexp-quote (car fp)) "\\>")
+ newname))
+ (checkdoc-create-error
+ "Flag variable names should normally end in `-flag'" s
+ (marker-position e)))))
;; Done with variables
))
(t
(last-pos 0)
(found 1)
(order (and (nth 3 fp) (car (nth 3 fp))))
- (nocheck (append '("&optional" "&rest") (nth 3 fp))))
+ (nocheck (append '("&optional" "&rest") (nth 3 fp)))
+ (inopts nil))
(while (and args found (> found last-pos))
(if (member (car args) nocheck)
- (setq args (cdr args))
+ (setq args (cdr args)
+ inopts t)
(setq last-pos found
found (save-excursion
(re-search-forward
;; Require whitespace OR
;; ITEMth<space> OR
;; ITEMs<space>
- "\\(\\>\\|th\\>\\|s\\>\\)")
+ "\\(\\>\\|th\\>\\|s\\>\\|[.,;:]\\)")
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
(re-search-forward
- (concat "\\<\\(" (car args)
- ;; Require whitespace OR
- ;; ITEMth<space> OR
- ;; ITEMs<space>
- "\\)\\(\\>\\|th\\>\\|s\\>\\)")
- e t))
+ (concat "\\<\\(" (car args)
+ ;; Require whitespace OR
+ ;; ITEMth<space> OR
+ ;; ITEMs<space>
+ "\\)\\(\\>\\|th\\>\\|s\\>\\)")
+ e t))
(if (checkdoc-autofix-ask-replace
(match-beginning 1) (match-end 1)
(format
- "Argument `%s' should appear as `%s'. Fix?"
+ "If this is the argument `%s', it should appear as %s. Fix? "
(car args) (upcase (car args)))
(upcase (car args)) t)
(setq found (match-beginning 1))))))
(if found (setq args (cdr args)))))
(if (not found)
- (format
- "Argument `%s' should appear as `%s' in the doc-string"
- (car args) (upcase (car args)))
+ ;; It wasn't found at all! Offer to attach this new symbol
+ ;; to the end of the documentation string.
+ (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)
+ (insert "\n"
+ (if inopts "Optional a" "A")
+ "rgument " (upcase (car args))
+ " ")
+ (insert (read-string "Describe: "))
+ (if (not (save-excursion (forward-char -1)
+ (looking-at "[.?!]")))
+ (insert "."))
+ nil)
+ (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 imperative.
+ ;; For instance, use `Return the cons of A and
+ ;; B.' in preference to `Returns the cons of A and B.'
+ ;; Usually it looks good to do likewise for the rest of the
+ ;; first paragraph. Subsequent paragraphs usually look better
+ ;; 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-regexp
+ (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 imperative for \"%s\". \
+Replace with \"%s\"? " original replace)
+ replace t)
+ (setq rs nil)))
+ (if rs
+ ;; there was a match, but no replace
+ (checkdoc-create-error
+ (format
+ "Probably \"%s\" should be imperative \"%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 it's complexity,
- ;; and reliance on the ispell program.
+ ;;* 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
(save-excursion (checkdoc-run-hooks 'checkdoc-style-hooks fp e))
(defun checkdoc-defun-info nil
"Return a list of details about the current sexp.
It is a list of the form:
- '( NAME VARIABLE INTERACTIVE NODOCPARAMS PARAMETERS ... )
+ (NAME VARIABLE INTERACTIVE NODOCPARAMS PARAMETERS ...)
where NAME is the name, VARIABLE is t if this is a `defvar',
INTERACTIVE is nil if this is not an interactive function, otherwise
it is the position of the `interactive' call, and PARAMETERS is a
;; Interactive
(save-excursion
(setq ret (cons
- (re-search-forward "(interactive"
+ (re-search-forward "^\\s-*(interactive"
(save-excursion (end-of-defun) (point))
t)
ret)))
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
(nreverse ret))))
(defun checkdoc-in-sample-code-p (start limit)
- "Return Non-nil if the current point is in a code-fragment.
+ "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)
;; 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 "`\\|\"\\|\\.\\|\\\\")))
+ ;; surrounded by /, as in a URL or filename: /emacs/
+ (not (and (= ?/ (char-after e))
+ (= ?/ (char-before b))))
+ (not (checkdoc-in-example-string-p begin end)))
+ (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."
+ (if sentence-end-double-space
+ (save-excursion
+ (let ((case-fold-search nil)
+ (errtxt nil) bb be
+ (old-syntax-table (syntax-table)))
+ (unwind-protect
+ (progn
+ (set-syntax-table checkdoc-syntax-table)
+ (goto-char begin)
+ (while (re-search-forward "[^ .0-9]\\(\\. \\)[^ \n]" end t)
+ (let ((b (match-beginning 1))
+ (e (match-end 1)))
+ (unless (or (checkdoc-in-sample-code-p begin end)
+ (checkdoc-in-example-string-p begin end)
+ (save-excursion
+ (goto-char b)
+ (condition-case nil
+ (progn
+ (forward-sexp -1)
+ ;; piece of an abbreviation
+ (looking-at
+ "\\([a-z]\\|[iI]\\.?e\\|[eE]\\.?g\\)\\."))
+ (error t))))
+ (if (checkdoc-autofix-ask-replace
+ b e
+ "There should be two spaces after a period. Fix? "
+ ". ")
+ nil
+ (if errtxt
+ ;; If there is already an error, then generate
+ ;; the warning output if applicable
+ (if checkdoc-generate-compile-warnings-flag
+ (checkdoc-create-error
+ "There should be two spaces after a period"
+ b e))
+ (setq errtxt
+ "There should be two spaces after a period"
+ bb b be e)))))))
+ (set-syntax-table old-syntax-table))
+ (if errtxt (checkdoc-create-error errtxt bb be))))))
+
;;; Ispell engine
;;
(eval-when-compile (require 'ispell))
(defun checkdoc-ispell-init ()
- "Initialize ispell process (default version) with lisp words.
+ "Initialize Ispell process (default version) with Lisp words.
The words used are from `checkdoc-ispell-lisp-words'. If `ispell'
cannot be loaded, then set `checkdoc-spellcheck-documentation-flag' to
nil."
(condition-case nil
(progn
(ispell-buffer-local-words)
- ;; This code copied in part from ispell.el emacs 19.34
+ ;; This code copied in part from ispell.el Emacs 19.34
(let ((w checkdoc-ispell-lisp-words))
(while w
(process-send-string
(error (setq checkdoc-spellcheck-documentation-flag nil)))))
(defun checkdoc-ispell-docstring-engine (end)
- "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)
+ "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 (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
(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
)
;;; 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 elisp manual about this check,
+ ;; 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?" "")
+ "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)))
;;
(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.
-
- ;; 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))))
-;;; 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
- ))))
+ (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 "^(" nil t))
+ (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 "^(" nil t))
+ (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
+
+ ;; 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)))
+ (when cm
+ (save-excursion
+ (goto-char cm)
+ (let ((e (copy-marker (lm-commentary-end))))
+ ;; Since the comments talk about Lisp, use the
+ ;; specialized spell-checker we also used for doc
+ ;; strings.
+ (checkdoc-sentencespace-region-engine (point) e)
+ (checkdoc-proper-noun-region-engine (point) e)
+ (checkdoc-ispell-docstring-engine e)))))
+ (setq
+ err
+ (or
+ ;; 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."
(or (progn (beginning-of-defun) (bobp))
(progn (end-of-defun) (< (point) p)))))))
+;;; `error' and `message' text verifier.
+;;
+(defun checkdoc-message-text-search (&optional beg end)
+ "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)
+ (type nil))
+ (if (not (or beg end)) (setq beg (point-min) end (point-max)))
+ (goto-char beg)
+ (while (setq type (checkdoc-message-text-next-string end))
+ (setq e (checkdoc-message-text-engine type)))
+ e))
+
+(defun checkdoc-message-text-next-string (end)
+ "Move cursor to the next checkable message string after point.
+Return the message classification.
+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 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':
+ ;; In Emacs, the convention is that error messages start with a capital
+ ;; letter but *do not* end with a period. Please follow this convention
+ ;; for the sake of consistency.
+ (if (and (save-excursion (forward-char 1)
+ (looking-at "[a-z]\\w+"))
+ (not (checkdoc-autofix-ask-replace
+ (match-beginning 0) (match-end 0)
+ "Capitalize your message text? "
+ (capitalize (match-string 0))
+ t)))
+ (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)
+ (looking-at "\\."))
+ (not (checkdoc-autofix-ask-replace (match-beginning 0)
+ (match-end 0)
+ "Remove period from error? "
+ ""
+ t)))
+ (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 (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' argument should end with \"? \". Fix? "
+ "? " t)
+ nil
+ (checkdoc-create-error
+ "`y-or-n-p' argument should end with \"? \""
+ (match-beginning 0) (match-end 0)))
+ (if (save-excursion (forward-sexp 1)
+ (forward-char -2)
+ (looking-at " "))
+ (if (checkdoc-autofix-ask-replace
+ (match-beginning 0) (match-end 0)
+ "`y-or-n-p' argument should end with \"? \". Fix? "
+ "? " t)
+ nil
+ (checkdoc-create-error
+ "`y-or-n-p' argument should end with \"? \""
+ (match-beginning 0) (match-end 0)))
+ (if (and ;; if this isn't true, we have a problem.
+ (save-excursion (forward-sexp 1)
+ (forward-char -1)
+ (looking-at "\""))
+ (checkdoc-autofix-ask-replace
+ (match-beginning 0) (match-end 0)
+ "`y-or-n-p' argument should end with \"? \". Fix? "
+ "? \"" t))
+ nil
+ (checkdoc-create-error
+ "`y-or-n-p' argument should end with \"? \""
+ (match-beginning 0) (match-end 0)))))))
+ ;; Now, let's just run the spell checker on this guy.
+ (checkdoc-ispell-docstring-engine (save-excursion (forward-sexp 1)
+ (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.
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)
(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))
+ '(("^\\*\\*\\* \\(.+\\.el\\): \\([^ \n]+\\)"
+ (1 font-lock-function-name-face)
+ (2 font-lock-comment-face)))
"Keywords used to highlight a checkdoc diagnostic buffer.")
-(defvar checkdoc-output-mode-map nil
- "Keymap used in `checkdoc-output-mode'.")
+(defvar checkdoc-output-error-regex-alist
+ '(("^\\(.+\\.el\\):\\([0-9]+\\): " 1 2)))
-(if checkdoc-output-mode-map
- nil
- (setq checkdoc-output-mode-map (make-sparse-keymap))
- (if (not (string-match "XEmacs" emacs-version))
- (define-key checkdoc-output-mode-map [mouse-2]
- 'checkdoc-find-error-mouse))
- (define-key checkdoc-output-mode-map "\C-c\C-c" 'checkdoc-find-error)
- (define-key checkdoc-output-mode-map "\C-m" 'checkdoc-find-error))
-
-(defun checkdoc-output-mode ()
- "Create and setup the buffer used to maintain checkdoc warnings.
-\\<checkdoc-output-mode-map>\\[checkdoc-find-error] - Go to this error location
-\\[checkdoc-find-error-mouse] - Goto the error clicked on."
- (if (get-buffer checkdoc-diagnostic-buffer)
- (get-buffer checkdoc-diagnostic-buffer)
- (save-excursion
- (set-buffer (get-buffer-create checkdoc-diagnostic-buffer))
- (kill-all-local-variables)
- (setq mode-name "Checkdoc"
- major-mode 'checkdoc-output-mode)
- (set (make-local-variable 'font-lock-defaults)
- '((checkdoc-output-font-lock-keywords) t t ((?- . "w") (?_ . "w"))))
- (use-local-map checkdoc-output-mode-map)
- (run-hooks 'checkdoc-output-mode-hook)
- (current-buffer))))
-
-(defun checkdoc-find-error-mouse (e)
- ;; checkdoc-params: (e)
- "Call `checkdoc-find-error' where the user clicks the mouse."
- (interactive "e")
- (mouse-set-point e)
- (checkdoc-find-error))
-
-(defun checkdoc-find-error ()
- "In a checkdoc diagnostic buffer, find the error under point."
- (interactive)
- (beginning-of-line)
- (if (looking-at "[0-9]+")
- (let ((l (string-to-int (match-string 0)))
- (f (save-excursion
- (re-search-backward " \\(\\(\\w+\\|\\s_\\)+\\.el\\):")
- (match-string 1))))
- (if (not (get-buffer f))
- (error "Can't find buffer %s" f))
- (switch-to-buffer-other-window (get-buffer f))
- (goto-line l))))
+(defvar checkdoc-pending-errors nil
+ "Non-nil when there are errors that have not been displayed yet.")
+
+(define-derived-mode checkdoc-output-mode compilation-mode "Checkdoc"
+ "Set up the major mode for the buffer containing the list of errors."
+ (set (make-local-variable 'compilation-error-regexp-alist)
+ checkdoc-output-error-regex-alist)
+ (set (make-local-variable 'compilation-mode-font-lock-keywords)
+ checkdoc-output-font-lock-keywords))
+
+(defun checkdoc-buffer-label ()
+ "The name to use for a checkdoc buffer in the error list."
+ (if (buffer-file-name)
+ (file-relative-name (buffer-file-name))
+ (concat "#<buffer "(buffer-name) ">")))
(defun checkdoc-start-section (check-type)
"Initialize the checkdoc diagnostic buffer for a pass.
Create the header so that the string CHECK-TYPE is displayed as the
function called to create the messages."
- (checkdoc-output-to-error-buffer
- "\n\n*** " (current-time-string) " "
- (file-name-nondirectory (buffer-file-name)) ": style check: " check-type
- " V " checkdoc-version))
+ (let ((dir default-directory)
+ (label (checkdoc-buffer-label)))
+ (with-current-buffer (get-buffer-create checkdoc-diagnostic-buffer)
+ (checkdoc-output-mode)
+ (setq default-directory dir)
+ (goto-char (point-max))
+ (insert "\n\n\C-l\n*** " label ": " check-type " V " checkdoc-version))))
(defun checkdoc-error (point msg)
"Store POINT and MSG as errors in the checkdoc diagnostic buffer."
- (checkdoc-output-to-error-buffer
- "\n" (int-to-string (count-lines (point-min) (or point 1))) ": "
- msg))
-
-(defun checkdoc-output-to-error-buffer (&rest text)
- "Place TEXT into the checkdoc diagnostic buffer."
- (save-excursion
- (set-buffer (checkdoc-output-mode))
- (goto-char (point-max))
- (apply 'insert text)))
+ (setq checkdoc-pending-errors t)
+ (let ((text (list "\n" (checkdoc-buffer-label) ":"
+ (int-to-string
+ (count-lines (point-min) (or point (point-min))))
+ ": " msg)))
+ (with-current-buffer (get-buffer checkdoc-diagnostic-buffer)
+ (goto-char (point-max))
+ (apply 'insert text))))
(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."
+ "Support for doc string checking in Emacs Lisp."
:prefix "checkdoc"
- :group 'lisp)
+ :group 'lisp
+ :version "20.3")
(custom-add-option 'emacs-lisp-mode-hook
(lambda () (checkdoc-minor-mode 1)))
+(add-to-list 'debug-ignored-errors
+ "Argument `.*' should appear (as .*) in the doc string")
+(add-to-list 'debug-ignored-errors
+ "Lisp symbol `.*' should appear in quotes")
+(add-to-list 'debug-ignored-errors "Disambiguate .* by preceding .*")
+
(provide 'checkdoc)
+
+;;; arch-tag: c49a7ec8-3bb7-46f2-bfbc-d5f26e033b26
;;; checkdoc.el ends here