1 ;;; checkdoc --- Check documentation strings for style requirements
3 ;;; Copyright (C) 1997 Free Software Foundation, Inc.
5 ;; Author: Eric M. Ludlam <zappo@gnu.ai.mit.edu>
7 ;; Keywords: docs, maint, lisp
9 ;; This file is part of GNU Emacs.
11 ;; GNU Emacs is free software; you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation; either version 2, or (at your option)
16 ;; GNU Emacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
24 ;; Boston, MA 02111-1307, USA.
28 ;; The emacs lisp manual has a nice chapter on how to write
29 ;; documentation strings. Many stylistic suggestions are fairly
30 ;; deterministic and easy to check for syntactically, but also easy
31 ;; to forget. The main checkdoc engine will perform the stylistic
32 ;; checks needed to make sure these styles are remembered.
34 ;; There are two ways to use checkdoc:
35 ;; 1) Periodically use `checkdoc'. `checkdoc-current-buffer' and
36 ;; `checkdoc-defun' to check your documentation.
37 ;; 2) Use `checkdoc-minor-mode' to automatically check your
38 ;; documentation whenever you evaluate lisp code with C-M-x
39 ;; or [menu-bar emacs-lisp eval-buffer]. Additional key-bindings
40 ;; are also provided under C-c ? KEY
41 ;; (require 'checkdoc)
42 ;; (add-hook 'emacs-lisp-mode-hook
43 ;; '(lambda () (checkdoc-minor-mode 1)))
47 ;; There are four classifications of style errors in terms of how
48 ;; easy they are to fix. They are simple, complex, really complex,
49 ;; and impossible. (Impossible really means that checkdoc does not
50 ;; have a fixing routine yet.) Typically white-space errors are
51 ;; classified as simple, and are auto-fixed by default. Typographic
52 ;; changes are considered complex, and the user is asked if they want
53 ;; the problem fixed before checkdoc makes the change. These changes
54 ;; can be done without asking if `checkdoc-autofix-flag' is properly
55 ;; set. Potentially redundant changes are considered really complex,
56 ;; and the user is always asked before a change is inserted. The
57 ;; variable `checkdoc-autofix-flag' controls how these types of errors
60 ;; Spell checking doc-strings:
62 ;; The variable `checkdoc-spellcheck-documentation-flag' can be set
63 ;; to customize how spell checking is to be done. Since spell
64 ;; checking can be quite slow, you can optimize how best you want your
65 ;; checking done. The default is 'defun, which spell checks each time
66 ;; `checkdoc-defun' or `checkdoc-eval-defun' is used. Setting to nil
67 ;; prevents spell checking during normal usage.
68 ;; Setting this variable to nil does not mean you cannot take
69 ;; advantage of the spell checking. You can instead use the
70 ;; interactive functions `checkdoc-ispell-*' to check the spelling of
71 ;; your documentation.
72 ;; There is a list of lisp-specific words which checkdoc will
73 ;; install into ispell on the fly, but only if ispell is not already
74 ;; running. Use `ispell-kill-ispell' to make checkdoc restart it with
75 ;; these words enabled.
77 ;; Adding your own checks:
79 ;; You can experiment with adding your own checks by setting the
80 ;; hooks `checkdoc-style-hooks' and `checkdoc-comment-style-hooks'.
81 ;; Return a string which is the error you wish to report. The cursor
82 ;; position should be preserved.
84 ;; This file requires lisp-mnt (lisp maintenance routines) for the
87 ;; Requires custom for emacs v20.
90 ;; 0.1 Initial revision
91 ;; 0.2 Fixed comments in this file to match the emacs lisp standards.
92 ;; Added new doc checks for: variable-flags, function arguments
93 ;; Added autofix functionality for white-space, and quoted variables.
94 ;; Unquoted symbols are allowed after ( character. (Sample code)
95 ;; Check for use of `? ' at end of line and warn.
96 ;; Check for spaces at end of lines for whole file, or one defun.
97 ;; Check for comments standards, including headinds like Code:
98 ;; and use of triple semicolons versus double semicolons
99 ;; Check that interactive functions have a doc-string. Optionally
100 ;; set `checkdoc-force-docstrings-flag' to non-nil to make all
101 ;; definitions have a doc-string.
102 ;; 0.3 Regexp changse for accuracy on var checking and param checking.
103 ;; lm-verify check expanded to each sub-call w/ more descriptive
104 ;; messages, and two autofix-options.
105 ;; Suggestions/patches from Christoph Wedler <wedler@fmi.uni-passau.de>
106 ;; XEmacs support w/ extents/overlays.
107 ;; Better Whitespace finding regexps
108 ;; Added `checkdoc-arguments-in-order-flag' to optionally turn off
109 ;; warnings of arguments that do not appear in order in doc
111 ;; 0.4 New fix routine when two lines can be joined to make the
112 ;; first line a comlete sentence.
113 ;; Added ispell code. Use `checkdoc-spellcheck-documentation-flag'
114 ;; to enable or disable this test in certain contexts.
115 ;; Added ispell interface functions `checkdoc-ispell',
116 ;; `checkdoc-ispell-continue', `checkdoc-ispell-defun'
117 ;; `checkdoc-ispell-interactive', `checkdoc-ispell-current-buffer'.
118 ;; Loop through all potential unquoted symbols.
119 ;; Auto-fixing no longer screws up the "end" of the doc-string.
120 ;; Maintain a different syntax table when examining arguments.
121 ;; Autofix enabled for parameters which are not uppercase iff they
122 ;; occur in lower case in the doc-string.
123 ;; Autofix enable if there is no Code: label.
124 ;; The comment text ";; checkdoc-order: nil|t" inside a defun to
125 ;; enable or disable the checking of argument order for one defun.
126 ;; The comment text ";; checkdoc-params: (arg1 arg2)" inside a defun
127 ;; (Such as just before the doc string) will list ARG1 and ARG2 as
128 ;; being paramters that need not show up in the doc string.
129 ;; Brought in suggestions from Jari Aalto <jaalto@tre.tele.nokia.fi>
130 ;; More robustness (comments in/around doc-strings/ arg lists)
131 ;; Don't offer to `quote'afy symbols or keystroke representations
132 ;; that are in lists (sample code) This added new fn
133 ;; `checkdoc-in-sample-code-p'
134 ;; Added more comments near the ;;; comment check about why it
135 ;; is being done. ;;; Are also now allowed inside a defun.
136 ;; This added the function `checkdoc-outside-major-sexp'
137 ;; Added `checkdoc-interactive' which permits interactive
138 ;; perusal of document warnings, and editing of strings.
139 ;; Fixed `checkdoc-defun-info' to be more robust when creating
140 ;; the paramter list.
141 ;; Added list of verbs in the wrong tense, and their fixes.
142 ;; Added defconst/subst/advice to checked items.
143 ;; Added `checkdoc-style-hooks' and `checkdoc-comment-style-hooks'
144 ;; for adding in user tests.
145 ;; Added `checkdoc-continue', a version of checkdoc that continues
147 ;; [X]Emacs 20 support for extended characters.
148 ;; Only check comments on real files.
149 ;; Put `checkdoc' and `checkdoc-continue' into keymap/menu
150 ;; 0.4.1 Made `custom' friendly.
151 ;; C-m in warning buffer also goes to error.
152 ;; Shrink error buffer to size of text.
153 ;; Added `checkdoc-tripple-semi-comment-check-flag'.
154 ;; `checkdoc-spellcheck-documentation-flag' off by default.
155 ;; Re-sorted check order so white space is removed before adding a .
158 ;; Hook into the byte compiler on a defun/defver level to generate
159 ;; warnings in the byte-compiler's warning/error buffer.
160 ;; Better ways to override more typical `eval' functions. Advice
161 ;; might be good but hard to turn on/off as a minor mode.
164 ;; Code sweep checks for "forbidden functions", proper use of hooks,
165 ;; proper keybindings, and other items from the manual that are
166 ;; not specifically docstring related. Would this even be useful?
169 (defvar checkdoc-version
"0.4.1"
170 "Release version of checkdoc you are currently running.")
172 ;; From custom web page for compatibility between versions of custom:
177 (if (and (featurep 'custom
) (fboundp 'custom-declare-variable
))
178 nil
;; We've got what we needed
179 ;; We have the old custom-library, hack around it!
180 (defmacro defgroup
(&rest args
)
182 (defmacro custom-add-option
(&rest args
)
184 (defmacro defcustom
(var value doc
&rest args
)
185 (` (defvar (, var
) (, value
) (, doc
))))))
187 (defcustom checkdoc-autofix-flag
'semiautomatic
188 "*Non-nil means attempt auto-fixing of doc-strings.
189 If this value is the symbol 'query, then the user is queried before
190 any change is made. If the value is 'automatic, then all changes are
191 made without asking unless the change is very-complex. If the value
192 is 'semiautomatic, or any other value, then simple fixes are made
193 without asking, and complex changes are made by asking the user first.
194 The value 'never is the same as nil, never ask or change anything."
196 :type
'(choice (const automatic
)
197 (const semiautomatic
)
201 (defcustom checkdoc-bouncy-flag t
202 "*Non-nil means to 'bounce' to auto-fix locations.
203 Setting this to nil will silently make fixes that require no user
204 interaction. See `checkdoc-autofix-flag' for auto-fixing details."
208 (defcustom checkdoc-force-docstrings-flag t
209 "*Non-nil means that all checkable definitions should have documentation.
210 Style guide dictates that interactive functions MUST have documentation,
211 and that its good but not required practice to make non user visible items
216 (defcustom checkdoc-tripple-semi-comment-check-flag t
217 "*Non-nil means to check for multiple adjacent occurrences of ;;; comments.
218 According to the style of emacs code in the lisp libraries, a block
219 comment can look like this:
223 But when inside a function, code can be commented out using the ;;;
224 construct for all lines. When this variable is nil, the ;;; construct
225 is ignored regardless of it's location in the code."
229 (defcustom checkdoc-spellcheck-documentation-flag nil
230 "*Non-nil means run ispell on doc-strings based on value.
231 This will be automatically set to nil if ispell does not exist on your
232 system. Possible values are:
234 nil - Don't spell-check during basic style checks.
235 'defun - Spell-check when style checking a single defun
236 'buffer - Spell-check only when style checking the whole buffer
237 'interactive - Spell-check only during `checkdoc-interactive'
238 t - Always spell-check"
240 :type
'(choice (const nil
)
246 (defvar checkdoc-ispell-lisp-words
247 '("alist" "etags" "iff" "keymap" "paren" "regexp" "sexp" "xemacs")
248 "List of words that are correct when spell-checking lisp documentation.")
250 (defcustom checkdoc-max-keyref-before-warn
10
251 "*The number of \\ [command-to-keystroke] tokens allowed in a doc-string.
252 Any more than this and a warning is generated suggesting that the construct
253 \\ {keymap} be used instead."
257 (defcustom checkdoc-arguments-in-order-flag t
258 "*Non-nil means warn if arguments appear out of order.
259 Setting this to nil will mean only checking that all the arguments
260 appear in the proper form in the documentation, not that they are in
261 the same order as they appear in the argument list. No mention is
262 made in the style guide relating to order."
266 (defvar checkdoc-style-hooks nil
267 "Hooks called after the standard style check is completed.
268 All hooks must return nil or a string representing the error found.
269 Useful for adding new user implemented commands.
271 Each hook is called with two parameters, (DEFUNINFO ENDPOINT).
272 DEFUNINFO is the return value of `checkdoc-defun-info'. ENDPOINT is the
273 location of end of the documentation string.")
275 (defvar checkdoc-comment-style-hooks nil
276 "Hooks called after the standard comment style check is completed.
277 Must return nil if no errors are found, or a string describing the
278 problem discovered. This is useful for adding additional checks.")
280 (defvar checkdoc-diagnostic-buffer
"*Style Warnings*"
281 "Name of the buffer where checkdoc stores warning messages.")
283 (defvar checkdoc-defun-regexp
284 "^(def\\(un\\|var\\|custom\\|macro\\|const\\|subst\\|advice\\)\
285 \\s-+\\(\\(\\sw\\|\\s_\\)+\\)[ \t\n]+"
286 "Regular expression used to identify a defun.
287 A search leaves the cursor in front of the parameter list.")
289 (defcustom checkdoc-verb-check-experimental-flag t
290 "*Non-nil means to attempt to check the voice of the doc-string.
291 This check keys off some words which are commonly misused. See the
292 variable `checkdoc-common-verbs-wrong-voice' if you wish to add your
297 (defvar checkdoc-common-verbs-regexp nil
298 "Regular expression derived from `checkdoc-common-verbs-regexp'.")
300 (defvar checkdoc-common-verbs-wrong-voice
303 ("appends" .
"append")
305 ("arranges" "arrange")
308 ("catches" .
"catch")
309 ("changes" .
"change")
311 ("contains" .
"contain")
312 ("creates" .
"create")
313 ("destroys" .
"destroy")
314 ("disables" .
"disable")
315 ("executes" .
"execute")
316 ("evals" .
"evaluate")
317 ("evaluates" .
"evaluate")
320 ("gathers" .
"gather")
321 ("generates" .
"generate")
323 ("guesses" .
"guess")
324 ("highlights" .
"highlight")
326 ("ignores" .
"ignore")
327 ("indents" .
"indent")
328 ("initializes" .
"initialize")
329 ("inserts" .
"insert")
330 ("installs" .
"install")
331 ("investigates" .
"investigate")
340 ("matches" .
"match")
341 ("notifies" .
"notify")
344 ("performs" .
"perform")
345 ("prepares" .
"prepare")
346 ("prepends" .
"prepend")
349 ("removes" .
"remove")
350 ("replaces" .
"replace")
352 ("restores" .
"restore")
353 ("returns" .
"return")
357 ("searches" .
"search")
358 ("selects" .
"select")
362 ("signifies" .
"signify")
366 ("switches" .
"switch")
369 ("toggles" .
"toggle")
373 ("unloads" .
"unload")
374 ("unmarks" .
"unmark")
375 ("updates" .
"update")
379 "Alist of common words in the wrong voice and what should be used instead.
380 Set `checkdoc-verb-check-experimental-flag' to nil to avoid this costly
381 and experimental check. Do not modify this list without setting
382 the value of `checkdoc-common-verbs-regexp' to nil which cause it to
385 (defvar checkdoc-syntax-table nil
386 "Syntax table used by checkdoc in document strings.")
388 (if checkdoc-syntax-table
390 (setq checkdoc-syntax-table
(copy-syntax-table emacs-lisp-mode-syntax-table
))
391 ;; When dealing with syntax in doc-strings, make sure that - are encompased
392 ;; in words so we can use cheap \\> to get the end of a symbol, not the
393 ;; end of a word in a conglomerate.
394 (modify-syntax-entry ?-
"w" checkdoc-syntax-table
)
400 (if (string-match "X[Ee]macs" emacs-version
)
402 (defalias 'checkdoc-make-overlay
'make-extent
)
403 (defalias 'checkdoc-overlay-put
'set-extent-property
)
404 (defalias 'checkdoc-delete-overlay
'delete-extent
)
405 (defalias 'checkdoc-overlay-start
'extent-start
)
406 (defalias 'checkdoc-overlay-end
'extent-end
)
407 (defalias 'checkdoc-mode-line-update
'redraw-modeline
)
408 (defalias 'checkdoc-call-eval-buffer
'eval-buffer
)
410 (defalias 'checkdoc-make-overlay
'make-overlay
)
411 (defalias 'checkdoc-overlay-put
'overlay-put
)
412 (defalias 'checkdoc-delete-overlay
'delete-overlay
)
413 (defalias 'checkdoc-overlay-start
'overlay-start
)
414 (defalias 'checkdoc-overlay-end
'overlay-end
)
415 (defalias 'checkdoc-mode-line-update
'force-mode-line-update
)
416 (defalias 'checkdoc-call-eval-buffer
'eval-current-buffer
)
419 ;; Emacs 20s have MULE characters which dont equate to numbers.
421 (defalias 'checkdoc-char
= 'char
=)
422 (defalias 'checkdoc-char
= '=))
424 ;; Emacs 19.28 and earlier don't have the handy 'add-to-list function
425 (if (fboundp 'add-to-list
)
427 (defalias 'checkdoc-add-to-list
'add-to-list
)
429 (defun checkdoc-add-to-list (list-var element
)
430 "Add to the value of LIST-VAR the element ELEMENT if it isn't there yet."
431 (if (not (member element
(symbol-value list-var
)))
432 (set list-var
(cons element
(symbol-value list-var
)))))
435 ;; To be safe in new emacsen, we want to read events, not characters
436 (if (fboundp 'read-event
)
437 (defalias 'checkdoc-read-event
'read-event
)
438 (defalias 'checkdoc-read-event
'read-char
))
440 ;;; User level commands
443 (defun checkdoc-eval-current-buffer ()
444 "Evaluate and check documentation for the current buffer.
445 Evaluation is done first because good documentation for something that
446 doesn't work is just not useful. Comments, Doc-strings, and rogue
447 spacing are all verified."
449 (checkdoc-call-eval-buffer nil
)
450 (checkdoc-current-buffer t
))
453 (defun checkdoc-current-buffer (&optional take-notes
)
454 "Check the current buffer for document style, comment style, and rogue spaces.
455 Optional argument TAKE-NOTES non-nil will store all found errors in a
456 warnings buffer, otherwise it stops after the first error."
458 (if (interactive-p) (message "Checking buffer for style..."))
459 ;; Assign a flag to spellcheck flag
460 (let ((checkdoc-spellcheck-documentation-flag
461 (memq checkdoc-spellcheck-documentation-flag
'(buffer t
))))
462 ;; every test is responsible for returning the cursor.
463 (or (and buffer-file-name
;; only check comments in a file
464 (checkdoc-comments take-notes
))
465 (checkdoc take-notes
)
466 (checkdoc-rogue-spaces take-notes
)
467 (not (interactive-p))
468 (message "Checking buffer for style...Done."))))
471 (defun checkdoc-interactive (&optional start-here
)
472 "Interactively check the current buffers for errors.
473 Prefix argument START-HERE will start the checking from the current
474 point, otherwise the check starts at the beginning of the current
475 buffer. Allows navigation forward and backwards through document
476 errors. Does not check for comment or space warnings."
478 ;; Determine where to start the test
479 (let* ((begin (prog1 (point)
480 (if (not start-here
) (goto-char (point-min)))))
481 ;; Assign a flag to spellcheck flag
482 (checkdoc-spellcheck-documentation-flag
483 (member checkdoc-spellcheck-documentation-flag
484 '(buffer interactive t
)))
485 ;; Fetch the error list
486 (err-list (list (checkdoc-next-error))))
487 (if (not (car err-list
)) (setq err-list nil
))
488 ;; Include whatever function point is in for good measure.
491 (goto-char (cdr (car err-list
)))
492 ;; The cursor should be just in front of the offending doc-string
493 (let ((cdo (save-excursion
494 (checkdoc-make-overlay (point)
495 (progn (forward-sexp 1)
500 (checkdoc-overlay-put cdo
'face
'highlight
)
501 ;; Make sure the whole doc-string is visible if possible.
503 (if (not (pos-visible-in-window-p
504 (save-excursion (forward-sexp 1) (point))
507 (message "%s(? e n p q)" (car (car err-list
)))
508 (setq c
(checkdoc-read-event))
509 (if (not (integerp c
)) (setq c ??
))
510 (cond ((or (checkdoc-char= c ?n
) (checkdoc-char= c ?\
))
511 (let ((ne (checkdoc-next-error)))
514 (message "No More Stylistic Errors.")
516 (setq err-list
(cons ne err-list
)))))
517 ((or (checkdoc-char= c ?p
) (checkdoc-char= c ?\C-?
))
518 (if (/= (length err-list
) 1)
520 (setq err-list
(cdr err-list
))
521 ;; This will just re-ask fixup questions if
522 ;; it was skipped the last time.
523 (checkdoc-next-error))
524 (message "No Previous Errors.")
526 ((checkdoc-char= c ?e
)
527 (message "Edit the docstring, and press C-M-c to exit.")
529 (checkdoc-delete-overlay cdo
)
530 (setq err-list
(cdr err-list
)) ;back up the error found.
532 (let ((ne (checkdoc-next-error)))
535 (message "No More Stylistic Errors.")
537 (setq err-list
(cons ne err-list
)))))
538 ((checkdoc-char= c ?q
)
542 (message "[E]dit [SPC|n] next error [DEL|p] prev error\
545 (checkdoc-delete-overlay cdo
))))
547 (message "Checkdoc: Done.")))
549 (defun checkdoc-next-error ()
550 "Find and return the next checkdoc error list, or nil.
551 Add error vector is of the form (WARNING . POSITION) where WARNING
552 is the warning text, and POSITION is the point in the buffer where the
553 error was found. We can use points and not markers because we promise
554 not to edit the buffer before point without re-executing this check."
555 (let ((msg nil
) (p (point)))
557 (while (and (not msg
) (checkdoc-next-docstring))
558 (message "Searching for doc-string error...%d%%"
559 (/ (* 100 (point)) (point-max)))
560 (if (setq msg
(checkdoc-this-string-valid))
561 (setq msg
(cons msg
(point)))))
562 ;; Quit.. restore position, Other errors, leave alone
563 (quit (goto-char p
)))
567 (defun checkdoc (&optional take-notes
)
568 "Use `checkdoc-continue' starting at the beginning of the current buffer.
569 Prefix argument TAKE-NOTES means to collect all the warning messages into
573 (goto-char (point-min))
574 (checkdoc-continue take-notes
)
575 ;; Go back since we can't be here without success above.
580 (defun checkdoc-continue (&optional take-notes
)
581 "Find the next doc-string in the current buffer which is stylisticly poor.
582 Prefix argument TAKE-NOTES means to continue through the whole buffer and
583 save warnings in a separate buffer. Second optional argument START-POINT
584 is the starting location. If this is nil, `point-min' is used instead."
586 (let ((wrong nil
) (msg nil
) (errors nil
)
587 ;; Assign a flag to spellcheck flag
588 (checkdoc-spellcheck-documentation-flag
589 (member checkdoc-spellcheck-documentation-flag
592 ;; If we are taking notes, encompass the whole buffer, otherwise
593 ;; the user is navigating down through the buffer.
594 (if take-notes
(checkdoc-start-section "checkdoc"))
595 (while (and (not wrong
) (checkdoc-next-docstring))
596 (if (not (checkdoc-char= (following-char) ?
\"))
599 ;; OK, lets look at the doc-string.
600 (setq msg
(checkdoc-this-string-valid))
605 (checkdoc-error (point) msg
)
607 (setq wrong
(point)))))))
612 (if (and take-notes errors
)
613 (checkdoc-show-diagnostics)
615 (message "No style warnings.")))))
617 (defun checkdoc-next-docstring ()
618 "Find the next doc-string after point and return t.
619 Return nil if there are no more doc-strings."
620 (if (not (re-search-forward checkdoc-defun-regexp nil t
))
622 ;; search drops us after the identifier. The next sexp is either
623 ;; the argument list or the value of the variable. skip it.
625 (skip-chars-forward " \n\t")
629 (defun checkdoc-comments (&optional take-notes
)
630 "Find missing comment sections in the current emacs lisp file.
631 Prefix argument TAKE-NOTES non-nil means to save warnings in a
632 separate buffer. Otherwise print a message. This returns the error
635 (if take-notes
(checkdoc-start-section "checkdoc-comments"))
636 (if (not buffer-file-name
)
637 (error "Can only check comments for a file buffer."))
638 (let* ((checkdoc-spellcheck-documentation-flag
639 (member checkdoc-spellcheck-documentation-flag
641 (e (checkdoc-file-comments-engine)))
644 (checkdoc-error nil e
)
646 (if (and e take-notes
)
647 (checkdoc-show-diagnostics))
651 (defun checkdoc-rogue-spaces (&optional take-notes
)
652 "Find extra spaces at the end of lines in the current file.
653 Prefix argument TAKE-NOTES non-nil means to save warnings in a
654 separate buffer. Otherwise print a message. This returns the error
657 (if take-notes
(checkdoc-start-section "checkdoc-rogue-spaces"))
658 (let ((e (checkdoc-rogue-space-check-engine)))
661 (checkdoc-error nil e
)
663 (if (and e take-notes
)
664 (checkdoc-show-diagnostics))
665 (if (not (interactive-p))
667 (if e
(message e
) (message "Space Check: done.")))))
671 (defun checkdoc-eval-defun ()
672 "Evaluate the current form with `eval-defun' and check it's documentation.
673 Evaluation is done first so the form will be read before the
674 documentation is checked. If there is a documentation error, then the display
675 of what was evaluated will be overwritten by the diagnostic message."
681 (defun checkdoc-defun (&optional no-error
)
682 "Examine the doc-string of the function or variable under point.
683 Calls `error' if the doc-string produces diagnostics. If NO-ERROR is
684 non-nil, then do not call error, but call `message' instead.
685 If the document check passes, then check the function for rogue white
686 space at the end of each line."
690 (if (not (looking-at checkdoc-defun-regexp
))
691 ;; I found this more annoying than useful.
693 ;; (message "Cannot check this sexp's doc-string."))
695 ;; search drops us after the identifier. The next sexp is either
696 ;; the argument list or the value of the variable. skip it.
697 (goto-char (match-end 0))
699 (skip-chars-forward " \n\t")
700 (let* ((checkdoc-spellcheck-documentation-flag
701 (member checkdoc-spellcheck-documentation-flag
703 (msg (checkdoc-this-string-valid)))
704 (if msg
(if no-error
(message msg
) (error msg
))
705 (setq msg
(checkdoc-rogue-space-check-engine
706 (save-excursion (beginning-of-defun) (point))
707 (save-excursion (end-of-defun) (point))))
708 (if msg
(if no-error
(message msg
) (error msg
))
709 (if (interactive-p) (message "Checkdoc: done."))))))))
711 ;;; Ispell interface for forcing a spell check
715 (defun checkdoc-ispell-current-buffer (&optional take-notes
)
716 "Check the style and spelling of the current buffer interactively.
717 Calls `checkdoc-current-buffer' with spell-checking turned on.
718 Prefix argument TAKE-NOTES is the same as for `checkdoc-current-buffer'"
720 (let ((checkdoc-spellcheck-documentation-flag t
))
721 (call-interactively 'checkdoc-current-buffer nil current-prefix-arg
)))
724 (defun checkdoc-ispell-interactive (&optional take-notes
)
725 "Check the style and spelling of the current buffer interactively.
726 Calls `checkdoc-interactive' with spell-checking turned on.
727 Prefix argument TAKE-NOTES is the same as for `checkdoc-interacitve'"
729 (let ((checkdoc-spellcheck-documentation-flag t
))
730 (call-interactively 'checkdoc-interactive nil current-prefix-arg
)))
733 (defun checkdoc-ispell (&optional take-notes
)
734 "Check the style and spelling of the current buffer.
735 Calls `checkdoc' with spell-checking turned on.
736 Prefix argument TAKE-NOTES is the same as for `checkdoc'"
738 (let ((checkdoc-spellcheck-documentation-flag t
))
739 (call-interactively 'checkdoc nil current-prefix-arg
)))
742 (defun checkdoc-ispell-continue (&optional take-notes
)
743 "Check the style and spelling of the current buffer after point.
744 Calls `checkdoc-continue' with spell-checking turned on.
745 Prefix argument TAKE-NOTES is the same as for `checkdoc-continue'"
747 (let ((checkdoc-spellcheck-documentation-flag t
))
748 (call-interactively 'checkdoc-continue nil current-prefix-arg
)))
751 (defun checkdoc-ispell-comments (&optional take-notes
)
752 "Check the style and spelling of the current buffer's comments.
753 Calls `checkdoc-comments' with spell-checking turned on.
754 Prefix argument TAKE-NOTES is the same as for `checkdoc-comments'"
756 (let ((checkdoc-spellcheck-documentation-flag t
))
757 (call-interactively 'checkdoc-comments nil current-prefix-arg
)))
760 (defun checkdoc-ispell-defun (&optional take-notes
)
761 "Check the style and spelling of the current defun with ispell.
762 Calls `checkdoc-defun' with spell-checking turned on.
763 Prefix argument TAKE-NOTES is the same as for `checkdoc-defun'"
765 (let ((checkdoc-spellcheck-documentation-flag t
))
766 (call-interactively 'checkdoc-defun
nil current-prefix-arg
)))
768 ;;; Minor Mode specification
770 (defvar checkdoc-minor-mode nil
771 "Non-nil in `emacs-lisp-mode' for automatic documentation checking.")
772 (make-variable-buffer-local 'checkdoc-minor-mode
)
774 (checkdoc-add-to-list 'minor-mode-alist
'(checkdoc-minor-mode " CDoc"))
776 (defvar checkdoc-minor-keymap
777 (let ((map (make-sparse-keymap))
778 (pmap (make-sparse-keymap)))
779 ;; Override some bindings
780 (define-key map
"\C-\M-x" 'checkdoc-eval-defun
)
781 (if (not (string-match "XEmacs" emacs-version
))
782 (define-key map
[menu-bar emacs-lisp eval-buffer
]
783 'checkdoc-eval-current-buffer
))
784 (define-key pmap
"x" 'checkdoc-defun
)
785 (define-key pmap
"X" 'checkdoc-ispell-defun
)
786 (define-key pmap
"`" 'checkdoc-continue
)
787 (define-key pmap
"~" 'checkdoc-ispell-continue
)
788 (define-key pmap
"d" 'checkdoc
)
789 (define-key pmap
"D" 'checkdoc-ispell
)
790 (define-key pmap
"i" 'checkdoc-interactive
)
791 (define-key pmap
"I" 'checkdoc-ispell-interactive
)
792 (define-key pmap
"b" 'checkdoc-current-buffer
)
793 (define-key pmap
"B" 'checkdoc-ispell-current-buffer
)
794 (define-key pmap
"e" 'checkdoc-eval-current-buffer
)
795 (define-key pmap
"c" 'checkdoc-comments
)
796 (define-key pmap
"C" 'checkdoc-ispell-comments
)
797 (define-key pmap
" " 'checkdoc-rogue-spaces
)
799 ;; bind our submap into map
800 (define-key map
"\C-c?" pmap
)
802 "Keymap used to override evaluation key-bindings for documentation checking.")
804 ;; Add in a menubar with easy-menu
806 (if checkdoc-minor-keymap
808 checkdoc-minor-menu checkdoc-minor-keymap
"Checkdoc Minor Mode Menu"
810 ["First Style Error" checkdoc t
]
811 ["First Style or Spelling Error " checkdoc-ispell t
]
812 ["Next Style Error" checkdoc-continue t
]
813 ["Next Style or Spelling Error" checkdoc-ispell-continue t
]
814 ["Interactive Style Check" checkdoc-interactive t
]
815 ["Interactive Style and Spelling Check" checkdoc-ispell-interactive t
]
816 ["Check Defun" checkdoc-defun
t]
817 ["Check and Spell Defun" checkdoc-ispell-defun
t]
818 ["Check and Evaluate Defun" checkdoc-eval-defun
t]
819 ["Check Buffer" checkdoc-current-buffer t
]
820 ["Check and Spell Buffer" checkdoc-ispell-current-buffer t
]
821 ["Check and Evaluate Buffer" checkdoc-eval-current-buffer t
]
822 ["Check Comment Style" checkdoc-comments buffer-file-name
]
823 ["Check Comment Style and Spelling" checkdoc-ispell-comments
825 ["Check for Rogue Spaces" checkdoc-rogue-spaces t
]
827 ;; XEmacs requires some weird stuff to add this menu in a minor mode.
830 ;; Allow re-insertion of a new keymap
831 (let ((a (assoc 'checkdoc-minor-mode minor-mode-map-alist
)))
833 (setcdr a checkdoc-minor-keymap
)
834 (checkdoc-add-to-list 'minor-mode-map-alist
(cons 'checkdoc-minor-mode
835 checkdoc-minor-keymap
))))
838 (defun checkdoc-minor-mode (&optional arg
)
839 "Toggle checkdoc minor mode. A mode for checking lisp doc-strings.
840 With prefix ARG, turn checkdoc minor mode on iff ARG is positive.
842 In checkdoc minor mode, the usual bindings for `eval-defun' which is
843 bound to \\<checkdoc-minor-keymap> \\[checkdoc-eval-defun] and `checkdoc-eval-current-buffer' are overridden to include
844 checking of documentation strings.
846 \\{checkdoc-minor-keymap}"
848 (setq checkdoc-minor-mode
849 (not (or (and (null arg
) checkdoc-minor-mode
)
850 (<= (prefix-numeric-value arg
) 0))))
851 (checkdoc-mode-line-update))
855 (defsubst checkdoc-run-hooks
(hookvar &rest args
)
856 "Run hooks in HOOKVAR with ARGS."
857 (if (fboundp 'run-hook-with-args-until-success
)
858 (apply 'run-hook-with-args-until-success hookvar args
)
859 ;; This method was similar to above. We ignore the warning
860 ;; since we will use the above for future emacs versions
861 (apply 'run-hook-with-args hookvar args
)))
863 (defsubst checkdoc-create-common-verbs-regexp
()
864 "Rebuild the contents of `checkdoc-common-verbs-regexp'."
865 (or checkdoc-common-verbs-regexp
866 (setq checkdoc-common-verbs-regexp
868 (mapconcat (lambda (e) (concat (car e
)))
869 checkdoc-common-verbs-wrong-voice
"\\|")
872 ;; Profiler says this is not yet faster than just calling assoc
873 ;;(defun checkdoc-word-in-alist-vector (word vector)
874 ;; "Check to see if WORD is in the car of an element of VECTOR.
875 ;;VECTOR must be sorted. The CDR should be a replacement. Since the
876 ;;word list is getting bigger, it is time for a quick bisecting search."
877 ;; (let ((max (length vector)) (min 0) i
878 ;; (found nil) (fw nil))
879 ;; (setq i (/ max 2))
880 ;; (while (and (not found) (/= min max))
881 ;; (setq fw (car (aref vector i)))
882 ;; (cond ((string= word fw) (setq found (cdr (aref vector i))))
883 ;; ((string< word fw) (setq max i))
885 ;; (setq i (/ (+ max min) 2))
891 (defun checkdoc-this-string-valid ()
892 "Return a message string if the current doc-string is invalid.
893 Check for style only, such as the first line always being a complete
894 sentence, whitespace restrictions, and making sure there are no
895 hard-coded key-codes such as C-[char] or mouse-[number] in the comment.
896 See the style guide in the Emacs Lisp manual for more details."
898 ;; Jump over comments between the last object and the doc-string
899 (while (looking-at "[ \t\n]*;")
902 (skip-chars-forward " \n\t"))
904 (if (not (looking-at "[ \t\n]*\""))
906 (let ((old-syntax-table (syntax-table)))
909 (set-syntax-table checkdoc-syntax-table
)
910 (checkdoc-this-string-valid-engine))
911 (set-syntax-table old-syntax-table
)))))
913 (defun checkdoc-this-string-valid-engine ()
914 "Return a message string if the current doc-string is invalid.
915 Depends on `checkdoc-this-string-valid' to reset the syntax table so that
916 regexp short cuts work."
917 (let ((case-fold-search nil
)
918 ;; Use a marker so if an early check modifies the text,
919 ;; we won't accidentally loose our place. This could cause
920 ;; end-of doc-string whitespace to also delete the " char.
921 (e (save-excursion (forward-sexp 1) (point-marker)))
922 (fp (checkdoc-defun-info)))
924 ;; * *Do not* indent subsequent lines of a documentation string so that
925 ;; the text is lined up in the source code with the text of the first
926 ;; line. This looks nice in the source code, but looks bizarre when
927 ;; users view the documentation. Remember that the indentation
928 ;; before the starting double-quote is not part of the string!
932 (if (and (< (point) e
)
933 (looking-at "\\([ \t]+\\)[^ \t\n]"))
934 (if (checkdoc-autofix-ask-replace (match-beginning 1)
936 "Remove this whitespace?"
939 "Second line should not have indentation")))
940 ;; * Do not start or end a documentation string with whitespace.
942 (if (or (if (looking-at "\"\\([ \t\n]+\\)")
943 (setq start
(match-beginning 1)
948 (if (/= (skip-chars-backward " \t\n") 0)
951 (if (checkdoc-autofix-ask-replace
952 start end
"Remove this whitespace?" "")
954 "Documentation strings should not start or end with whitespace")))
955 ;; * Every command, function, or variable intended for users to know
956 ;; about should have a documentation string.
958 ;; * An internal variable or subroutine of a Lisp program might as well
959 ;; have a documentation string. In earlier Emacs versions, you could
960 ;; save space by using a comment instead of a documentation string,
961 ;; but that is no longer the case.
962 (if (and (not (nth 1 fp
)) ; not a variable
963 (or (nth 2 fp
) ; is interactive
964 checkdoc-force-docstrings-flag
) ;or we always complain
965 (not (checkdoc-char= (following-char) ?
\"))) ; no doc-string
967 "All interactive functions should have documentation"
968 "All variables and subroutines might as well have a \
969 documentation string"))
970 ;; * The first line of the documentation string should consist of one
971 ;; or two complete sentences that stand on their own as a summary.
972 ;; `M-x apropos' displays just the first line, and if it doesn't
973 ;; stand on its own, the result looks bad. In particular, start the
974 ;; first line with a capital letter and end with a period.
977 (skip-chars-backward " \t\n")
978 (if (> (point) e
) (goto-char e
)) ;of the form (defun n () "doc" nil)
981 ((and (checkdoc-char= (following-char) ?
\")
982 ;; A backslashed double quote at the end of a sentence
983 (not (checkdoc-char= (preceding-char) ?
\\)))
984 ;; We might have to add a period in this case
986 (if (looking-at "[.!]")
989 (if (checkdoc-autofix-ask-replace
990 (point) (1+ (point)) "Add period to sentence?"
993 "First sentence should end with punctuation.")))
994 ((looking-at "[\\!;:.)]")
998 ;; If it is not a complete sentence, lets see if we can
999 ;; predict a clever way to make it one.
1000 (let ((msg "First line is not a complete sentence")
1003 (if (re-search-forward "\\. +" e t
)
1004 ;; Here we have found a complete sentence, but no break.
1005 (if (checkdoc-autofix-ask-replace
1006 (1+ (match-beginning 0)) (match-end 0)
1007 "First line not a complete sentence. Add CR here?"
1012 (setq l1
(current-column)
1017 (if (> (+ l1 l2
1) 80)
1018 (setq msg
"Incomplete auto-fix. Doc-string \
1019 may require more formatting.")
1020 ;; We can merge these lines! Replace this CR
1022 (delete-char 1) (insert " ")
1024 ;; Lets see if there is enough room to draw the next
1025 ;; line's sentence up here. I often get hit w/
1026 ;; auto-fill moving my words around.
1027 (let ((numc (progn (end-of-line) (- 80 (current-column))))
1031 (if (and (re-search-forward "[.!:\"][ \n\"]" (save-excursion
1035 (< (current-column) numc
))
1036 (if (checkdoc-autofix-ask-replace
1038 "1st line not a complete sentence. Join these lines?"
1041 ;; They said yes. We have more fill work to do...
1046 ;; Continuation of above. Make sure our sentence is capitalized.
1048 (skip-chars-forward "\"\\*")
1049 (if (looking-at "[a-z]")
1050 (if (checkdoc-autofix-ask-replace
1051 (match-beginning 0) (match-end 0)
1052 "Capitalize your sentence?" (upcase (match-string 0))
1055 "First line should be capitalized.")
1057 ;; * For consistency, phrase the verb in the first sentence of a
1058 ;; documentation string as an infinitive with "to" omitted. For
1059 ;; instance, use "Return the cons of A and B." in preference to
1060 ;; "Returns the cons of A and B." Usually it looks good to do
1061 ;; likewise for the rest of the first paragraph. Subsequent
1062 ;; paragraphs usually look better if they have proper subjects.
1064 ;; For our purposes, just check to first sentence. A more robust
1065 ;; grammar checker would be preferred for the rest of the
1066 ;; documentation string.
1067 (and checkdoc-verb-check-experimental-flag
1069 ;; Maybe rebuild the monster-regex
1070 (checkdoc-create-common-verbs-regexp)
1071 (let ((lim (save-excursion
1073 ;; check string-continuation
1074 (if (checkdoc-char= (preceding-char) ?
\\)
1075 (progn (forward-line 1)
1078 (rs nil
) replace original
(case-fold-search t
))
1079 (while (and (not rs
)
1080 (re-search-forward checkdoc-common-verbs-regexp
1082 (setq original
(buffer-substring-no-properties
1083 (match-beginning 1) (match-end 1))
1084 rs
(assoc (downcase original
)
1085 checkdoc-common-verbs-wrong-voice
))
1086 (if (not rs
) (error "Verb voice alist corrupted."))
1087 (setq replace
(let ((case-fold-search nil
))
1089 (if (string-match "^[A-Z]" original
)
1090 (capitalize (cdr rs
))
1092 (if (checkdoc-autofix-ask-replace
1093 (match-beginning 1) (match-end 1)
1094 (format "Wrong voice for verb `%s'. Replace with `%s'?"
1099 ;; there was a match, but no replace
1101 "Incorrect voice in sentence. Use `%s' instead of `%s'."
1102 replace original
)))))
1103 ;; * Don't write key sequences directly in documentation strings.
1104 ;; Instead, use the `\\[...]' construct to stand for them.
1106 (let ((f nil
) (m nil
) (start (point))
1107 (re "\\<\\([CMA]-[a-zA-Z]\\|\\(\\([CMA]-\\)?\
1108 mouse-[0-3]\\)\\)\\>"))
1109 ;; Find the first key sequence not in a sample
1110 (while (and (not f
) (setq m
(re-search-forward re e t
)))
1111 (setq f
(not (checkdoc-in-sample-code-p start e
))))
1114 "Keycode " (match-string 1)
1115 " embedded in doc-string. Use \\\\<keymap> & \\\\[function] "
1117 ;; It is not practical to use `\\[...]' very many times, because
1118 ;; display of the documentation string will become slow. So use this
1119 ;; to describe the most important commands in your major mode, and
1120 ;; then use `\\{...}' to display the rest of the mode's keymap.
1122 (if (re-search-forward "\\\\\\\\\\[\\w+" e t
1123 (1+ checkdoc-max-keyref-before-warn
))
1124 "Too many occurrences of \\[function]. Use \\{keymap} instead"))
1125 ;; * Format the documentation string so that it fits in an
1126 ;; Emacs window on an 80-column screen. It is a good idea
1127 ;; for most lines to be no wider than 60 characters. The
1128 ;; first line can be wider if necessary to fit the
1129 ;; information that ought to be there.
1131 (let ((start (point)))
1132 (while (and (< (point) e
)
1133 (or (progn (end-of-line) (< (current-column) 80))
1134 (progn (beginning-of-line)
1135 (re-search-forward "\\\\\\\\[[<{]"
1139 (checkdoc-in-sample-code-p start e
)))
1142 (if (and (< (point) e
) (> (current-column) 80))
1143 "Some lines are over 80 columns wide")))
1144 ;;* When a documentation string refers to a Lisp symbol, write it as
1145 ;; it would be printed (which usually means in lower case), with
1146 ;; single-quotes around it. For example: `lambda'. There are two
1147 ;; exceptions: write t and nil without single-quotes. (In this
1148 ;; manual, we normally do use single-quotes for those symbols.)
1150 (let ((found nil
) (start (point)) (msg nil
) (ms nil
))
1151 (while (and (not msg
)
1153 "[^([`':]\\(\\w\+[:-]\\(\\w\\|\\s_\\)+\\)[^]']"
1155 (setq ms
(match-string 1))
1157 ;; A . is a \s_ char, so we must remove periods from
1158 ;; sentences more carefully.
1159 (if (string-match "\\.$" ms
)
1160 (setq ms
(substring ms
0 (1- (length ms
))))))
1161 (if (and (not (checkdoc-in-sample-code-p start e
))
1162 (setq found
(intern-soft ms
))
1163 (or (boundp found
) (fboundp found
)))
1165 (setq msg
(format "Lisp symbol %s should appear in `quotes'"
1167 (if (checkdoc-autofix-ask-replace
1168 (match-beginning 1) (+ (match-beginning 1)
1170 msg
(concat "`" ms
"'") t
)
1175 (if (re-search-forward "\\(`\\(t\\|nil\\)'\\)" e t
)
1176 (if (checkdoc-autofix-ask-replace
1177 (match-beginning 1) (match-end 1)
1178 (format "%s should not appear in quotes. Remove?"
1182 "Symbols t and nil should not appear in `quotes'")))
1183 ;; Here we deviate to tests based on a variable or function.
1184 (cond ((eq (nth 1 fp
) t
)
1185 ;; This is if we are in a variable
1187 ;; * The documentation string for a variable that is a
1188 ;; yes-or-no flag should start with words such as "Non-nil
1189 ;; means...", to make it clear that all non-`nil' values are
1190 ;; equivalent and indicate explicitly what `nil' and non-`nil'
1192 ;; * If a user option variable records a true-or-false
1193 ;; condition, give it a name that ends in `-flag'.
1195 ;; If the variable has -flag in the name, make sure
1196 (if (and (string-match "-flag$" (car fp
))
1197 (not (looking-at "\"\\*?Non-nil\\s-+means\\s-+")))
1198 "Flag variable doc-strings should start: Non-nil means")
1199 ;; If the doc-string starts with "Non-nil means"
1200 (if (and (looking-at "\"\\*?Non-nil\\s-+means\\s-+")
1201 (not (string-match "-flag$" (car fp
))))
1202 "Flag variables should end in: -flag")
1203 ;; Done with variables
1206 ;; This if we are in a function definition
1208 ;; * When a function's documentation string mentions the value
1209 ;; of an argument of the function, use the argument name in
1210 ;; capital letters as if it were a name for that value. Thus,
1211 ;; the documentation string of the function `/' refers to its
1212 ;; second argument as `DIVISOR', because the actual argument
1213 ;; name is `divisor'.
1215 ;; Addendum: Make sure they appear in the doc in the same
1216 ;; order that they are found in the arg list.
1217 (let ((args (cdr (cdr (cdr (cdr fp
)))))
1220 (order (and (nth 3 fp
) (car (nth 3 fp
))))
1221 (nocheck (append '("&optional" "&rest") (nth 3 fp
))))
1222 (while (and args found
(> found last-pos
))
1223 (if (member (car args
) nocheck
)
1224 (setq args
(cdr args
))
1225 (setq last-pos found
1226 found
(save-excursion
1228 (concat "\\<" (upcase (car args
))
1229 ;; Require whitespace OR
1232 "\\(\\>\\|th\\>\\|s\\>\\)")
1235 (let ((case-fold-search t
))
1236 ;; If the symbol was not found, lets see if we
1237 ;; can find it with a different capitalization
1238 ;; and see if the user wants to capitalize it.
1241 (concat "\\<\\(" (car args
)
1242 ;; Require whitespace OR
1245 "\\)\\(\\>\\|th\\>\\|s\\>\\)")
1247 (if (checkdoc-autofix-ask-replace
1248 (match-beginning 1) (match-end 1)
1250 "Argument `%s' should appear as `%s'. Fix?"
1251 (car args
) (upcase (car args
)))
1252 (upcase (car args
)) t
)
1253 (setq found
(match-beginning 1))))))
1254 (if found
(setq args
(cdr args
)))))
1257 "Argument `%s' should appear as `%s' in the doc-string"
1258 (car args
) (upcase (car args
)))
1259 (if (or (and order
(eq order
'yes
))
1260 (and (not order
) checkdoc-arguments-in-order-flag
))
1261 (if (< found last-pos
)
1262 "Arguments occur in the doc-string out of order"))))
1263 ;; Done with functions
1265 ;; Make sure the doc-string has correctly spelled english words
1266 ;; in it. This functions is extracted due to it's complexity,
1267 ;; and reliance on the ispell program.
1268 (checkdoc-ispell-docstring-engine e
)
1269 ;; User supplied checks
1270 (save-excursion (checkdoc-run-hooks 'checkdoc-style-hooks fp e
))
1274 (defun checkdoc-defun-info nil
1275 "Return a list of details about the current sexp.
1276 It is a list of the form:
1277 '( NAME VARIABLE INTERACTIVE NODOCPARAMS PARAMETERS ... )
1278 where NAME is the name, VARIABLE is t if this is a `defvar',
1279 INTERACTIVE is nil if this is not an interactive function, otherwise
1280 it is the position of the `interactive' call, and PARAMETERS is a
1281 string which is the name of each variable in the function's argument
1282 list. The NODOCPARAMS is a sublist of parameters specified by a checkdoc
1283 comment for a given defun. If the first element is not a string, then
1284 the token checkdoc-order: <TOKEN> exists, and TOKEN is a symbol read
1287 (beginning-of-defun)
1288 (let ((defun (looking-at "(def\\(un\\|macro\\|subst\\|advice\\)"))
1289 (is-advice (looking-at "(defadvice"))
1292 (oo (make-vector 3 0))) ;substitute obarray for `read'
1295 (skip-chars-forward " \n\t")
1297 (list (buffer-substring-no-properties
1298 (point) (progn (forward-sexp 1) (point)))))
1300 (setq ret
(cons t ret
))
1301 ;; The variable spot
1302 (setq ret
(cons nil ret
))
1306 (re-search-forward "(interactive"
1307 (save-excursion (end-of-defun) (point))
1310 (skip-chars-forward " \t\n")
1311 (let ((bss (buffer-substring (point) (save-excursion (forward-sexp 1)
1313 ;; Overload th main obarray so read doesn't intern the
1314 ;; local symbols of the function we are checking.
1315 ;; Without this we end up cluttering the symbol space w/
1318 ;; Ok, check for checkdoc parameter comment here
1323 (if (re-search-forward ";\\s-+checkdoc-order:\\s-+"
1324 (save-excursion (end-of-defun)
1327 (setq sl1
(list (cond ((looking-at "nil") 'no
)
1328 ((looking-at "t") 'yes
)))))
1329 (if (re-search-forward ";\\s-+checkdoc-params:\\s-+"
1330 (save-excursion (end-of-defun)
1334 (goto-char (match-end 0))
1335 (setq lst
(read (current-buffer)))
1337 (setq sl
(cons (symbol-name (car lst
)) sl
)
1339 (setq sl1
(append sl1 sl
))))
1342 ;; Read the list of paramters, but do not put the symbols in
1343 ;; the standard obarray.
1344 (setq lst
(read bss
)))
1345 ;; This is because read will intern nil if it doesn't into the
1347 (if (not (listp lst
)) (setq lst nil
))
1350 (setq ret
(cons (symbol-name (car lst
)) ret
)
1354 (defun checkdoc-in-sample-code-p (start limit
)
1355 "Return Non-nil if the current point is in a code-fragment.
1356 A code fragment is identified by an open parenthesis followed by a
1357 symbol which is a valid function, or a parenthesis that is quoted with the '
1358 character. Only the region from START to LIMIT is is allowed while
1359 searching for the bounding parenthesis."
1362 (narrow-to-region start limit
)
1364 (and (condition-case nil
(progn (up-list 1) t
) (error nil
))
1365 (condition-case nil
(progn (forward-list -
1) t
) (error nil
))
1366 (or (save-excursion (forward-char -
1) (looking-at "'("))
1367 (and (looking-at "(\\(\\(\\w\\|[-:_]\\)+\\)[ \t\n;]")
1368 (let ((ms (buffer-substring-no-properties
1369 (match-beginning 1) (match-end 1))))
1370 ;; if this string is function bound, we are in
1371 ;; sample code. If it has a - or : character in
1372 ;; the name, then it is probably supposed to be bound
1374 (or (fboundp (intern-soft ms
))
1375 (string-match "\\w[-:_]+\\w" ms
))))))))))
1379 (eval-when-compile (require 'ispell
))
1381 (defun checkdoc-ispell-init ()
1382 "Initialize ispell process (default version) with lisp words.
1383 The words used are from `checkdoc-ispell-lisp-words'. If `ispell'
1384 cannot be loaded, then set `checkdoc-spellcheck-documentation-flag' to
1387 (if (not (symbol-value 'ispell-process
)) ;Silence byteCompiler
1390 (ispell-buffer-local-words)
1391 ;; This code copied in part from ispell.el emacs 19.34
1392 (let ((w checkdoc-ispell-lisp-words
))
1394 (process-send-string
1395 ;; Silence byte compiler
1396 (symbol-value 'ispell-process
)
1397 (concat "@" (car w
) "\n"))
1399 (error (setq checkdoc-spellcheck-documentation-flag nil
)))))
1401 (defun checkdoc-ispell-docstring-engine (end)
1402 "Run the ispell tools on the doc-string between point and END.
1403 Since ispell isn't lisp smart, we must pre-process the doc-string
1404 before using the ispell engine on it."
1405 (if (not checkdoc-spellcheck-documentation-flag
)
1407 (checkdoc-ispell-init)
1409 (skip-chars-forward "^a-zA-Z")
1410 (let ((word nil
) (sym nil
) (case-fold-search nil
) (err nil
))
1411 (while (and (not err
) (< (point) end
))
1412 (if (save-excursion (forward-char -
1) (looking-at "[('`]"))
1413 ;; Skip lists describing meta-syntax, or bound variables
1415 (setq word
(buffer-substring-no-properties
1417 (skip-chars-forward "a-zA-Z-")
1419 sym
(intern-soft word
))
1420 (if (and sym
(or (boundp sym
) (fboundp sym
)))
1421 ;; This is probably repetative in most cases, but not always.
1423 ;; Find out how we spell-check this word.
1425 (not (string-match "[a-z]" word
)) ;all caps meta variable
1426 (looking-at "}") ; a keymap expression
1430 (if (not (eq checkdoc-autofix-flag
'never
))
1431 (let ((lk last-input-event
))
1433 (if (not (equal last-input-event lk
))
1436 (message "Continuing..."))))
1439 (skip-chars-forward "^a-zA-Z"))
1442 ;;; Rogue space checking engine
1444 (defun checkdoc-rogue-space-check-engine (&optional start end
)
1445 "Return a message string if there is a line with white space at the end.
1446 If `checkdoc-autofix-flag' permits, delete that whitespace instead.
1447 If optional arguments START and END are non nil, bound the check to
1451 (if (not start
) (setq start
(point-min)))
1452 ;; If end is nil, it means end of buffer to search anyway
1454 ;; Checkfor and error if `? ' or `?\ ' is used at the end of a line.
1458 (if (re-search-forward "\\?\\\\?[ \t][ \t]*$" end t
)
1460 "Don't use `? ' at the end of a line. \
1461 Some editors & news agents may remove it")))
1462 ;; Check for, and pottentially remove whitespace appearing at the
1463 ;; end of different lines.
1466 ;; There is no documentation in the elisp manual about this check,
1467 ;; it is intended to help clean up messy code and reduce the file size.
1468 (while (and (not msg
) (re-search-forward "[^ \t\n]\\([ \t]+\\)$" end t
))
1469 ;; This is not a complex activity
1470 (if (checkdoc-autofix-ask-replace
1471 (match-beginning 1) (match-end 1)
1472 "White space at end of line. Remove?" "")
1474 (setq msg
"White space found at end of line.")))))
1475 ;; Return an error and leave the cursor at that spot, or restore
1482 ;;; Comment checking engine
1485 ;; We must load this to:
1486 ;; a) get symbols for comple and
1487 ;; b) determine if we have lm-history symbol which doesn't always exist
1488 (require 'lisp-mnt
))
1490 (defun checkdoc-file-comments-engine ()
1491 "Return a message string if this file does not match the emacs standard.
1492 This checks for style only, such as the first line, Commentary:,
1493 Code:, and others referenced in the style guide."
1494 (if (featurep 'lisp-mnt
)
1497 ;; Old Xemacs don't have `lm-commentary-mark'
1498 (if (and (not (fboundp 'lm-commentary-mark
)) (boundp 'lm-commentary
))
1499 (defalias 'lm-commentary-mark
'lm-commentary
)))
1501 (let* ((f1 (file-name-nondirectory (buffer-file-name)))
1502 (fn (file-name-sans-extension f1
))
1503 (fe (substring f1
(length fn
))))
1504 (goto-char (point-min))
1506 ;; Lisp Maintenance checks first
1507 ;; Was: (lm-verify) -> not flexible enough for some people
1508 ;; * Summary at the beginning of the file:
1509 (if (not (lm-summary))
1510 ;; This certifies as very complex so always ask unless
1511 ;; it's set to never
1512 (if (and checkdoc-autofix-flag
1513 (not (eq checkdoc-autofix-flag
'never
))
1514 (y-or-n-p "There is no first line summary! Add one?"))
1516 (goto-char (point-min))
1517 (insert ";;; " fn fe
" --- " (read-string "Summary: ") "\n"))
1518 "The first line should be of the form: \";;; package --- Summary\"")
1520 ;; * Commentary Section
1521 (if (not (lm-commentary-mark))
1522 "You should have a section marked \";;; Commentary:\""
1524 ;; * History section. Say nothing if there is a file ChangeLog
1525 (if (or (file-exists-p "ChangeLog")
1526 (let ((fn 'lm-history-mark
)) ;bestill byte-compiler
1527 (and (fboundp fn
) (funcall fn
))))
1529 "You should have a section marked \";;; History:\" or use a ChangeLog")
1531 (if (not (lm-code-mark))
1533 (goto-char (point-min))
1534 (while (and cont
(re-search-forward "^(" nil t
))
1535 (setq cont
(looking-at "require\\s-+")))
1537 checkdoc-autofix-flag
1538 (not (eq checkdoc-autofix-flag
'never
))
1539 (y-or-n-p "There is no ;;; Code: marker. Insert one? "))
1540 (progn (beginning-of-line)
1541 (insert ";;; Code:\n")
1543 "You should have a section marked \";;; Code:\""))
1545 ;; * A footer. Not compartamentalized from lm-verify: too bad.
1546 ;; The following is partially clipped from lm-verify
1548 (goto-char (point-max))
1549 (if (not (re-search-backward
1550 (concat "^;;;[ \t]+" fn
"\\(" (regexp-quote fe
)
1551 "\\)?[ \t]+ends here[ \t]*$"
1552 "\\|^;;;[ \t]+ End of file[ \t]+"
1553 fn
"\\(" (regexp-quote fe
) "\\)?")
1555 (if (and checkdoc-autofix-flag
1556 (not (eq checkdoc-autofix-flag
'never
))
1557 (y-or-n-p "No identifiable footer! Add one?"))
1559 (goto-char (point-max))
1560 (insert "\n(provide '" fn
")\n;;; " fn fe
" ends here\n"))
1561 (format "The footer should be (provide '%s)\\n;;; %s%s ends here"
1563 ;; Ok, now lets look for multiple occurances of ;;;, and offer
1564 ;; to remove the extra ";" if applicable. This pre-supposes
1565 ;; that the user has semiautomatic fixing on to be useful.
1567 ;; In the info node (elisp)Library Headers a header is three ;
1568 ;; (the header) followed by text of only two ;
1569 ;; In (elisp)Comment Tips, however it says this:
1570 ;; * Another use for triple-semicolon comments is for commenting out
1571 ;; lines within a function. We use triple-semicolons for this
1572 ;; precisely so that they remain at the left margin.
1574 (goto-char (point-min))
1575 (while (and checkdoc-tripple-semi-comment-check-flag
1576 (not msg
) (re-search-forward "^;;;[^;]" nil t
))
1577 ;; We found a triple, lets check all following lines.
1578 (if (not (bolp)) (progn (beginning-of-line) (forward-line 1)))
1579 (let ((complex-replace t
))
1580 (while (looking-at ";;\\(;\\)[^;]")
1581 (if (and (checkdoc-outside-major-sexp) ;in code is ok.
1582 (checkdoc-autofix-ask-replace
1583 (match-beginning 1) (match-end 1)
1584 "Multiple occurances of ;;; found. Use ;; instead?" ""
1586 ;; Learn that, yea, the user did want to do this a
1587 ;; whole bunch of times.
1588 (setq complex-replace nil
))
1590 (forward-line 1)))))
1591 ;; Lets spellcheck the commentary section. This is the only
1592 ;; section that is easy to pick out, and it is also the most
1593 ;; visible section (with the finder)
1595 (goto-char (lm-commentary-mark))
1596 ;; Spellcheck between the commentary, and the first
1597 ;; non-comment line. We could use lm-commentary, but that
1598 ;; returns a string, and ispell wants to talk to a buffer.
1599 ;; Since the comments talk about lisp, use the specialized
1600 ;; spell-checker we also used for doc-strings.
1601 (checkdoc-ispell-docstring-engine (save-excursion
1602 (re-search-forward "^[^;]" nil t
)
1604 ;;; test comment out code
1607 ;; Generic Full-file checks (should be comment related)
1608 (checkdoc-run-hooks 'checkdoc-comment-style-hooks
)
1609 ;; Done with full file comment checks
1612 (defun checkdoc-outside-major-sexp ()
1613 "Return t if point is outside the bounds of a valid sexp."
1617 (or (progn (beginning-of-defun) (bobp))
1618 (progn (end-of-defun) (< (point) p
)))))))
1620 ;;; Auto-fix helper functions
1622 (defun checkdoc-autofix-ask-replace (start end question replacewith
1624 "Highlight between START and END and queries the user with QUESTION.
1625 If the user says yes, or if `checkdoc-autofix-flag' permits, replace
1626 the region marked by START and END with REPLACEWITH. If optional flag
1627 COMPLEX is non-nil, then we may ask the user a question. See the
1628 documentation for `checkdoc-autofix-flag' for details.
1630 If a section is auto-replaced without asking the user, this function
1631 will pause near the fixed code so the user will briefly see what
1634 This function returns non-nil if the text was replaced."
1635 (if checkdoc-autofix-flag
1636 (let ((o (checkdoc-make-overlay start end
))
1640 (checkdoc-overlay-put o
'face
'highlight
)
1641 (if (or (eq checkdoc-autofix-flag
'automatic
)
1642 (and (eq checkdoc-autofix-flag
'semiautomatic
)
1644 (and (or (eq checkdoc-autofix-flag
'query
) complex
)
1645 (y-or-n-p question
)))
1648 ;; On the off chance this is automatic, display
1649 ;; the question anyway so the user knows whats
1651 (if checkdoc-bouncy-flag
(message "%s -> done" question
))
1652 (delete-region start end
)
1653 (insert replacewith
)
1654 (if checkdoc-bouncy-flag
(sit-for 0))
1656 (checkdoc-delete-overlay o
))
1657 (checkdoc-delete-overlay o
))
1660 ;;; Warning management
1662 (defvar checkdoc-output-font-lock-keywords
1663 '(("\\(\\w+\\.el\\):" 1 font-lock-function-name-face
)
1664 ("style check: \\(\\w+\\)" 1 font-lock-comment-face
)
1665 ("^\\([0-9]+\\):" 1 font-lock-reference-face
))
1666 "Keywords used to highlight a checkdoc diagnostic buffer.")
1668 (defvar checkdoc-output-mode-map nil
1669 "Keymap used in `checkdoc-output-mode'.")
1671 (if checkdoc-output-mode-map
1673 (setq checkdoc-output-mode-map
(make-sparse-keymap))
1674 (if (not (string-match "XEmacs" emacs-version
))
1675 (define-key checkdoc-output-mode-map
[mouse-2
]
1676 'checkdoc-find-error-mouse
))
1677 (define-key checkdoc-output-mode-map
"\C-c\C-c" 'checkdoc-find-error
)
1678 (define-key checkdoc-output-mode-map
"\C-m" 'checkdoc-find-error
))
1680 (defun checkdoc-output-mode ()
1681 "Create and setup the buffer used to maintain checkdoc warnings.
1682 \\<checkdoc-output-mode-map>\\[checkdoc-find-error] - Go to this error location
1683 \\[checkdoc-find-error-mouse] - Goto the error clicked on."
1684 (if (get-buffer checkdoc-diagnostic-buffer
)
1685 (get-buffer checkdoc-diagnostic-buffer
)
1687 (set-buffer (get-buffer-create checkdoc-diagnostic-buffer
))
1688 (kill-all-local-variables)
1689 (setq mode-name
"Checkdoc"
1690 major-mode
'checkdoc-output-mode
)
1691 (set (make-local-variable 'font-lock-defaults
)
1692 '((checkdoc-output-font-lock-keywords) t t
((?- .
"w") (?_ .
"w"))))
1693 (use-local-map checkdoc-output-mode-map
)
1694 (run-hooks 'checkdoc-output-mode-hook
)
1697 (defun checkdoc-find-error-mouse (e)
1698 ;; checkdoc-params: (e)
1699 "Call `checkdoc-find-error' where the user clicks the mouse."
1702 (checkdoc-find-error))
1704 (defun checkdoc-find-error ()
1705 "In a checkdoc diagnostic buffer, find the error under point."
1708 (if (looking-at "[0-9]+")
1709 (let ((l (string-to-int (match-string 0)))
1711 (re-search-backward " \\(\\(\\w+\\|\\s_\\)+\\.el\\):")
1713 (if (not (get-buffer f
))
1714 (error "Can't find buffer %s" f
))
1715 (switch-to-buffer-other-window (get-buffer f
))
1718 (defun checkdoc-start-section (check-type)
1719 "Initialize the checkdoc diagnostic buffer for a pass.
1720 Create the header so that the string CHECK-TYPE is displayed as the
1721 function called to create the messages."
1722 (checkdoc-output-to-error-buffer
1723 "\n\n*** " (current-time-string) " "
1724 (file-name-nondirectory (buffer-file-name)) ": style check: " check-type
1725 " V " checkdoc-version
))
1727 (defun checkdoc-error (point msg
)
1728 "Store POINT and MSG as errors in the checkdoc diagnostic buffer."
1729 (checkdoc-output-to-error-buffer
1730 "\n" (int-to-string (count-lines (point-min) (or point
1))) ": "
1733 (defun checkdoc-output-to-error-buffer (&rest text
)
1734 "Place TEXT into the checkdoc diagnostic buffer."
1736 (set-buffer (checkdoc-output-mode))
1737 (goto-char (point-max))
1738 (apply 'insert text
)))
1740 (defun checkdoc-show-diagnostics ()
1741 "Display the checkdoc diagnostic buffer in a temporary window."
1742 (let ((b (get-buffer checkdoc-diagnostic-buffer
)))
1743 (if b
(progn (pop-to-buffer b
)
1744 (beginning-of-line)))
1746 (shrink-window-if-larger-than-buffer)))
1748 (defgroup checkdoc nil
1749 "Support for doc-string checking in emacs lisp."
1753 (custom-add-option 'emacs-lisp-mode-hook
1754 (lambda () (checkdoc-minor-mode 1)))
1757 ;;; checkdoc.el ends here