Mercurial > emacs
annotate lisp/emacs-lisp/checkdoc.el @ 21689:95c0fe8d25a7
(easy-menu-do-add-item):
Do the right thing when nil is specified as criterion for activeness.
Fix string used to report an invalid item.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Tue, 21 Apr 1998 04:54:46 +0000 |
parents | 86fcccceba7b |
children | 38f78542051a |
rev | line source |
---|---|
20085 | 1 ;;; checkdoc --- Check documentation strings for style requirements |
2 | |
20603
24dda0afd915
Added some more comments in the commentary.
Eric M. Ludlam <zappo@gnu.org>
parents:
20085
diff
changeset
|
3 ;;; Copyright (C) 1997, 1998 Free Software Foundation |
21181 | 4 |
20603
24dda0afd915
Added some more comments in the commentary.
Eric M. Ludlam <zappo@gnu.org>
parents:
20085
diff
changeset
|
5 ;; Author: Eric M. Ludlam <zappo@gnu.org> |
21181 | 6 ;; Version: 0.4.3 |
20085 | 7 ;; Keywords: docs, maint, lisp |
21181 | 8 |
20085 | 9 ;; This file is part of GNU Emacs. |
21181 | 10 |
20085 | 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) | |
14 ;; any later version. | |
21181 | 15 |
20085 | 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. | |
21181 | 20 |
20085 | 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. | |
25 | |
26 ;;; Commentary: | |
27 ;; | |
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. | |
33 ;; | |
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))) | |
44 ;; | |
45 ;; Auto-fixing: | |
46 ;; | |
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 | |
58 ;; are fixed. | |
59 ;; | |
60 ;; Spell checking doc-strings: | |
61 ;; | |
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. | |
76 ;; | |
20603
24dda0afd915
Added some more comments in the commentary.
Eric M. Ludlam <zappo@gnu.org>
parents:
20085
diff
changeset
|
77 ;; Checking parameters |
24dda0afd915
Added some more comments in the commentary.
Eric M. Ludlam <zappo@gnu.org>
parents:
20085
diff
changeset
|
78 ;; |
24dda0afd915
Added some more comments in the commentary.
Eric M. Ludlam <zappo@gnu.org>
parents:
20085
diff
changeset
|
79 ;; You might not always want a function to have it's parameters listed |
24dda0afd915
Added some more comments in the commentary.
Eric M. Ludlam <zappo@gnu.org>
parents:
20085
diff
changeset
|
80 ;; in order. When this is the case, put the following comment just in |
24dda0afd915
Added some more comments in the commentary.
Eric M. Ludlam <zappo@gnu.org>
parents:
20085
diff
changeset
|
81 ;; front of the documentation string: "; checkdoc-order: nil" This |
24dda0afd915
Added some more comments in the commentary.
Eric M. Ludlam <zappo@gnu.org>
parents:
20085
diff
changeset
|
82 ;; overrides the value of `checkdoc-arguments-in-order-flag'. |
24dda0afd915
Added some more comments in the commentary.
Eric M. Ludlam <zappo@gnu.org>
parents:
20085
diff
changeset
|
83 ;; |
24dda0afd915
Added some more comments in the commentary.
Eric M. Ludlam <zappo@gnu.org>
parents:
20085
diff
changeset
|
84 ;; If you specifically wish to avoid mentioning a parameter of a |
24dda0afd915
Added some more comments in the commentary.
Eric M. Ludlam <zappo@gnu.org>
parents:
20085
diff
changeset
|
85 ;; function in the doc string (such as a hidden parameter, or a |
24dda0afd915
Added some more comments in the commentary.
Eric M. Ludlam <zappo@gnu.org>
parents:
20085
diff
changeset
|
86 ;; parameter which is very obvious like events), you can have checkdoc |
24dda0afd915
Added some more comments in the commentary.
Eric M. Ludlam <zappo@gnu.org>
parents:
20085
diff
changeset
|
87 ;; skip looking for it by putting the following comment just in front |
24dda0afd915
Added some more comments in the commentary.
Eric M. Ludlam <zappo@gnu.org>
parents:
20085
diff
changeset
|
88 ;; of the documentation string: "; checkdoc-params: (args go here)" |
24dda0afd915
Added some more comments in the commentary.
Eric M. Ludlam <zappo@gnu.org>
parents:
20085
diff
changeset
|
89 ;; |
20085 | 90 ;; Adding your own checks: |
91 ;; | |
92 ;; You can experiment with adding your own checks by setting the | |
93 ;; hooks `checkdoc-style-hooks' and `checkdoc-comment-style-hooks'. | |
94 ;; Return a string which is the error you wish to report. The cursor | |
95 ;; position should be preserved. | |
96 ;; | |
97 ;; This file requires lisp-mnt (lisp maintenance routines) for the | |
98 ;; comment checkers. | |
99 ;; | |
100 ;; Requires custom for emacs v20. | |
101 | |
102 ;;; Change log: | |
103 ;; 0.1 Initial revision | |
104 ;; 0.2 Fixed comments in this file to match the emacs lisp standards. | |
105 ;; Added new doc checks for: variable-flags, function arguments | |
106 ;; Added autofix functionality for white-space, and quoted variables. | |
107 ;; Unquoted symbols are allowed after ( character. (Sample code) | |
108 ;; Check for use of `? ' at end of line and warn. | |
109 ;; Check for spaces at end of lines for whole file, or one defun. | |
110 ;; Check for comments standards, including headinds like Code: | |
111 ;; and use of triple semicolons versus double semicolons | |
112 ;; Check that interactive functions have a doc-string. Optionally | |
113 ;; set `checkdoc-force-docstrings-flag' to non-nil to make all | |
114 ;; definitions have a doc-string. | |
115 ;; 0.3 Regexp changse for accuracy on var checking and param checking. | |
116 ;; lm-verify check expanded to each sub-call w/ more descriptive | |
117 ;; messages, and two autofix-options. | |
118 ;; Suggestions/patches from Christoph Wedler <wedler@fmi.uni-passau.de> | |
119 ;; XEmacs support w/ extents/overlays. | |
120 ;; Better Whitespace finding regexps | |
121 ;; Added `checkdoc-arguments-in-order-flag' to optionally turn off | |
122 ;; warnings of arguments that do not appear in order in doc | |
123 ;; strings. | |
124 ;; 0.4 New fix routine when two lines can be joined to make the | |
125 ;; first line a comlete sentence. | |
126 ;; Added ispell code. Use `checkdoc-spellcheck-documentation-flag' | |
127 ;; to enable or disable this test in certain contexts. | |
128 ;; Added ispell interface functions `checkdoc-ispell', | |
129 ;; `checkdoc-ispell-continue', `checkdoc-ispell-defun' | |
130 ;; `checkdoc-ispell-interactive', `checkdoc-ispell-current-buffer'. | |
131 ;; Loop through all potential unquoted symbols. | |
132 ;; Auto-fixing no longer screws up the "end" of the doc-string. | |
133 ;; Maintain a different syntax table when examining arguments. | |
134 ;; Autofix enabled for parameters which are not uppercase iff they | |
135 ;; occur in lower case in the doc-string. | |
136 ;; Autofix enable if there is no Code: label. | |
137 ;; The comment text ";; checkdoc-order: nil|t" inside a defun to | |
138 ;; enable or disable the checking of argument order for one defun. | |
139 ;; The comment text ";; checkdoc-params: (arg1 arg2)" inside a defun | |
140 ;; (Such as just before the doc string) will list ARG1 and ARG2 as | |
141 ;; being paramters that need not show up in the doc string. | |
142 ;; Brought in suggestions from Jari Aalto <jaalto@tre.tele.nokia.fi> | |
143 ;; More robustness (comments in/around doc-strings/ arg lists) | |
144 ;; Don't offer to `quote'afy symbols or keystroke representations | |
145 ;; that are in lists (sample code) This added new fn | |
146 ;; `checkdoc-in-sample-code-p' | |
147 ;; Added more comments near the ;;; comment check about why it | |
148 ;; is being done. ;;; Are also now allowed inside a defun. | |
149 ;; This added the function `checkdoc-outside-major-sexp' | |
150 ;; Added `checkdoc-interactive' which permits interactive | |
151 ;; perusal of document warnings, and editing of strings. | |
152 ;; Fixed `checkdoc-defun-info' to be more robust when creating | |
153 ;; the paramter list. | |
154 ;; Added list of verbs in the wrong tense, and their fixes. | |
155 ;; Added defconst/subst/advice to checked items. | |
156 ;; Added `checkdoc-style-hooks' and `checkdoc-comment-style-hooks' | |
157 ;; for adding in user tests. | |
158 ;; Added `checkdoc-continue', a version of checkdoc that continues | |
159 ;; from point. | |
160 ;; [X]Emacs 20 support for extended characters. | |
161 ;; Only check comments on real files. | |
162 ;; Put `checkdoc' and `checkdoc-continue' into keymap/menu | |
163 ;; 0.4.1 Made `custom' friendly. | |
164 ;; C-m in warning buffer also goes to error. | |
165 ;; Shrink error buffer to size of text. | |
166 ;; Added `checkdoc-tripple-semi-comment-check-flag'. | |
167 ;; `checkdoc-spellcheck-documentation-flag' off by default. | |
168 ;; Re-sorted check order so white space is removed before adding a . | |
20603
24dda0afd915
Added some more comments in the commentary.
Eric M. Ludlam <zappo@gnu.org>
parents:
20085
diff
changeset
|
169 ;; 0.4.2 Added some more comments in the commentary. |
24dda0afd915
Added some more comments in the commentary.
Eric M. Ludlam <zappo@gnu.org>
parents:
20085
diff
changeset
|
170 ;; You can now `quote' symbols that look like keystrokes |
24dda0afd915
Added some more comments in the commentary.
Eric M. Ludlam <zappo@gnu.org>
parents:
20085
diff
changeset
|
171 ;; When spell checking, meta variables can end in `th' or `s'. |
21181 | 172 ;; 0.4.3 Fixed bug where multi-function checking skips defuns that |
173 ;; have comments before the doc-string. | |
174 ;; Fixed bug where keystrokes were identified from a variable name | |
175 ;; like ASSOC-P. | |
20085 | 176 |
177 ;;; TO DO: | |
178 ;; Hook into the byte compiler on a defun/defver level to generate | |
179 ;; warnings in the byte-compiler's warning/error buffer. | |
180 ;; Better ways to override more typical `eval' functions. Advice | |
181 ;; might be good but hard to turn on/off as a minor mode. | |
182 ;; | |
183 ;;; Maybe Do: | |
184 ;; Code sweep checks for "forbidden functions", proper use of hooks, | |
185 ;; proper keybindings, and other items from the manual that are | |
186 ;; not specifically docstring related. Would this even be useful? | |
187 | |
188 ;;; Code: | |
21181 | 189 (defvar checkdoc-version "0.4.3" |
20085 | 190 "Release version of checkdoc you are currently running.") |
191 | |
192 ;; From custom web page for compatibility between versions of custom: | |
193 (eval-and-compile | |
194 (condition-case () | |
195 (require 'custom) | |
196 (error nil)) | |
197 (if (and (featurep 'custom) (fboundp 'custom-declare-variable)) | |
198 nil ;; We've got what we needed | |
199 ;; We have the old custom-library, hack around it! | |
200 (defmacro defgroup (&rest args) | |
201 nil) | |
202 (defmacro custom-add-option (&rest args) | |
203 nil) | |
20603
24dda0afd915
Added some more comments in the commentary.
Eric M. Ludlam <zappo@gnu.org>
parents:
20085
diff
changeset
|
204 (defmacro defcustom (var value doc &rest args) |
20085 | 205 (` (defvar (, var) (, value) (, doc)))))) |
206 | |
207 (defcustom checkdoc-autofix-flag 'semiautomatic | |
208 "*Non-nil means attempt auto-fixing of doc-strings. | |
209 If this value is the symbol 'query, then the user is queried before | |
210 any change is made. If the value is 'automatic, then all changes are | |
211 made without asking unless the change is very-complex. If the value | |
212 is 'semiautomatic, or any other value, then simple fixes are made | |
213 without asking, and complex changes are made by asking the user first. | |
214 The value 'never is the same as nil, never ask or change anything." | |
215 :group 'checkdoc | |
216 :type '(choice (const automatic) | |
217 (const semiautomatic) | |
218 (const query) | |
219 (const never))) | |
220 | |
221 (defcustom checkdoc-bouncy-flag t | |
222 "*Non-nil means to 'bounce' to auto-fix locations. | |
223 Setting this to nil will silently make fixes that require no user | |
224 interaction. See `checkdoc-autofix-flag' for auto-fixing details." | |
225 :group 'checkdoc | |
226 :type 'boolean) | |
227 | |
228 (defcustom checkdoc-force-docstrings-flag t | |
229 "*Non-nil means that all checkable definitions should have documentation. | |
230 Style guide dictates that interactive functions MUST have documentation, | |
231 and that its good but not required practice to make non user visible items | |
232 have doc-strings." | |
233 :group 'checkdoc | |
234 :type 'boolean) | |
235 | |
236 (defcustom checkdoc-tripple-semi-comment-check-flag t | |
237 "*Non-nil means to check for multiple adjacent occurrences of ;;; comments. | |
238 According to the style of emacs code in the lisp libraries, a block | |
239 comment can look like this: | |
240 ;;; Title | |
241 ;; text | |
242 ;; text | |
243 But when inside a function, code can be commented out using the ;;; | |
244 construct for all lines. When this variable is nil, the ;;; construct | |
245 is ignored regardless of it's location in the code." | |
246 :group 'checkdoc | |
247 :type 'boolean) | |
248 | |
249 (defcustom checkdoc-spellcheck-documentation-flag nil | |
250 "*Non-nil means run ispell on doc-strings based on value. | |
251 This will be automatically set to nil if ispell does not exist on your | |
252 system. Possible values are: | |
253 | |
254 nil - Don't spell-check during basic style checks. | |
255 'defun - Spell-check when style checking a single defun | |
256 'buffer - Spell-check only when style checking the whole buffer | |
257 'interactive - Spell-check only during `checkdoc-interactive' | |
258 t - Always spell-check" | |
259 :group 'checkdoc | |
260 :type '(choice (const nil) | |
261 (const defun) | |
262 (const buffer) | |
263 (const interactive) | |
264 (const t))) | |
265 | |
266 (defvar checkdoc-ispell-lisp-words | |
267 '("alist" "etags" "iff" "keymap" "paren" "regexp" "sexp" "xemacs") | |
268 "List of words that are correct when spell-checking lisp documentation.") | |
269 | |
270 (defcustom checkdoc-max-keyref-before-warn 10 | |
271 "*The number of \\ [command-to-keystroke] tokens allowed in a doc-string. | |
272 Any more than this and a warning is generated suggesting that the construct | |
273 \\ {keymap} be used instead." | |
274 :group 'checkdoc | |
275 :type 'integer) | |
276 | |
277 (defcustom checkdoc-arguments-in-order-flag t | |
278 "*Non-nil means warn if arguments appear out of order. | |
279 Setting this to nil will mean only checking that all the arguments | |
280 appear in the proper form in the documentation, not that they are in | |
281 the same order as they appear in the argument list. No mention is | |
282 made in the style guide relating to order." | |
283 :group 'checkdoc | |
284 :type 'boolean) | |
285 | |
286 (defvar checkdoc-style-hooks nil | |
287 "Hooks called after the standard style check is completed. | |
288 All hooks must return nil or a string representing the error found. | |
289 Useful for adding new user implemented commands. | |
290 | |
291 Each hook is called with two parameters, (DEFUNINFO ENDPOINT). | |
292 DEFUNINFO is the return value of `checkdoc-defun-info'. ENDPOINT is the | |
293 location of end of the documentation string.") | |
294 | |
295 (defvar checkdoc-comment-style-hooks nil | |
296 "Hooks called after the standard comment style check is completed. | |
297 Must return nil if no errors are found, or a string describing the | |
298 problem discovered. This is useful for adding additional checks.") | |
299 | |
300 (defvar checkdoc-diagnostic-buffer "*Style Warnings*" | |
20603
24dda0afd915
Added some more comments in the commentary.
Eric M. Ludlam <zappo@gnu.org>
parents:
20085
diff
changeset
|
301 "Name of warning message buffer.") |
20085 | 302 |
303 (defvar checkdoc-defun-regexp | |
304 "^(def\\(un\\|var\\|custom\\|macro\\|const\\|subst\\|advice\\)\ | |
305 \\s-+\\(\\(\\sw\\|\\s_\\)+\\)[ \t\n]+" | |
306 "Regular expression used to identify a defun. | |
307 A search leaves the cursor in front of the parameter list.") | |
308 | |
309 (defcustom checkdoc-verb-check-experimental-flag t | |
310 "*Non-nil means to attempt to check the voice of the doc-string. | |
311 This check keys off some words which are commonly misused. See the | |
312 variable `checkdoc-common-verbs-wrong-voice' if you wish to add your | |
313 own." | |
314 :group 'checkdoc | |
315 :type 'boolean) | |
316 | |
317 (defvar checkdoc-common-verbs-regexp nil | |
318 "Regular expression derived from `checkdoc-common-verbs-regexp'.") | |
319 | |
320 (defvar checkdoc-common-verbs-wrong-voice | |
321 '(("adds" . "add") | |
322 ("allows" . "allow") | |
323 ("appends" . "append") | |
324 ("applies" "apply") | |
325 ("arranges" "arrange") | |
326 ("brings" . "bring") | |
327 ("calls" . "call") | |
328 ("catches" . "catch") | |
329 ("changes" . "change") | |
330 ("checks" . "check") | |
331 ("contains" . "contain") | |
332 ("creates" . "create") | |
333 ("destroys" . "destroy") | |
334 ("disables" . "disable") | |
335 ("executes" . "execute") | |
336 ("evals" . "evaluate") | |
337 ("evaluates" . "evaluate") | |
338 ("finds" . "find") | |
339 ("forces" . "force") | |
340 ("gathers" . "gather") | |
341 ("generates" . "generate") | |
342 ("goes" . "go") | |
343 ("guesses" . "guess") | |
344 ("highlights" . "highlight") | |
345 ("holds" . "hold") | |
346 ("ignores" . "ignore") | |
347 ("indents" . "indent") | |
348 ("initializes" . "initialize") | |
349 ("inserts" . "insert") | |
350 ("installs" . "install") | |
351 ("investigates" . "investigate") | |
352 ("keeps" . "keep") | |
353 ("kills" . "kill") | |
354 ("leaves" . "leave") | |
355 ("lets" . "let") | |
356 ("loads" . "load") | |
357 ("looks" . "look") | |
358 ("makes" . "make") | |
359 ("marks" . "mark") | |
360 ("matches" . "match") | |
361 ("notifies" . "notify") | |
362 ("offers" . "offer") | |
363 ("parses" . "parse") | |
364 ("performs" . "perform") | |
365 ("prepares" . "prepare") | |
366 ("prepends" . "prepend") | |
367 ("reads" . "read") | |
368 ("raises" . "raise") | |
369 ("removes" . "remove") | |
370 ("replaces" . "replace") | |
371 ("resets" . "reset") | |
372 ("restores" . "restore") | |
373 ("returns" . "return") | |
374 ("runs" . "run") | |
375 ("saves" . "save") | |
376 ("says" . "say") | |
377 ("searches" . "search") | |
378 ("selects" . "select") | |
379 ("sets" . "set") | |
380 ("sex" . "s*x") | |
381 ("shows" . "show") | |
382 ("signifies" . "signify") | |
383 ("sorts" . "sort") | |
384 ("starts" . "start") | |
385 ("stores" . "store") | |
386 ("switches" . "switch") | |
387 ("tells" . "tell") | |
388 ("tests" . "test") | |
389 ("toggles" . "toggle") | |
390 ("tries" . "try") | |
391 ("turns" . "turn") | |
392 ("undoes" . "undo") | |
393 ("unloads" . "unload") | |
394 ("unmarks" . "unmark") | |
395 ("updates" . "update") | |
396 ("uses" . "use") | |
397 ("yanks" . "yank") | |
398 ) | |
399 "Alist of common words in the wrong voice and what should be used instead. | |
400 Set `checkdoc-verb-check-experimental-flag' to nil to avoid this costly | |
401 and experimental check. Do not modify this list without setting | |
402 the value of `checkdoc-common-verbs-regexp' to nil which cause it to | |
403 be re-created.") | |
404 | |
405 (defvar checkdoc-syntax-table nil | |
406 "Syntax table used by checkdoc in document strings.") | |
407 | |
408 (if checkdoc-syntax-table | |
409 nil | |
410 (setq checkdoc-syntax-table (copy-syntax-table emacs-lisp-mode-syntax-table)) | |
411 ;; When dealing with syntax in doc-strings, make sure that - are encompased | |
412 ;; in words so we can use cheap \\> to get the end of a symbol, not the | |
413 ;; end of a word in a conglomerate. | |
414 (modify-syntax-entry ?- "w" checkdoc-syntax-table) | |
415 ) | |
416 | |
417 | |
418 ;;; Compatibility | |
419 ;; | |
420 (if (string-match "X[Ee]macs" emacs-version) | |
421 (progn | |
422 (defalias 'checkdoc-make-overlay 'make-extent) | |
423 (defalias 'checkdoc-overlay-put 'set-extent-property) | |
424 (defalias 'checkdoc-delete-overlay 'delete-extent) | |
425 (defalias 'checkdoc-overlay-start 'extent-start) | |
426 (defalias 'checkdoc-overlay-end 'extent-end) | |
427 (defalias 'checkdoc-mode-line-update 'redraw-modeline) | |
428 (defalias 'checkdoc-call-eval-buffer 'eval-buffer) | |
429 ) | |
430 (defalias 'checkdoc-make-overlay 'make-overlay) | |
431 (defalias 'checkdoc-overlay-put 'overlay-put) | |
432 (defalias 'checkdoc-delete-overlay 'delete-overlay) | |
433 (defalias 'checkdoc-overlay-start 'overlay-start) | |
434 (defalias 'checkdoc-overlay-end 'overlay-end) | |
435 (defalias 'checkdoc-mode-line-update 'force-mode-line-update) | |
436 (defalias 'checkdoc-call-eval-buffer 'eval-current-buffer) | |
437 ) | |
438 | |
439 ;; Emacs 20s have MULE characters which dont equate to numbers. | |
440 (if (fboundp 'char=) | |
441 (defalias 'checkdoc-char= 'char=) | |
442 (defalias 'checkdoc-char= '=)) | |
443 | |
444 ;; Emacs 19.28 and earlier don't have the handy 'add-to-list function | |
445 (if (fboundp 'add-to-list) | |
446 | |
447 (defalias 'checkdoc-add-to-list 'add-to-list) | |
448 | |
449 (defun checkdoc-add-to-list (list-var element) | |
450 "Add to the value of LIST-VAR the element ELEMENT if it isn't there yet." | |
451 (if (not (member element (symbol-value list-var))) | |
452 (set list-var (cons element (symbol-value list-var))))) | |
453 ) | |
454 | |
455 ;; To be safe in new emacsen, we want to read events, not characters | |
456 (if (fboundp 'read-event) | |
457 (defalias 'checkdoc-read-event 'read-event) | |
458 (defalias 'checkdoc-read-event 'read-char)) | |
459 | |
460 ;;; User level commands | |
461 ;; | |
462 ;;;###autoload | |
463 (defun checkdoc-eval-current-buffer () | |
464 "Evaluate and check documentation for the current buffer. | |
465 Evaluation is done first because good documentation for something that | |
466 doesn't work is just not useful. Comments, Doc-strings, and rogue | |
467 spacing are all verified." | |
468 (interactive) | |
469 (checkdoc-call-eval-buffer nil) | |
470 (checkdoc-current-buffer t)) | |
471 | |
472 ;;;###autoload | |
473 (defun checkdoc-current-buffer (&optional take-notes) | |
474 "Check the current buffer for document style, comment style, and rogue spaces. | |
475 Optional argument TAKE-NOTES non-nil will store all found errors in a | |
476 warnings buffer, otherwise it stops after the first error." | |
477 (interactive "P") | |
478 (if (interactive-p) (message "Checking buffer for style...")) | |
479 ;; Assign a flag to spellcheck flag | |
480 (let ((checkdoc-spellcheck-documentation-flag | |
481 (memq checkdoc-spellcheck-documentation-flag '(buffer t)))) | |
482 ;; every test is responsible for returning the cursor. | |
483 (or (and buffer-file-name ;; only check comments in a file | |
484 (checkdoc-comments take-notes)) | |
485 (checkdoc take-notes) | |
486 (checkdoc-rogue-spaces take-notes) | |
487 (not (interactive-p)) | |
488 (message "Checking buffer for style...Done.")))) | |
489 | |
490 ;;;###autoload | |
491 (defun checkdoc-interactive (&optional start-here) | |
492 "Interactively check the current buffers for errors. | |
493 Prefix argument START-HERE will start the checking from the current | |
494 point, otherwise the check starts at the beginning of the current | |
495 buffer. Allows navigation forward and backwards through document | |
496 errors. Does not check for comment or space warnings." | |
497 (interactive "P") | |
498 ;; Determine where to start the test | |
499 (let* ((begin (prog1 (point) | |
500 (if (not start-here) (goto-char (point-min))))) | |
501 ;; Assign a flag to spellcheck flag | |
502 (checkdoc-spellcheck-documentation-flag | |
503 (member checkdoc-spellcheck-documentation-flag | |
504 '(buffer interactive t))) | |
505 ;; Fetch the error list | |
506 (err-list (list (checkdoc-next-error)))) | |
507 (if (not (car err-list)) (setq err-list nil)) | |
508 ;; Include whatever function point is in for good measure. | |
509 (beginning-of-defun) | |
510 (while err-list | |
511 (goto-char (cdr (car err-list))) | |
512 ;; The cursor should be just in front of the offending doc-string | |
513 (let ((cdo (save-excursion | |
514 (checkdoc-make-overlay (point) | |
515 (progn (forward-sexp 1) | |
516 (point))))) | |
517 c) | |
518 (unwind-protect | |
519 (progn | |
520 (checkdoc-overlay-put cdo 'face 'highlight) | |
521 ;; Make sure the whole doc-string is visible if possible. | |
522 (sit-for 0) | |
523 (if (not (pos-visible-in-window-p | |
524 (save-excursion (forward-sexp 1) (point)) | |
525 (selected-window))) | |
526 (recenter)) | |
527 (message "%s(? e n p q)" (car (car err-list))) | |
528 (setq c (checkdoc-read-event)) | |
529 (if (not (integerp c)) (setq c ??)) | |
530 (cond ((or (checkdoc-char= c ?n) (checkdoc-char= c ?\ )) | |
531 (let ((ne (checkdoc-next-error))) | |
532 (if (not ne) | |
533 (progn | |
534 (message "No More Stylistic Errors.") | |
535 (sit-for 2)) | |
536 (setq err-list (cons ne err-list))))) | |
537 ((or (checkdoc-char= c ?p) (checkdoc-char= c ?\C-?)) | |
538 (if (/= (length err-list) 1) | |
539 (progn | |
540 (setq err-list (cdr err-list)) | |
541 ;; This will just re-ask fixup questions if | |
542 ;; it was skipped the last time. | |
543 (checkdoc-next-error)) | |
544 (message "No Previous Errors.") | |
545 (sit-for 2))) | |
546 ((checkdoc-char= c ?e) | |
547 (message "Edit the docstring, and press C-M-c to exit.") | |
548 (recursive-edit) | |
549 (checkdoc-delete-overlay cdo) | |
550 (setq err-list (cdr err-list)) ;back up the error found. | |
551 (beginning-of-defun) | |
552 (let ((ne (checkdoc-next-error))) | |
553 (if (not ne) | |
554 (progn | |
555 (message "No More Stylistic Errors.") | |
556 (sit-for 2)) | |
557 (setq err-list (cons ne err-list))))) | |
558 ((checkdoc-char= c ?q) | |
559 (setq err-list nil | |
560 begin (point))) | |
561 (t | |
562 (message "[E]dit [SPC|n] next error [DEL|p] prev error\ | |
563 [q]uit [?] help: ") | |
564 (sit-for 5)))) | |
565 (checkdoc-delete-overlay cdo)))) | |
566 (goto-char begin) | |
567 (message "Checkdoc: Done."))) | |
568 | |
569 (defun checkdoc-next-error () | |
570 "Find and return the next checkdoc error list, or nil. | |
571 Add error vector is of the form (WARNING . POSITION) where WARNING | |
572 is the warning text, and POSITION is the point in the buffer where the | |
573 error was found. We can use points and not markers because we promise | |
574 not to edit the buffer before point without re-executing this check." | |
575 (let ((msg nil) (p (point))) | |
576 (condition-case nil | |
577 (while (and (not msg) (checkdoc-next-docstring)) | |
578 (message "Searching for doc-string error...%d%%" | |
579 (/ (* 100 (point)) (point-max))) | |
580 (if (setq msg (checkdoc-this-string-valid)) | |
581 (setq msg (cons msg (point))))) | |
582 ;; Quit.. restore position, Other errors, leave alone | |
583 (quit (goto-char p))) | |
584 msg)) | |
585 | |
586 ;;;###autoload | |
587 (defun checkdoc (&optional take-notes) | |
588 "Use `checkdoc-continue' starting at the beginning of the current buffer. | |
589 Prefix argument TAKE-NOTES means to collect all the warning messages into | |
590 a separate buffer." | |
591 (interactive "P") | |
592 (let ((p (point))) | |
593 (goto-char (point-min)) | |
594 (checkdoc-continue take-notes) | |
595 ;; Go back since we can't be here without success above. | |
596 (goto-char p) | |
597 nil)) | |
598 | |
599 ;;;###autoload | |
600 (defun checkdoc-continue (&optional take-notes) | |
601 "Find the next doc-string in the current buffer which is stylisticly poor. | |
602 Prefix argument TAKE-NOTES means to continue through the whole buffer and | |
603 save warnings in a separate buffer. Second optional argument START-POINT | |
604 is the starting location. If this is nil, `point-min' is used instead." | |
605 (interactive "P") | |
606 (let ((wrong nil) (msg nil) (errors nil) | |
607 ;; Assign a flag to spellcheck flag | |
608 (checkdoc-spellcheck-documentation-flag | |
609 (member checkdoc-spellcheck-documentation-flag | |
610 '(buffer t)))) | |
611 (save-excursion | |
612 ;; If we are taking notes, encompass the whole buffer, otherwise | |
613 ;; the user is navigating down through the buffer. | |
614 (if take-notes (checkdoc-start-section "checkdoc")) | |
615 (while (and (not wrong) (checkdoc-next-docstring)) | |
21181 | 616 ;; OK, lets look at the doc-string. |
617 (setq msg (checkdoc-this-string-valid)) | |
618 (if msg | |
619 ;; Oops | |
620 (if take-notes | |
621 (progn | |
622 (checkdoc-error (point) msg) | |
623 (setq errors t)) | |
624 (setq wrong (point)))))) | |
20085 | 625 (if wrong |
626 (progn | |
627 (goto-char wrong) | |
628 (error msg))) | |
629 (if (and take-notes errors) | |
630 (checkdoc-show-diagnostics) | |
631 (if (interactive-p) | |
632 (message "No style warnings."))))) | |
633 | |
634 (defun checkdoc-next-docstring () | |
635 "Find the next doc-string after point and return t. | |
636 Return nil if there are no more doc-strings." | |
637 (if (not (re-search-forward checkdoc-defun-regexp nil t)) | |
638 nil | |
639 ;; search drops us after the identifier. The next sexp is either | |
640 ;; the argument list or the value of the variable. skip it. | |
641 (forward-sexp 1) | |
642 (skip-chars-forward " \n\t") | |
643 t)) | |
644 | |
645 ;;; ###autoload | |
646 (defun checkdoc-comments (&optional take-notes) | |
647 "Find missing comment sections in the current emacs lisp file. | |
648 Prefix argument TAKE-NOTES non-nil means to save warnings in a | |
649 separate buffer. Otherwise print a message. This returns the error | |
650 if there is one." | |
651 (interactive "P") | |
652 (if take-notes (checkdoc-start-section "checkdoc-comments")) | |
653 (if (not buffer-file-name) | |
654 (error "Can only check comments for a file buffer.")) | |
655 (let* ((checkdoc-spellcheck-documentation-flag | |
656 (member checkdoc-spellcheck-documentation-flag | |
657 '(buffer t))) | |
658 (e (checkdoc-file-comments-engine))) | |
659 (if e | |
660 (if take-notes | |
661 (checkdoc-error nil e) | |
662 (error e))) | |
663 (if (and e take-notes) | |
664 (checkdoc-show-diagnostics)) | |
665 e)) | |
666 | |
667 ;;;###autoload | |
668 (defun checkdoc-rogue-spaces (&optional take-notes) | |
669 "Find extra spaces at the end of lines in the current file. | |
670 Prefix argument TAKE-NOTES non-nil means to save warnings in a | |
671 separate buffer. Otherwise print a message. This returns the error | |
672 if there is one." | |
673 (interactive "P") | |
674 (if take-notes (checkdoc-start-section "checkdoc-rogue-spaces")) | |
675 (let ((e (checkdoc-rogue-space-check-engine))) | |
676 (if e | |
677 (if take-notes | |
678 (checkdoc-error nil e) | |
679 (message e))) | |
680 (if (and e take-notes) | |
681 (checkdoc-show-diagnostics)) | |
682 (if (not (interactive-p)) | |
683 e | |
684 (if e (message e) (message "Space Check: done."))))) | |
685 | |
686 | |
687 ;;;###autoload | |
688 (defun checkdoc-eval-defun () | |
689 "Evaluate the current form with `eval-defun' and check it's documentation. | |
690 Evaluation is done first so the form will be read before the | |
691 documentation is checked. If there is a documentation error, then the display | |
692 of what was evaluated will be overwritten by the diagnostic message." | |
693 (interactive) | |
694 (eval-defun nil) | |
695 (checkdoc-defun)) | |
696 | |
697 ;;;###autoload | |
698 (defun checkdoc-defun (&optional no-error) | |
699 "Examine the doc-string of the function or variable under point. | |
700 Calls `error' if the doc-string produces diagnostics. If NO-ERROR is | |
701 non-nil, then do not call error, but call `message' instead. | |
702 If the document check passes, then check the function for rogue white | |
703 space at the end of each line." | |
704 (interactive) | |
705 (save-excursion | |
706 (beginning-of-defun) | |
707 (if (not (looking-at checkdoc-defun-regexp)) | |
708 ;; I found this more annoying than useful. | |
709 ;;(if (not no-error) | |
710 ;; (message "Cannot check this sexp's doc-string.")) | |
711 nil | |
712 ;; search drops us after the identifier. The next sexp is either | |
713 ;; the argument list or the value of the variable. skip it. | |
714 (goto-char (match-end 0)) | |
715 (forward-sexp 1) | |
716 (skip-chars-forward " \n\t") | |
717 (let* ((checkdoc-spellcheck-documentation-flag | |
718 (member checkdoc-spellcheck-documentation-flag | |
719 '(defun t))) | |
720 (msg (checkdoc-this-string-valid))) | |
721 (if msg (if no-error (message msg) (error msg)) | |
722 (setq msg (checkdoc-rogue-space-check-engine | |
723 (save-excursion (beginning-of-defun) (point)) | |
724 (save-excursion (end-of-defun) (point)))) | |
725 (if msg (if no-error (message msg) (error msg)) | |
726 (if (interactive-p) (message "Checkdoc: done.")))))))) | |
727 | |
728 ;;; Ispell interface for forcing a spell check | |
729 ;; | |
730 | |
731 ;;;###autoload | |
732 (defun checkdoc-ispell-current-buffer (&optional take-notes) | |
733 "Check the style and spelling of the current buffer interactively. | |
734 Calls `checkdoc-current-buffer' with spell-checking turned on. | |
735 Prefix argument TAKE-NOTES is the same as for `checkdoc-current-buffer'" | |
736 (interactive) | |
737 (let ((checkdoc-spellcheck-documentation-flag t)) | |
738 (call-interactively 'checkdoc-current-buffer nil current-prefix-arg))) | |
739 | |
740 ;;;###autoload | |
741 (defun checkdoc-ispell-interactive (&optional take-notes) | |
742 "Check the style and spelling of the current buffer interactively. | |
743 Calls `checkdoc-interactive' with spell-checking turned on. | |
744 Prefix argument TAKE-NOTES is the same as for `checkdoc-interacitve'" | |
745 (interactive) | |
746 (let ((checkdoc-spellcheck-documentation-flag t)) | |
747 (call-interactively 'checkdoc-interactive nil current-prefix-arg))) | |
748 | |
749 ;;;###autoload | |
750 (defun checkdoc-ispell (&optional take-notes) | |
751 "Check the style and spelling of the current buffer. | |
752 Calls `checkdoc' with spell-checking turned on. | |
753 Prefix argument TAKE-NOTES is the same as for `checkdoc'" | |
754 (interactive) | |
755 (let ((checkdoc-spellcheck-documentation-flag t)) | |
756 (call-interactively 'checkdoc nil current-prefix-arg))) | |
757 | |
758 ;;;###autoload | |
759 (defun checkdoc-ispell-continue (&optional take-notes) | |
760 "Check the style and spelling of the current buffer after point. | |
761 Calls `checkdoc-continue' with spell-checking turned on. | |
762 Prefix argument TAKE-NOTES is the same as for `checkdoc-continue'" | |
763 (interactive) | |
764 (let ((checkdoc-spellcheck-documentation-flag t)) | |
765 (call-interactively 'checkdoc-continue nil current-prefix-arg))) | |
766 | |
767 ;;;###autoload | |
768 (defun checkdoc-ispell-comments (&optional take-notes) | |
769 "Check the style and spelling of the current buffer's comments. | |
770 Calls `checkdoc-comments' with spell-checking turned on. | |
771 Prefix argument TAKE-NOTES is the same as for `checkdoc-comments'" | |
772 (interactive) | |
773 (let ((checkdoc-spellcheck-documentation-flag t)) | |
774 (call-interactively 'checkdoc-comments nil current-prefix-arg))) | |
775 | |
776 ;;;###autoload | |
777 (defun checkdoc-ispell-defun (&optional take-notes) | |
778 "Check the style and spelling of the current defun with ispell. | |
779 Calls `checkdoc-defun' with spell-checking turned on. | |
780 Prefix argument TAKE-NOTES is the same as for `checkdoc-defun'" | |
781 (interactive) | |
782 (let ((checkdoc-spellcheck-documentation-flag t)) | |
783 (call-interactively 'checkdoc-defun nil current-prefix-arg))) | |
784 | |
785 ;;; Minor Mode specification | |
786 ;; | |
787 (defvar checkdoc-minor-mode nil | |
788 "Non-nil in `emacs-lisp-mode' for automatic documentation checking.") | |
789 (make-variable-buffer-local 'checkdoc-minor-mode) | |
790 | |
791 (checkdoc-add-to-list 'minor-mode-alist '(checkdoc-minor-mode " CDoc")) | |
792 | |
793 (defvar checkdoc-minor-keymap | |
794 (let ((map (make-sparse-keymap)) | |
795 (pmap (make-sparse-keymap))) | |
796 ;; Override some bindings | |
797 (define-key map "\C-\M-x" 'checkdoc-eval-defun) | |
798 (if (not (string-match "XEmacs" emacs-version)) | |
799 (define-key map [menu-bar emacs-lisp eval-buffer] | |
800 'checkdoc-eval-current-buffer)) | |
801 (define-key pmap "x" 'checkdoc-defun) | |
802 (define-key pmap "X" 'checkdoc-ispell-defun) | |
803 (define-key pmap "`" 'checkdoc-continue) | |
804 (define-key pmap "~" 'checkdoc-ispell-continue) | |
805 (define-key pmap "d" 'checkdoc) | |
806 (define-key pmap "D" 'checkdoc-ispell) | |
807 (define-key pmap "i" 'checkdoc-interactive) | |
808 (define-key pmap "I" 'checkdoc-ispell-interactive) | |
809 (define-key pmap "b" 'checkdoc-current-buffer) | |
810 (define-key pmap "B" 'checkdoc-ispell-current-buffer) | |
811 (define-key pmap "e" 'checkdoc-eval-current-buffer) | |
812 (define-key pmap "c" 'checkdoc-comments) | |
813 (define-key pmap "C" 'checkdoc-ispell-comments) | |
814 (define-key pmap " " 'checkdoc-rogue-spaces) | |
815 | |
816 ;; bind our submap into map | |
817 (define-key map "\C-c?" pmap) | |
818 map) | |
819 "Keymap used to override evaluation key-bindings for documentation checking.") | |
820 | |
821 ;; Add in a menubar with easy-menu | |
822 | |
823 (if checkdoc-minor-keymap | |
824 (easy-menu-define | |
825 checkdoc-minor-menu checkdoc-minor-keymap "Checkdoc Minor Mode Menu" | |
826 '("CheckDoc" | |
827 ["First Style Error" checkdoc t] | |
828 ["First Style or Spelling Error " checkdoc-ispell t] | |
829 ["Next Style Error" checkdoc-continue t] | |
830 ["Next Style or Spelling Error" checkdoc-ispell-continue t] | |
831 ["Interactive Style Check" checkdoc-interactive t] | |
832 ["Interactive Style and Spelling Check" checkdoc-ispell-interactive t] | |
833 ["Check Defun" checkdoc-defun t] | |
834 ["Check and Spell Defun" checkdoc-ispell-defun t] | |
835 ["Check and Evaluate Defun" checkdoc-eval-defun t] | |
836 ["Check Buffer" checkdoc-current-buffer t] | |
837 ["Check and Spell Buffer" checkdoc-ispell-current-buffer t] | |
838 ["Check and Evaluate Buffer" checkdoc-eval-current-buffer t] | |
839 ["Check Comment Style" checkdoc-comments buffer-file-name] | |
840 ["Check Comment Style and Spelling" checkdoc-ispell-comments | |
841 buffer-file-name] | |
842 ["Check for Rogue Spaces" checkdoc-rogue-spaces t] | |
843 ))) | |
844 ;; XEmacs requires some weird stuff to add this menu in a minor mode. | |
845 ;; What is it? | |
846 | |
847 ;; Allow re-insertion of a new keymap | |
848 (let ((a (assoc 'checkdoc-minor-mode minor-mode-map-alist))) | |
849 (if a | |
850 (setcdr a checkdoc-minor-keymap) | |
851 (checkdoc-add-to-list 'minor-mode-map-alist (cons 'checkdoc-minor-mode | |
852 checkdoc-minor-keymap)))) | |
853 | |
854 ;;;###autoload | |
855 (defun checkdoc-minor-mode (&optional arg) | |
856 "Toggle checkdoc minor mode. A mode for checking lisp doc-strings. | |
857 With prefix ARG, turn checkdoc minor mode on iff ARG is positive. | |
858 | |
859 In checkdoc minor mode, the usual bindings for `eval-defun' which is | |
860 bound to \\<checkdoc-minor-keymap> \\[checkdoc-eval-defun] and `checkdoc-eval-current-buffer' are overridden to include | |
861 checking of documentation strings. | |
862 | |
863 \\{checkdoc-minor-keymap}" | |
864 (interactive "P") | |
865 (setq checkdoc-minor-mode | |
866 (not (or (and (null arg) checkdoc-minor-mode) | |
867 (<= (prefix-numeric-value arg) 0)))) | |
868 (checkdoc-mode-line-update)) | |
869 | |
870 ;;; Subst utils | |
871 ;; | |
872 (defsubst checkdoc-run-hooks (hookvar &rest args) | |
873 "Run hooks in HOOKVAR with ARGS." | |
874 (if (fboundp 'run-hook-with-args-until-success) | |
875 (apply 'run-hook-with-args-until-success hookvar args) | |
876 ;; This method was similar to above. We ignore the warning | |
877 ;; since we will use the above for future emacs versions | |
878 (apply 'run-hook-with-args hookvar args))) | |
879 | |
880 (defsubst checkdoc-create-common-verbs-regexp () | |
881 "Rebuild the contents of `checkdoc-common-verbs-regexp'." | |
882 (or checkdoc-common-verbs-regexp | |
883 (setq checkdoc-common-verbs-regexp | |
884 (concat "\\<\\(" | |
885 (mapconcat (lambda (e) (concat (car e))) | |
886 checkdoc-common-verbs-wrong-voice "\\|") | |
887 "\\)\\>")))) | |
888 | |
889 ;; Profiler says this is not yet faster than just calling assoc | |
890 ;;(defun checkdoc-word-in-alist-vector (word vector) | |
891 ;; "Check to see if WORD is in the car of an element of VECTOR. | |
892 ;;VECTOR must be sorted. The CDR should be a replacement. Since the | |
893 ;;word list is getting bigger, it is time for a quick bisecting search." | |
894 ;; (let ((max (length vector)) (min 0) i | |
895 ;; (found nil) (fw nil)) | |
896 ;; (setq i (/ max 2)) | |
897 ;; (while (and (not found) (/= min max)) | |
898 ;; (setq fw (car (aref vector i))) | |
899 ;; (cond ((string= word fw) (setq found (cdr (aref vector i)))) | |
900 ;; ((string< word fw) (setq max i)) | |
901 ;; (t (setq min i))) | |
902 ;; (setq i (/ (+ max min) 2)) | |
903 ;; ) | |
904 ;; found)) | |
905 | |
906 ;;; Checking engines | |
907 ;; | |
908 (defun checkdoc-this-string-valid () | |
909 "Return a message string if the current doc-string is invalid. | |
910 Check for style only, such as the first line always being a complete | |
911 sentence, whitespace restrictions, and making sure there are no | |
912 hard-coded key-codes such as C-[char] or mouse-[number] in the comment. | |
913 See the style guide in the Emacs Lisp manual for more details." | |
914 | |
915 ;; Jump over comments between the last object and the doc-string | |
916 (while (looking-at "[ \t\n]*;") | |
917 (forward-line 1) | |
918 (beginning-of-line) | |
919 (skip-chars-forward " \n\t")) | |
920 | |
921 (if (not (looking-at "[ \t\n]*\"")) | |
922 nil | |
923 (let ((old-syntax-table (syntax-table))) | |
924 (unwind-protect | |
925 (progn | |
926 (set-syntax-table checkdoc-syntax-table) | |
927 (checkdoc-this-string-valid-engine)) | |
928 (set-syntax-table old-syntax-table))))) | |
929 | |
930 (defun checkdoc-this-string-valid-engine () | |
931 "Return a message string if the current doc-string is invalid. | |
932 Depends on `checkdoc-this-string-valid' to reset the syntax table so that | |
933 regexp short cuts work." | |
934 (let ((case-fold-search nil) | |
935 ;; Use a marker so if an early check modifies the text, | |
936 ;; we won't accidentally loose our place. This could cause | |
937 ;; end-of doc-string whitespace to also delete the " char. | |
938 (e (save-excursion (forward-sexp 1) (point-marker))) | |
939 (fp (checkdoc-defun-info))) | |
940 (or | |
941 ;; * *Do not* indent subsequent lines of a documentation string so that | |
942 ;; the text is lined up in the source code with the text of the first | |
943 ;; line. This looks nice in the source code, but looks bizarre when | |
944 ;; users view the documentation. Remember that the indentation | |
945 ;; before the starting double-quote is not part of the string! | |
946 (save-excursion | |
947 (forward-line 1) | |
948 (beginning-of-line) | |
949 (if (and (< (point) e) | |
950 (looking-at "\\([ \t]+\\)[^ \t\n]")) | |
951 (if (checkdoc-autofix-ask-replace (match-beginning 1) | |
952 (match-end 1) | |
953 "Remove this whitespace?" | |
954 "") | |
955 nil | |
956 "Second line should not have indentation"))) | |
957 ;; * Do not start or end a documentation string with whitespace. | |
958 (let (start end) | |
959 (if (or (if (looking-at "\"\\([ \t\n]+\\)") | |
960 (setq start (match-beginning 1) | |
961 end (match-end 1))) | |
962 (save-excursion | |
963 (forward-sexp 1) | |
964 (forward-char -1) | |
965 (if (/= (skip-chars-backward " \t\n") 0) | |
966 (setq start (point) | |
967 end (1- e))))) | |
968 (if (checkdoc-autofix-ask-replace | |
969 start end "Remove this whitespace?" "") | |
970 nil | |
971 "Documentation strings should not start or end with whitespace"))) | |
972 ;; * Every command, function, or variable intended for users to know | |
973 ;; about should have a documentation string. | |
974 ;; | |
975 ;; * An internal variable or subroutine of a Lisp program might as well | |
976 ;; have a documentation string. In earlier Emacs versions, you could | |
977 ;; save space by using a comment instead of a documentation string, | |
978 ;; but that is no longer the case. | |
979 (if (and (not (nth 1 fp)) ; not a variable | |
980 (or (nth 2 fp) ; is interactive | |
981 checkdoc-force-docstrings-flag) ;or we always complain | |
982 (not (checkdoc-char= (following-char) ?\"))) ; no doc-string | |
983 (if (nth 2 fp) | |
984 "All interactive functions should have documentation" | |
985 "All variables and subroutines might as well have a \ | |
986 documentation string")) | |
987 ;; * The first line of the documentation string should consist of one | |
988 ;; or two complete sentences that stand on their own as a summary. | |
989 ;; `M-x apropos' displays just the first line, and if it doesn't | |
990 ;; stand on its own, the result looks bad. In particular, start the | |
991 ;; first line with a capital letter and end with a period. | |
992 (save-excursion | |
993 (end-of-line) | |
994 (skip-chars-backward " \t\n") | |
995 (if (> (point) e) (goto-char e)) ;of the form (defun n () "doc" nil) | |
996 (forward-char -1) | |
997 (cond | |
998 ((and (checkdoc-char= (following-char) ?\") | |
999 ;; A backslashed double quote at the end of a sentence | |
1000 (not (checkdoc-char= (preceding-char) ?\\))) | |
1001 ;; We might have to add a period in this case | |
1002 (forward-char -1) | |
1003 (if (looking-at "[.!]") | |
1004 nil | |
1005 (forward-char 1) | |
1006 (if (checkdoc-autofix-ask-replace | |
1007 (point) (1+ (point)) "Add period to sentence?" | |
1008 ".\"" t) | |
1009 nil | |
1010 "First sentence should end with punctuation."))) | |
1011 ((looking-at "[\\!;:.)]") | |
1012 ;; These are ok | |
1013 nil) | |
1014 (t | |
1015 ;; If it is not a complete sentence, lets see if we can | |
1016 ;; predict a clever way to make it one. | |
1017 (let ((msg "First line is not a complete sentence") | |
1018 (e (point))) | |
1019 (beginning-of-line) | |
1020 (if (re-search-forward "\\. +" e t) | |
1021 ;; Here we have found a complete sentence, but no break. | |
1022 (if (checkdoc-autofix-ask-replace | |
1023 (1+ (match-beginning 0)) (match-end 0) | |
1024 "First line not a complete sentence. Add CR here?" | |
1025 "\n" t) | |
1026 (let (l1 l2) | |
1027 (forward-line 1) | |
1028 (end-of-line) | |
1029 (setq l1 (current-column) | |
1030 l2 (save-excursion | |
1031 (forward-line 1) | |
1032 (end-of-line) | |
1033 (current-column))) | |
1034 (if (> (+ l1 l2 1) 80) | |
1035 (setq msg "Incomplete auto-fix. Doc-string \ | |
1036 may require more formatting.") | |
1037 ;; We can merge these lines! Replace this CR | |
1038 ;; with a space. | |
1039 (delete-char 1) (insert " ") | |
1040 (setq msg nil)))) | |
1041 ;; Lets see if there is enough room to draw the next | |
1042 ;; line's sentence up here. I often get hit w/ | |
1043 ;; auto-fill moving my words around. | |
1044 (let ((numc (progn (end-of-line) (- 80 (current-column)))) | |
1045 (p (point))) | |
1046 (forward-line 1) | |
1047 (beginning-of-line) | |
1048 (if (and (re-search-forward "[.!:\"][ \n\"]" (save-excursion | |
1049 (end-of-line) | |
1050 (point)) | |
1051 t) | |
1052 (< (current-column) numc)) | |
1053 (if (checkdoc-autofix-ask-replace | |
1054 p (1+ p) | |
1055 "1st line not a complete sentence. Join these lines?" | |
1056 " " t) | |
1057 (progn | |
1058 ;; They said yes. We have more fill work to do... | |
1059 (delete-char 1) | |
1060 (insert "\n") | |
1061 (setq msg nil)))))) | |
1062 msg)))) | |
1063 ;; Continuation of above. Make sure our sentence is capitalized. | |
1064 (save-excursion | |
1065 (skip-chars-forward "\"\\*") | |
1066 (if (looking-at "[a-z]") | |
1067 (if (checkdoc-autofix-ask-replace | |
1068 (match-beginning 0) (match-end 0) | |
1069 "Capitalize your sentence?" (upcase (match-string 0)) | |
1070 t) | |
1071 nil | |
1072 "First line should be capitalized.") | |
1073 nil)) | |
1074 ;; * For consistency, phrase the verb in the first sentence of a | |
1075 ;; documentation string as an infinitive with "to" omitted. For | |
1076 ;; instance, use "Return the cons of A and B." in preference to | |
1077 ;; "Returns the cons of A and B." Usually it looks good to do | |
1078 ;; likewise for the rest of the first paragraph. Subsequent | |
1079 ;; paragraphs usually look better if they have proper subjects. | |
1080 ;; | |
1081 ;; For our purposes, just check to first sentence. A more robust | |
1082 ;; grammar checker would be preferred for the rest of the | |
1083 ;; documentation string. | |
1084 (and checkdoc-verb-check-experimental-flag | |
1085 (save-excursion | |
1086 ;; Maybe rebuild the monster-regex | |
1087 (checkdoc-create-common-verbs-regexp) | |
1088 (let ((lim (save-excursion | |
1089 (end-of-line) | |
1090 ;; check string-continuation | |
1091 (if (checkdoc-char= (preceding-char) ?\\) | |
1092 (progn (forward-line 1) | |
1093 (end-of-line))) | |
1094 (point))) | |
1095 (rs nil) replace original (case-fold-search t)) | |
1096 (while (and (not rs) | |
1097 (re-search-forward checkdoc-common-verbs-regexp | |
1098 lim t)) | |
1099 (setq original (buffer-substring-no-properties | |
1100 (match-beginning 1) (match-end 1)) | |
1101 rs (assoc (downcase original) | |
1102 checkdoc-common-verbs-wrong-voice)) | |
1103 (if (not rs) (error "Verb voice alist corrupted.")) | |
1104 (setq replace (let ((case-fold-search nil)) | |
1105 (save-match-data | |
1106 (if (string-match "^[A-Z]" original) | |
1107 (capitalize (cdr rs)) | |
1108 (cdr rs))))) | |
1109 (if (checkdoc-autofix-ask-replace | |
1110 (match-beginning 1) (match-end 1) | |
1111 (format "Wrong voice for verb `%s'. Replace with `%s'?" | |
1112 original replace) | |
1113 replace t) | |
1114 (setq rs nil))) | |
1115 (if rs | |
1116 ;; there was a match, but no replace | |
1117 (format | |
1118 "Incorrect voice in sentence. Use `%s' instead of `%s'." | |
1119 replace original))))) | |
1120 ;; * Don't write key sequences directly in documentation strings. | |
1121 ;; Instead, use the `\\[...]' construct to stand for them. | |
1122 (save-excursion | |
1123 (let ((f nil) (m nil) (start (point)) | |
21181 | 1124 (re "[^`A-Za-z0-9_]\\([CMA]-[a-zA-Z]\\|\\(\\([CMA]-\\)?\ |
20085 | 1125 mouse-[0-3]\\)\\)\\>")) |
1126 ;; Find the first key sequence not in a sample | |
1127 (while (and (not f) (setq m (re-search-forward re e t))) | |
1128 (setq f (not (checkdoc-in-sample-code-p start e)))) | |
1129 (if m | |
1130 (concat | |
1131 "Keycode " (match-string 1) | |
1132 " embedded in doc-string. Use \\\\<keymap> & \\\\[function] " | |
1133 "instead")))) | |
1134 ;; It is not practical to use `\\[...]' very many times, because | |
1135 ;; display of the documentation string will become slow. So use this | |
1136 ;; to describe the most important commands in your major mode, and | |
1137 ;; then use `\\{...}' to display the rest of the mode's keymap. | |
1138 (save-excursion | |
1139 (if (re-search-forward "\\\\\\\\\\[\\w+" e t | |
1140 (1+ checkdoc-max-keyref-before-warn)) | |
1141 "Too many occurrences of \\[function]. Use \\{keymap} instead")) | |
1142 ;; * Format the documentation string so that it fits in an | |
1143 ;; Emacs window on an 80-column screen. It is a good idea | |
1144 ;; for most lines to be no wider than 60 characters. The | |
1145 ;; first line can be wider if necessary to fit the | |
1146 ;; information that ought to be there. | |
1147 (save-excursion | |
1148 (let ((start (point))) | |
1149 (while (and (< (point) e) | |
1150 (or (progn (end-of-line) (< (current-column) 80)) | |
1151 (progn (beginning-of-line) | |
1152 (re-search-forward "\\\\\\\\[[<{]" | |
1153 (save-excursion | |
1154 (end-of-line) | |
1155 (point)) t)) | |
1156 (checkdoc-in-sample-code-p start e))) | |
1157 (forward-line 1)) | |
1158 (end-of-line) | |
1159 (if (and (< (point) e) (> (current-column) 80)) | |
1160 "Some lines are over 80 columns wide"))) | |
1161 ;;* When a documentation string refers to a Lisp symbol, write it as | |
1162 ;; it would be printed (which usually means in lower case), with | |
1163 ;; single-quotes around it. For example: `lambda'. There are two | |
1164 ;; exceptions: write t and nil without single-quotes. (In this | |
1165 ;; manual, we normally do use single-quotes for those symbols.) | |
1166 (save-excursion | |
1167 (let ((found nil) (start (point)) (msg nil) (ms nil)) | |
1168 (while (and (not msg) | |
1169 (re-search-forward | |
1170 "[^([`':]\\(\\w\+[:-]\\(\\w\\|\\s_\\)+\\)[^]']" | |
1171 e t)) | |
1172 (setq ms (match-string 1)) | |
1173 (save-match-data | |
1174 ;; A . is a \s_ char, so we must remove periods from | |
1175 ;; sentences more carefully. | |
1176 (if (string-match "\\.$" ms) | |
1177 (setq ms (substring ms 0 (1- (length ms)))))) | |
1178 (if (and (not (checkdoc-in-sample-code-p start e)) | |
1179 (setq found (intern-soft ms)) | |
1180 (or (boundp found) (fboundp found))) | |
1181 (progn | |
1182 (setq msg (format "Lisp symbol %s should appear in `quotes'" | |
1183 ms)) | |
1184 (if (checkdoc-autofix-ask-replace | |
1185 (match-beginning 1) (+ (match-beginning 1) | |
1186 (length ms)) | |
1187 msg (concat "`" ms "'") t) | |
1188 (setq msg nil))))) | |
1189 msg)) | |
1190 ;; t and nil case | |
1191 (save-excursion | |
1192 (if (re-search-forward "\\(`\\(t\\|nil\\)'\\)" e t) | |
1193 (if (checkdoc-autofix-ask-replace | |
1194 (match-beginning 1) (match-end 1) | |
1195 (format "%s should not appear in quotes. Remove?" | |
1196 (match-string 2)) | |
1197 (match-string 2) t) | |
1198 nil | |
1199 "Symbols t and nil should not appear in `quotes'"))) | |
1200 ;; Here we deviate to tests based on a variable or function. | |
1201 (cond ((eq (nth 1 fp) t) | |
1202 ;; This is if we are in a variable | |
1203 (or | |
1204 ;; * The documentation string for a variable that is a | |
1205 ;; yes-or-no flag should start with words such as "Non-nil | |
1206 ;; means...", to make it clear that all non-`nil' values are | |
1207 ;; equivalent and indicate explicitly what `nil' and non-`nil' | |
1208 ;; mean. | |
1209 ;; * If a user option variable records a true-or-false | |
1210 ;; condition, give it a name that ends in `-flag'. | |
1211 | |
1212 ;; If the variable has -flag in the name, make sure | |
1213 (if (and (string-match "-flag$" (car fp)) | |
1214 (not (looking-at "\"\\*?Non-nil\\s-+means\\s-+"))) | |
1215 "Flag variable doc-strings should start: Non-nil means") | |
1216 ;; If the doc-string starts with "Non-nil means" | |
1217 (if (and (looking-at "\"\\*?Non-nil\\s-+means\\s-+") | |
1218 (not (string-match "-flag$" (car fp)))) | |
1219 "Flag variables should end in: -flag") | |
1220 ;; Done with variables | |
1221 )) | |
1222 (t | |
1223 ;; This if we are in a function definition | |
1224 (or | |
1225 ;; * When a function's documentation string mentions the value | |
1226 ;; of an argument of the function, use the argument name in | |
1227 ;; capital letters as if it were a name for that value. Thus, | |
1228 ;; the documentation string of the function `/' refers to its | |
1229 ;; second argument as `DIVISOR', because the actual argument | |
1230 ;; name is `divisor'. | |
1231 | |
1232 ;; Addendum: Make sure they appear in the doc in the same | |
1233 ;; order that they are found in the arg list. | |
1234 (let ((args (cdr (cdr (cdr (cdr fp))))) | |
1235 (last-pos 0) | |
1236 (found 1) | |
1237 (order (and (nth 3 fp) (car (nth 3 fp)))) | |
1238 (nocheck (append '("&optional" "&rest") (nth 3 fp)))) | |
1239 (while (and args found (> found last-pos)) | |
1240 (if (member (car args) nocheck) | |
1241 (setq args (cdr args)) | |
1242 (setq last-pos found | |
1243 found (save-excursion | |
1244 (re-search-forward | |
1245 (concat "\\<" (upcase (car args)) | |
1246 ;; Require whitespace OR | |
1247 ;; ITEMth<space> OR | |
1248 ;; ITEMs<space> | |
1249 "\\(\\>\\|th\\>\\|s\\>\\)") | |
1250 e t))) | |
1251 (if (not found) | |
1252 (let ((case-fold-search t)) | |
1253 ;; If the symbol was not found, lets see if we | |
1254 ;; can find it with a different capitalization | |
1255 ;; and see if the user wants to capitalize it. | |
1256 (if (save-excursion | |
1257 (re-search-forward | |
1258 (concat "\\<\\(" (car args) | |
1259 ;; Require whitespace OR | |
1260 ;; ITEMth<space> OR | |
1261 ;; ITEMs<space> | |
1262 "\\)\\(\\>\\|th\\>\\|s\\>\\)") | |
1263 e t)) | |
1264 (if (checkdoc-autofix-ask-replace | |
1265 (match-beginning 1) (match-end 1) | |
1266 (format | |
1267 "Argument `%s' should appear as `%s'. Fix?" | |
1268 (car args) (upcase (car args))) | |
1269 (upcase (car args)) t) | |
1270 (setq found (match-beginning 1)))))) | |
1271 (if found (setq args (cdr args))))) | |
1272 (if (not found) | |
1273 (format | |
1274 "Argument `%s' should appear as `%s' in the doc-string" | |
1275 (car args) (upcase (car args))) | |
1276 (if (or (and order (eq order 'yes)) | |
1277 (and (not order) checkdoc-arguments-in-order-flag)) | |
1278 (if (< found last-pos) | |
1279 "Arguments occur in the doc-string out of order")))) | |
1280 ;; Done with functions | |
1281 ))) | |
1282 ;; Make sure the doc-string has correctly spelled english words | |
1283 ;; in it. This functions is extracted due to it's complexity, | |
1284 ;; and reliance on the ispell program. | |
1285 (checkdoc-ispell-docstring-engine e) | |
1286 ;; User supplied checks | |
1287 (save-excursion (checkdoc-run-hooks 'checkdoc-style-hooks fp e)) | |
1288 ;; Done! | |
1289 ))) | |
1290 | |
1291 (defun checkdoc-defun-info nil | |
1292 "Return a list of details about the current sexp. | |
1293 It is a list of the form: | |
1294 '( NAME VARIABLE INTERACTIVE NODOCPARAMS PARAMETERS ... ) | |
1295 where NAME is the name, VARIABLE is t if this is a `defvar', | |
1296 INTERACTIVE is nil if this is not an interactive function, otherwise | |
1297 it is the position of the `interactive' call, and PARAMETERS is a | |
1298 string which is the name of each variable in the function's argument | |
1299 list. The NODOCPARAMS is a sublist of parameters specified by a checkdoc | |
1300 comment for a given defun. If the first element is not a string, then | |
1301 the token checkdoc-order: <TOKEN> exists, and TOKEN is a symbol read | |
1302 from the comment." | |
1303 (save-excursion | |
1304 (beginning-of-defun) | |
1305 (let ((defun (looking-at "(def\\(un\\|macro\\|subst\\|advice\\)")) | |
1306 (is-advice (looking-at "(defadvice")) | |
1307 (lst nil) | |
1308 (ret nil) | |
1309 (oo (make-vector 3 0))) ;substitute obarray for `read' | |
1310 (forward-char 1) | |
1311 (forward-sexp 1) | |
1312 (skip-chars-forward " \n\t") | |
1313 (setq ret | |
1314 (list (buffer-substring-no-properties | |
1315 (point) (progn (forward-sexp 1) (point))))) | |
1316 (if (not defun) | |
1317 (setq ret (cons t ret)) | |
1318 ;; The variable spot | |
1319 (setq ret (cons nil ret)) | |
1320 ;; Interactive | |
1321 (save-excursion | |
1322 (setq ret (cons | |
1323 (re-search-forward "(interactive" | |
1324 (save-excursion (end-of-defun) (point)) | |
1325 t) | |
1326 ret))) | |
1327 (skip-chars-forward " \t\n") | |
1328 (let ((bss (buffer-substring (point) (save-excursion (forward-sexp 1) | |
1329 (point)))) | |
1330 ;; Overload th main obarray so read doesn't intern the | |
1331 ;; local symbols of the function we are checking. | |
1332 ;; Without this we end up cluttering the symbol space w/ | |
1333 ;; useless symbols. | |
1334 (obarray oo)) | |
1335 ;; Ok, check for checkdoc parameter comment here | |
1336 (save-excursion | |
1337 (setq ret | |
1338 (cons | |
1339 (let ((sl1 nil)) | |
1340 (if (re-search-forward ";\\s-+checkdoc-order:\\s-+" | |
1341 (save-excursion (end-of-defun) | |
1342 (point)) | |
1343 t) | |
1344 (setq sl1 (list (cond ((looking-at "nil") 'no) | |
1345 ((looking-at "t") 'yes))))) | |
1346 (if (re-search-forward ";\\s-+checkdoc-params:\\s-+" | |
1347 (save-excursion (end-of-defun) | |
1348 (point)) | |
1349 t) | |
1350 (let ((sl nil)) | |
1351 (goto-char (match-end 0)) | |
1352 (setq lst (read (current-buffer))) | |
1353 (while lst | |
1354 (setq sl (cons (symbol-name (car lst)) sl) | |
1355 lst (cdr lst))) | |
1356 (setq sl1 (append sl1 sl)))) | |
1357 sl1) | |
1358 ret))) | |
1359 ;; Read the list of paramters, but do not put the symbols in | |
1360 ;; the standard obarray. | |
1361 (setq lst (read bss))) | |
1362 ;; This is because read will intern nil if it doesn't into the | |
1363 ;; new obarray. | |
1364 (if (not (listp lst)) (setq lst nil)) | |
1365 (if is-advice nil | |
1366 (while lst | |
1367 (setq ret (cons (symbol-name (car lst)) ret) | |
1368 lst (cdr lst))))) | |
1369 (nreverse ret)))) | |
1370 | |
1371 (defun checkdoc-in-sample-code-p (start limit) | |
1372 "Return Non-nil if the current point is in a code-fragment. | |
1373 A code fragment is identified by an open parenthesis followed by a | |
1374 symbol which is a valid function, or a parenthesis that is quoted with the ' | |
1375 character. Only the region from START to LIMIT is is allowed while | |
1376 searching for the bounding parenthesis." | |
1377 (save-match-data | |
1378 (save-restriction | |
1379 (narrow-to-region start limit) | |
1380 (save-excursion | |
1381 (and (condition-case nil (progn (up-list 1) t) (error nil)) | |
1382 (condition-case nil (progn (forward-list -1) t) (error nil)) | |
1383 (or (save-excursion (forward-char -1) (looking-at "'(")) | |
1384 (and (looking-at "(\\(\\(\\w\\|[-:_]\\)+\\)[ \t\n;]") | |
1385 (let ((ms (buffer-substring-no-properties | |
1386 (match-beginning 1) (match-end 1)))) | |
1387 ;; if this string is function bound, we are in | |
1388 ;; sample code. If it has a - or : character in | |
1389 ;; the name, then it is probably supposed to be bound | |
1390 ;; but isn't yet. | |
1391 (or (fboundp (intern-soft ms)) | |
1392 (string-match "\\w[-:_]+\\w" ms)))))))))) | |
1393 | |
1394 ;;; Ispell engine | |
1395 ;; | |
1396 (eval-when-compile (require 'ispell)) | |
1397 | |
1398 (defun checkdoc-ispell-init () | |
1399 "Initialize ispell process (default version) with lisp words. | |
1400 The words used are from `checkdoc-ispell-lisp-words'. If `ispell' | |
1401 cannot be loaded, then set `checkdoc-spellcheck-documentation-flag' to | |
1402 nil." | |
1403 (require 'ispell) | |
1404 (if (not (symbol-value 'ispell-process)) ;Silence byteCompiler | |
1405 (condition-case nil | |
1406 (progn | |
1407 (ispell-buffer-local-words) | |
1408 ;; This code copied in part from ispell.el emacs 19.34 | |
1409 (let ((w checkdoc-ispell-lisp-words)) | |
1410 (while w | |
1411 (process-send-string | |
1412 ;; Silence byte compiler | |
1413 (symbol-value 'ispell-process) | |
1414 (concat "@" (car w) "\n")) | |
1415 (setq w (cdr w))))) | |
1416 (error (setq checkdoc-spellcheck-documentation-flag nil))))) | |
1417 | |
1418 (defun checkdoc-ispell-docstring-engine (end) | |
1419 "Run the ispell tools on the doc-string between point and END. | |
1420 Since ispell isn't lisp smart, we must pre-process the doc-string | |
1421 before using the ispell engine on it." | |
1422 (if (not checkdoc-spellcheck-documentation-flag) | |
1423 nil | |
1424 (checkdoc-ispell-init) | |
1425 (save-excursion | |
1426 (skip-chars-forward "^a-zA-Z") | |
1427 (let ((word nil) (sym nil) (case-fold-search nil) (err nil)) | |
1428 (while (and (not err) (< (point) end)) | |
1429 (if (save-excursion (forward-char -1) (looking-at "[('`]")) | |
1430 ;; Skip lists describing meta-syntax, or bound variables | |
1431 (forward-sexp 1) | |
1432 (setq word (buffer-substring-no-properties | |
1433 (point) (progn | |
1434 (skip-chars-forward "a-zA-Z-") | |
1435 (point))) | |
1436 sym (intern-soft word)) | |
1437 (if (and sym (or (boundp sym) (fboundp sym))) | |
1438 ;; This is probably repetative in most cases, but not always. | |
1439 nil | |
1440 ;; Find out how we spell-check this word. | |
1441 (if (or | |
20603
24dda0afd915
Added some more comments in the commentary.
Eric M. Ludlam <zappo@gnu.org>
parents:
20085
diff
changeset
|
1442 ;; All caps w/ option th, or s tacked on the end |
24dda0afd915
Added some more comments in the commentary.
Eric M. Ludlam <zappo@gnu.org>
parents:
20085
diff
changeset
|
1443 ;; for pluralization or nuberthness. |
24dda0afd915
Added some more comments in the commentary.
Eric M. Ludlam <zappo@gnu.org>
parents:
20085
diff
changeset
|
1444 (string-match "^[A-Z][A-Z]+\\(s\\|th\\)?$" word) |
20085 | 1445 (looking-at "}") ; a keymap expression |
1446 ) | |
1447 nil | |
1448 (save-excursion | |
1449 (if (not (eq checkdoc-autofix-flag 'never)) | |
1450 (let ((lk last-input-event)) | |
1451 (ispell-word nil t) | |
1452 (if (not (equal last-input-event lk)) | |
1453 (progn | |
1454 (sit-for 0) | |
1455 (message "Continuing...")))) | |
1456 ;; Nothing here. | |
1457 ))))) | |
1458 (skip-chars-forward "^a-zA-Z")) | |
1459 err)))) | |
1460 | |
1461 ;;; Rogue space checking engine | |
1462 ;; | |
1463 (defun checkdoc-rogue-space-check-engine (&optional start end) | |
1464 "Return a message string if there is a line with white space at the end. | |
1465 If `checkdoc-autofix-flag' permits, delete that whitespace instead. | |
1466 If optional arguments START and END are non nil, bound the check to | |
1467 this region." | |
1468 (let ((p (point)) | |
1469 (msg nil)) | |
1470 (if (not start) (setq start (point-min))) | |
1471 ;; If end is nil, it means end of buffer to search anyway | |
1472 (or | |
1473 ;; Checkfor and error if `? ' or `?\ ' is used at the end of a line. | |
1474 ;; (It's dangerous) | |
1475 (progn | |
1476 (goto-char start) | |
1477 (if (re-search-forward "\\?\\\\?[ \t][ \t]*$" end t) | |
1478 (setq msg | |
1479 "Don't use `? ' at the end of a line. \ | |
1480 Some editors & news agents may remove it"))) | |
1481 ;; Check for, and pottentially remove whitespace appearing at the | |
1482 ;; end of different lines. | |
1483 (progn | |
1484 (goto-char start) | |
1485 ;; There is no documentation in the elisp manual about this check, | |
1486 ;; it is intended to help clean up messy code and reduce the file size. | |
1487 (while (and (not msg) (re-search-forward "[^ \t\n]\\([ \t]+\\)$" end t)) | |
1488 ;; This is not a complex activity | |
1489 (if (checkdoc-autofix-ask-replace | |
1490 (match-beginning 1) (match-end 1) | |
1491 "White space at end of line. Remove?" "") | |
1492 nil | |
1493 (setq msg "White space found at end of line."))))) | |
1494 ;; Return an error and leave the cursor at that spot, or restore | |
1495 ;; the cursor. | |
1496 (if msg | |
1497 msg | |
1498 (goto-char p) | |
1499 nil))) | |
1500 | |
1501 ;;; Comment checking engine | |
1502 ;; | |
1503 (eval-when-compile | |
1504 ;; We must load this to: | |
1505 ;; a) get symbols for comple and | |
1506 ;; b) determine if we have lm-history symbol which doesn't always exist | |
1507 (require 'lisp-mnt)) | |
1508 | |
1509 (defun checkdoc-file-comments-engine () | |
1510 "Return a message string if this file does not match the emacs standard. | |
1511 This checks for style only, such as the first line, Commentary:, | |
1512 Code:, and others referenced in the style guide." | |
1513 (if (featurep 'lisp-mnt) | |
1514 nil | |
1515 (require 'lisp-mnt) | |
1516 ;; Old Xemacs don't have `lm-commentary-mark' | |
1517 (if (and (not (fboundp 'lm-commentary-mark)) (boundp 'lm-commentary)) | |
1518 (defalias 'lm-commentary-mark 'lm-commentary))) | |
1519 (save-excursion | |
1520 (let* ((f1 (file-name-nondirectory (buffer-file-name))) | |
1521 (fn (file-name-sans-extension f1)) | |
1522 (fe (substring f1 (length fn)))) | |
1523 (goto-char (point-min)) | |
1524 (or | |
1525 ;; Lisp Maintenance checks first | |
1526 ;; Was: (lm-verify) -> not flexible enough for some people | |
1527 ;; * Summary at the beginning of the file: | |
1528 (if (not (lm-summary)) | |
1529 ;; This certifies as very complex so always ask unless | |
1530 ;; it's set to never | |
1531 (if (and checkdoc-autofix-flag | |
1532 (not (eq checkdoc-autofix-flag 'never)) | |
1533 (y-or-n-p "There is no first line summary! Add one?")) | |
1534 (progn | |
1535 (goto-char (point-min)) | |
1536 (insert ";;; " fn fe " --- " (read-string "Summary: ") "\n")) | |
1537 "The first line should be of the form: \";;; package --- Summary\"") | |
1538 nil) | |
1539 ;; * Commentary Section | |
1540 (if (not (lm-commentary-mark)) | |
1541 "You should have a section marked \";;; Commentary:\"" | |
1542 nil) | |
1543 ;; * History section. Say nothing if there is a file ChangeLog | |
1544 (if (or (file-exists-p "ChangeLog") | |
1545 (let ((fn 'lm-history-mark)) ;bestill byte-compiler | |
1546 (and (fboundp fn) (funcall fn)))) | |
1547 nil | |
1548 "You should have a section marked \";;; History:\" or use a ChangeLog") | |
1549 ;; * Code section | |
1550 (if (not (lm-code-mark)) | |
1551 (let ((cont t)) | |
1552 (goto-char (point-min)) | |
1553 (while (and cont (re-search-forward "^(" nil t)) | |
1554 (setq cont (looking-at "require\\s-+"))) | |
1555 (if (and (not cont) | |
1556 checkdoc-autofix-flag | |
1557 (not (eq checkdoc-autofix-flag 'never)) | |
1558 (y-or-n-p "There is no ;;; Code: marker. Insert one? ")) | |
1559 (progn (beginning-of-line) | |
1560 (insert ";;; Code:\n") | |
1561 nil) | |
1562 "You should have a section marked \";;; Code:\"")) | |
1563 nil) | |
1564 ;; * A footer. Not compartamentalized from lm-verify: too bad. | |
1565 ;; The following is partially clipped from lm-verify | |
1566 (save-excursion | |
1567 (goto-char (point-max)) | |
1568 (if (not (re-search-backward | |
1569 (concat "^;;;[ \t]+" fn "\\(" (regexp-quote fe) | |
1570 "\\)?[ \t]+ends here[ \t]*$" | |
1571 "\\|^;;;[ \t]+ End of file[ \t]+" | |
1572 fn "\\(" (regexp-quote fe) "\\)?") | |
1573 nil t)) | |
1574 (if (and checkdoc-autofix-flag | |
1575 (not (eq checkdoc-autofix-flag 'never)) | |
1576 (y-or-n-p "No identifiable footer! Add one?")) | |
1577 (progn | |
1578 (goto-char (point-max)) | |
1579 (insert "\n(provide '" fn ")\n;;; " fn fe " ends here\n")) | |
1580 (format "The footer should be (provide '%s)\\n;;; %s%s ends here" | |
1581 fn fn fe)))) | |
1582 ;; Ok, now lets look for multiple occurances of ;;;, and offer | |
1583 ;; to remove the extra ";" if applicable. This pre-supposes | |
1584 ;; that the user has semiautomatic fixing on to be useful. | |
1585 | |
1586 ;; In the info node (elisp)Library Headers a header is three ; | |
1587 ;; (the header) followed by text of only two ; | |
1588 ;; In (elisp)Comment Tips, however it says this: | |
1589 ;; * Another use for triple-semicolon comments is for commenting out | |
1590 ;; lines within a function. We use triple-semicolons for this | |
1591 ;; precisely so that they remain at the left margin. | |
1592 (let ((msg nil)) | |
1593 (goto-char (point-min)) | |
1594 (while (and checkdoc-tripple-semi-comment-check-flag | |
1595 (not msg) (re-search-forward "^;;;[^;]" nil t)) | |
1596 ;; We found a triple, lets check all following lines. | |
1597 (if (not (bolp)) (progn (beginning-of-line) (forward-line 1))) | |
1598 (let ((complex-replace t)) | |
1599 (while (looking-at ";;\\(;\\)[^;]") | |
1600 (if (and (checkdoc-outside-major-sexp) ;in code is ok. | |
1601 (checkdoc-autofix-ask-replace | |
1602 (match-beginning 1) (match-end 1) | |
1603 "Multiple occurances of ;;; found. Use ;; instead?" "" | |
1604 complex-replace)) | |
1605 ;; Learn that, yea, the user did want to do this a | |
1606 ;; whole bunch of times. | |
1607 (setq complex-replace nil)) | |
1608 (beginning-of-line) | |
1609 (forward-line 1))))) | |
1610 ;; Lets spellcheck the commentary section. This is the only | |
1611 ;; section that is easy to pick out, and it is also the most | |
1612 ;; visible section (with the finder) | |
1613 (save-excursion | |
1614 (goto-char (lm-commentary-mark)) | |
1615 ;; Spellcheck between the commentary, and the first | |
1616 ;; non-comment line. We could use lm-commentary, but that | |
1617 ;; returns a string, and ispell wants to talk to a buffer. | |
1618 ;; Since the comments talk about lisp, use the specialized | |
1619 ;; spell-checker we also used for doc-strings. | |
1620 (checkdoc-ispell-docstring-engine (save-excursion | |
1621 (re-search-forward "^[^;]" nil t) | |
1622 (point)))) | |
1623 ;;; test comment out code | |
1624 ;;; (foo 1 3) | |
1625 ;;; (bar 5 7) | |
1626 ;; Generic Full-file checks (should be comment related) | |
1627 (checkdoc-run-hooks 'checkdoc-comment-style-hooks) | |
1628 ;; Done with full file comment checks | |
1629 )))) | |
1630 | |
1631 (defun checkdoc-outside-major-sexp () | |
1632 "Return t if point is outside the bounds of a valid sexp." | |
1633 (save-match-data | |
1634 (save-excursion | |
1635 (let ((p (point))) | |
1636 (or (progn (beginning-of-defun) (bobp)) | |
1637 (progn (end-of-defun) (< (point) p))))))) | |
1638 | |
1639 ;;; Auto-fix helper functions | |
1640 ;; | |
1641 (defun checkdoc-autofix-ask-replace (start end question replacewith | |
1642 &optional complex) | |
1643 "Highlight between START and END and queries the user with QUESTION. | |
1644 If the user says yes, or if `checkdoc-autofix-flag' permits, replace | |
1645 the region marked by START and END with REPLACEWITH. If optional flag | |
1646 COMPLEX is non-nil, then we may ask the user a question. See the | |
1647 documentation for `checkdoc-autofix-flag' for details. | |
1648 | |
1649 If a section is auto-replaced without asking the user, this function | |
1650 will pause near the fixed code so the user will briefly see what | |
1651 happened. | |
1652 | |
1653 This function returns non-nil if the text was replaced." | |
1654 (if checkdoc-autofix-flag | |
1655 (let ((o (checkdoc-make-overlay start end)) | |
1656 (ret nil)) | |
1657 (unwind-protect | |
1658 (progn | |
1659 (checkdoc-overlay-put o 'face 'highlight) | |
1660 (if (or (eq checkdoc-autofix-flag 'automatic) | |
1661 (and (eq checkdoc-autofix-flag 'semiautomatic) | |
1662 (not complex)) | |
1663 (and (or (eq checkdoc-autofix-flag 'query) complex) | |
1664 (y-or-n-p question))) | |
1665 (save-excursion | |
1666 (goto-char start) | |
1667 ;; On the off chance this is automatic, display | |
1668 ;; the question anyway so the user knows whats | |
1669 ;; going on. | |
1670 (if checkdoc-bouncy-flag (message "%s -> done" question)) | |
1671 (delete-region start end) | |
1672 (insert replacewith) | |
1673 (if checkdoc-bouncy-flag (sit-for 0)) | |
1674 (setq ret t))) | |
1675 (checkdoc-delete-overlay o)) | |
1676 (checkdoc-delete-overlay o)) | |
1677 ret))) | |
1678 | |
1679 ;;; Warning management | |
1680 ;; | |
1681 (defvar checkdoc-output-font-lock-keywords | |
1682 '(("\\(\\w+\\.el\\):" 1 font-lock-function-name-face) | |
1683 ("style check: \\(\\w+\\)" 1 font-lock-comment-face) | |
20953
f3f9df46d008
Changed font-lock-reference-face to font-lock-constant-face.
Simon Marshall <simon@gnu.org>
parents:
20603
diff
changeset
|
1684 ("^\\([0-9]+\\):" 1 font-lock-constant-face)) |
20085 | 1685 "Keywords used to highlight a checkdoc diagnostic buffer.") |
1686 | |
1687 (defvar checkdoc-output-mode-map nil | |
1688 "Keymap used in `checkdoc-output-mode'.") | |
1689 | |
1690 (if checkdoc-output-mode-map | |
1691 nil | |
1692 (setq checkdoc-output-mode-map (make-sparse-keymap)) | |
1693 (if (not (string-match "XEmacs" emacs-version)) | |
1694 (define-key checkdoc-output-mode-map [mouse-2] | |
1695 'checkdoc-find-error-mouse)) | |
1696 (define-key checkdoc-output-mode-map "\C-c\C-c" 'checkdoc-find-error) | |
1697 (define-key checkdoc-output-mode-map "\C-m" 'checkdoc-find-error)) | |
1698 | |
1699 (defun checkdoc-output-mode () | |
1700 "Create and setup the buffer used to maintain checkdoc warnings. | |
1701 \\<checkdoc-output-mode-map>\\[checkdoc-find-error] - Go to this error location | |
1702 \\[checkdoc-find-error-mouse] - Goto the error clicked on." | |
1703 (if (get-buffer checkdoc-diagnostic-buffer) | |
1704 (get-buffer checkdoc-diagnostic-buffer) | |
1705 (save-excursion | |
1706 (set-buffer (get-buffer-create checkdoc-diagnostic-buffer)) | |
1707 (kill-all-local-variables) | |
1708 (setq mode-name "Checkdoc" | |
1709 major-mode 'checkdoc-output-mode) | |
1710 (set (make-local-variable 'font-lock-defaults) | |
1711 '((checkdoc-output-font-lock-keywords) t t ((?- . "w") (?_ . "w")))) | |
1712 (use-local-map checkdoc-output-mode-map) | |
1713 (run-hooks 'checkdoc-output-mode-hook) | |
1714 (current-buffer)))) | |
1715 | |
1716 (defun checkdoc-find-error-mouse (e) | |
1717 ;; checkdoc-params: (e) | |
1718 "Call `checkdoc-find-error' where the user clicks the mouse." | |
1719 (interactive "e") | |
1720 (mouse-set-point e) | |
1721 (checkdoc-find-error)) | |
1722 | |
1723 (defun checkdoc-find-error () | |
1724 "In a checkdoc diagnostic buffer, find the error under point." | |
1725 (interactive) | |
1726 (beginning-of-line) | |
1727 (if (looking-at "[0-9]+") | |
1728 (let ((l (string-to-int (match-string 0))) | |
1729 (f (save-excursion | |
1730 (re-search-backward " \\(\\(\\w+\\|\\s_\\)+\\.el\\):") | |
1731 (match-string 1)))) | |
1732 (if (not (get-buffer f)) | |
1733 (error "Can't find buffer %s" f)) | |
1734 (switch-to-buffer-other-window (get-buffer f)) | |
1735 (goto-line l)))) | |
1736 | |
1737 (defun checkdoc-start-section (check-type) | |
1738 "Initialize the checkdoc diagnostic buffer for a pass. | |
1739 Create the header so that the string CHECK-TYPE is displayed as the | |
1740 function called to create the messages." | |
1741 (checkdoc-output-to-error-buffer | |
1742 "\n\n*** " (current-time-string) " " | |
1743 (file-name-nondirectory (buffer-file-name)) ": style check: " check-type | |
1744 " V " checkdoc-version)) | |
1745 | |
1746 (defun checkdoc-error (point msg) | |
1747 "Store POINT and MSG as errors in the checkdoc diagnostic buffer." | |
1748 (checkdoc-output-to-error-buffer | |
1749 "\n" (int-to-string (count-lines (point-min) (or point 1))) ": " | |
1750 msg)) | |
1751 | |
1752 (defun checkdoc-output-to-error-buffer (&rest text) | |
1753 "Place TEXT into the checkdoc diagnostic buffer." | |
1754 (save-excursion | |
1755 (set-buffer (checkdoc-output-mode)) | |
1756 (goto-char (point-max)) | |
1757 (apply 'insert text))) | |
1758 | |
1759 (defun checkdoc-show-diagnostics () | |
1760 "Display the checkdoc diagnostic buffer in a temporary window." | |
1761 (let ((b (get-buffer checkdoc-diagnostic-buffer))) | |
1762 (if b (progn (pop-to-buffer b) | |
1763 (beginning-of-line))) | |
1764 (other-window -1) | |
1765 (shrink-window-if-larger-than-buffer))) | |
1766 | |
1767 (defgroup checkdoc nil | |
1768 "Support for doc-string checking in emacs lisp." | |
1769 :prefix "checkdoc" | |
21651
86fcccceba7b
*** empty log message ***
Dan Nicolaescu <done@ece.arizona.edu>
parents:
21181
diff
changeset
|
1770 :group 'lisp |
86fcccceba7b
*** empty log message ***
Dan Nicolaescu <done@ece.arizona.edu>
parents:
21181
diff
changeset
|
1771 :version "20.3") |
20085 | 1772 |
1773 (custom-add-option 'emacs-lisp-mode-hook | |
1774 (lambda () (checkdoc-minor-mode 1))) | |
1775 | |
1776 (provide 'checkdoc) | |
1777 ;;; checkdoc.el ends here |