Commit | Line | Data |
---|---|---|
5b531322 KH |
1 | ;;; checkdoc --- Check documentation strings for style requirements |
2 | ||
0a0a3dee | 3 | ;;; Copyright (C) 1997, 1998 Free Software Foundation |
04f3f5a2 | 4 | |
0a0a3dee | 5 | ;; Author: Eric M. Ludlam <zappo@gnu.org> |
04f3f5a2 | 6 | ;; Version: 0.4.3 |
5b531322 | 7 | ;; Keywords: docs, maint, lisp |
04f3f5a2 | 8 | |
5b531322 | 9 | ;; This file is part of GNU Emacs. |
04f3f5a2 | 10 | |
5b531322 KH |
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. | |
04f3f5a2 | 15 | |
5b531322 KH |
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. | |
04f3f5a2 | 20 | |
5b531322 KH |
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 | ;; | |
0a0a3dee EL |
77 | ;; Checking parameters |
78 | ;; | |
79 | ;; You might not always want a function to have it's parameters listed | |
80 | ;; in order. When this is the case, put the following comment just in | |
81 | ;; front of the documentation string: "; checkdoc-order: nil" This | |
82 | ;; overrides the value of `checkdoc-arguments-in-order-flag'. | |
83 | ;; | |
84 | ;; If you specifically wish to avoid mentioning a parameter of a | |
85 | ;; function in the doc string (such as a hidden parameter, or a | |
86 | ;; parameter which is very obvious like events), you can have checkdoc | |
87 | ;; skip looking for it by putting the following comment just in front | |
88 | ;; of the documentation string: "; checkdoc-params: (args go here)" | |
89 | ;; | |
5b531322 KH |
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 . | |
0a0a3dee EL |
169 | ;; 0.4.2 Added some more comments in the commentary. |
170 | ;; You can now `quote' symbols that look like keystrokes | |
171 | ;; When spell checking, meta variables can end in `th' or `s'. | |
04f3f5a2 EL |
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. | |
5b531322 KH |
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: | |
04f3f5a2 | 189 | (defvar checkdoc-version "0.4.3" |
5b531322 KH |
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) | |
0a0a3dee | 204 | (defmacro defcustom (var value doc &rest args) |
5b531322 KH |
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*" | |
0a0a3dee | 301 | "Name of warning message buffer.") |
5b531322 KH |
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)) | |
04f3f5a2 EL |
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)))))) | |
5b531322 KH |
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)) | |
04f3f5a2 | 1124 | (re "[^`A-Za-z0-9_]\\([CMA]-[a-zA-Z]\\|\\(\\([CMA]-\\)?\ |
5b531322 KH |
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 | |
0a0a3dee EL |
1442 | ;; All caps w/ option th, or s tacked on the end |
1443 | ;; for pluralization or nuberthness. | |
1444 | (string-match "^[A-Z][A-Z]+\\(s\\|th\\)?$" word) | |
5b531322 KH |
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) | |
883212ce | 1684 | ("^\\([0-9]+\\):" 1 font-lock-constant-face)) |
5b531322 KH |
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" | |
1770 | :group 'lisp) | |
1771 | ||
1772 | (custom-add-option 'emacs-lisp-mode-hook | |
1773 | (lambda () (checkdoc-minor-mode 1))) | |
1774 | ||
1775 | (provide 'checkdoc) | |
1776 | ;;; checkdoc.el ends here |