Commit | Line | Data |
---|---|---|
e8af40ee | 1 | ;;; checkdoc.el --- check documentation strings for style requirements |
5b531322 | 2 | |
3731a850 | 3 | ;; Copyright (C) 1997, 1998, 2001, 2002, 2003, 2004, |
114f9c96 | 4 | ;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. |
04f3f5a2 | 5 | |
0a0a3dee | 6 | ;; Author: Eric M. Ludlam <zappo@gnu.org> |
84f473b0 | 7 | ;; Version: 0.6.2 |
5b531322 | 8 | ;; Keywords: docs, maint, lisp |
04f3f5a2 | 9 | |
5b531322 | 10 | ;; This file is part of GNU Emacs. |
04f3f5a2 | 11 | |
d6cba7ae | 12 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
5b531322 | 13 | ;; it under the terms of the GNU General Public License as published by |
d6cba7ae GM |
14 | ;; the Free Software Foundation, either version 3 of the License, or |
15 | ;; (at your option) any later version. | |
04f3f5a2 | 16 | |
5b531322 KH |
17 | ;; GNU Emacs is distributed in the hope that it will be useful, |
18 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
19 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
20 | ;; GNU General Public License for more details. | |
04f3f5a2 | 21 | |
5b531322 | 22 | ;; You should have received a copy of the GNU General Public License |
d6cba7ae | 23 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
5b531322 KH |
24 | |
25 | ;;; Commentary: | |
26 | ;; | |
5fecb21a | 27 | ;; The Emacs Lisp manual has a nice chapter on how to write |
5b531322 KH |
28 | ;; documentation strings. Many stylistic suggestions are fairly |
29 | ;; deterministic and easy to check for syntactically, but also easy | |
30 | ;; to forget. The main checkdoc engine will perform the stylistic | |
31 | ;; checks needed to make sure these styles are remembered. | |
32 | ;; | |
33 | ;; There are two ways to use checkdoc: | |
bca0d607 EL |
34 | ;; 1) Periodically use `checkdoc' or `checkdoc-current-buffer'. |
35 | ;; `checkdoc' is a more interactive version of | |
36 | ;; `checkdoc-current-buffer' | |
5b531322 | 37 | ;; 2) Use `checkdoc-minor-mode' to automatically check your |
5fecb21a | 38 | ;; documentation whenever you evaluate Lisp code with C-M-x |
5b531322 KH |
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 | ;; | |
bca0d607 EL |
45 | ;; Using `checkdoc': |
46 | ;; | |
47 | ;; The commands `checkdoc' and `checkdoc-ispell' are the top-level | |
48 | ;; entry points to all of the different checks that are available. It | |
49 | ;; breaks examination of your Lisp file into four sections (comments, | |
50 | ;; documentation, messages, and spacing) and indicates its current | |
51 | ;; state in a status buffer. | |
52 | ;; | |
53 | ;; The Comments check examines your headers, footers, and | |
54 | ;; various tags (such as "Code:") to make sure that your code is ready | |
55 | ;; for easy integration into existing systems. | |
56 | ;; | |
57 | ;; The Documentation check deals with documentation strings | |
58 | ;; and their elements that help make Emacs easier to use. | |
59 | ;; | |
60 | ;; The Messages check ensures that the strings displayed in the | |
61 | ;; minibuffer by some commands (such as `error' and `y-or-n-p') | |
62 | ;; are consistent with the Emacs environment. | |
63 | ;; | |
64 | ;; The Spacing check cleans up white-space at the end of lines. | |
65 | ;; | |
66 | ;; The interface while working with documentation and messages is | |
67 | ;; slightly different when being run in the interactive mode. The | |
68 | ;; interface offers several options, including the ability to skip to | |
69 | ;; the next error, or back up to previous errors. Auto-fixing is | |
70 | ;; turned off at this stage, but you can use the `f' or `F' key to fix | |
71 | ;; a given error (if the fix is available.) | |
72 | ;; | |
5b531322 KH |
73 | ;; Auto-fixing: |
74 | ;; | |
75 | ;; There are four classifications of style errors in terms of how | |
76 | ;; easy they are to fix. They are simple, complex, really complex, | |
77 | ;; and impossible. (Impossible really means that checkdoc does not | |
78 | ;; have a fixing routine yet.) Typically white-space errors are | |
79 | ;; classified as simple, and are auto-fixed by default. Typographic | |
80 | ;; changes are considered complex, and the user is asked if they want | |
81 | ;; the problem fixed before checkdoc makes the change. These changes | |
82 | ;; can be done without asking if `checkdoc-autofix-flag' is properly | |
83 | ;; set. Potentially redundant changes are considered really complex, | |
84 | ;; and the user is always asked before a change is inserted. The | |
85 | ;; variable `checkdoc-autofix-flag' controls how these types of errors | |
86 | ;; are fixed. | |
87 | ;; | |
bca0d607 | 88 | ;; Spell checking text: |
5b531322 KH |
89 | ;; |
90 | ;; The variable `checkdoc-spellcheck-documentation-flag' can be set | |
91 | ;; to customize how spell checking is to be done. Since spell | |
92 | ;; checking can be quite slow, you can optimize how best you want your | |
84003f38 | 93 | ;; checking done. The default is `defun', which spell checks each time |
5b531322 KH |
94 | ;; `checkdoc-defun' or `checkdoc-eval-defun' is used. Setting to nil |
95 | ;; prevents spell checking during normal usage. | |
96 | ;; Setting this variable to nil does not mean you cannot take | |
97 | ;; advantage of the spell checking. You can instead use the | |
98 | ;; interactive functions `checkdoc-ispell-*' to check the spelling of | |
99 | ;; your documentation. | |
5fecb21a RS |
100 | ;; There is a list of Lisp-specific words which checkdoc will |
101 | ;; install into Ispell on the fly, but only if Ispell is not already | |
5b531322 KH |
102 | ;; running. Use `ispell-kill-ispell' to make checkdoc restart it with |
103 | ;; these words enabled. | |
104 | ;; | |
bca0d607 | 105 | ;; Checking parameters: |
0a0a3dee | 106 | ;; |
6deb1543 | 107 | ;; You might not always want a function to have its parameters listed |
0a0a3dee EL |
108 | ;; in order. When this is the case, put the following comment just in |
109 | ;; front of the documentation string: "; checkdoc-order: nil" This | |
110 | ;; overrides the value of `checkdoc-arguments-in-order-flag'. | |
111 | ;; | |
112 | ;; If you specifically wish to avoid mentioning a parameter of a | |
113 | ;; function in the doc string (such as a hidden parameter, or a | |
114 | ;; parameter which is very obvious like events), you can have checkdoc | |
115 | ;; skip looking for it by putting the following comment just in front | |
116 | ;; of the documentation string: "; checkdoc-params: (args go here)" | |
117 | ;; | |
bca0d607 | 118 | ;; Checking message strings: |
a4370a77 | 119 | ;; |
bca0d607 | 120 | ;; The text that follows the `error' and `y-or-n-p' commands is |
a4370a77 EL |
121 | ;; also checked. The documentation for `error' clearly states some |
122 | ;; simple style rules to follow which checkdoc will auto-fix for you. | |
123 | ;; `y-or-n-p' also states that it should end in a space. I added that | |
124 | ;; it should end in "? " since that is almost always used. | |
125 | ;; | |
5b531322 KH |
126 | ;; Adding your own checks: |
127 | ;; | |
128 | ;; You can experiment with adding your own checks by setting the | |
129 | ;; hooks `checkdoc-style-hooks' and `checkdoc-comment-style-hooks'. | |
130 | ;; Return a string which is the error you wish to report. The cursor | |
131 | ;; position should be preserved. | |
132 | ;; | |
bca0d607 EL |
133 | ;; Error errors: |
134 | ;; | |
135 | ;; Checkdoc does not always flag errors correctly. There are a | |
136 | ;; couple ways you can coax your file into passing all of checkdoc's | |
137 | ;; tests through buffer local variables. | |
138 | ;; | |
139 | ;; The variable `checkdoc-verb-check-experimental-flag' can be used | |
140 | ;; to turn off the check for verb-voice in case you use words that are | |
141 | ;; not semantically verbs, but are still in the incomplete list. | |
142 | ;; | |
143 | ;; The variable `checkdoc-symbol-words' can be a list of words that | |
144 | ;; happen to also be symbols. This is not a problem for one-word | |
145 | ;; symbols, but if you use a hyphenated word that is also a symbol, | |
146 | ;; then you may need this. | |
147 | ;; | |
148 | ;; The symbol `checkdoc-force-docstrings-flag' can be set to nil if | |
149 | ;; you have many undocumented functions you don't wish to document. | |
150 | ;; | |
151 | ;; See the above section "Checking Parameters" for details about | |
152 | ;; parameter checking. | |
153 | ;; | |
154 | ;; Dependencies: | |
155 | ;; | |
156 | ;; This file requires lisp-mnt (Lisp maintenance routines) for the | |
157 | ;; comment checkers. | |
158 | ;; | |
159 | ;; Requires custom for Emacs v20. | |
5b531322 KH |
160 | |
161 | ;;; TO DO: | |
bca0d607 | 162 | ;; Hook into the byte compiler on a defun/defvar level to generate |
5b531322 KH |
163 | ;; warnings in the byte-compiler's warning/error buffer. |
164 | ;; Better ways to override more typical `eval' functions. Advice | |
165 | ;; might be good but hard to turn on/off as a minor mode. | |
166 | ;; | |
167 | ;;; Maybe Do: | |
168 | ;; Code sweep checks for "forbidden functions", proper use of hooks, | |
169 | ;; proper keybindings, and other items from the manual that are | |
170 | ;; not specifically docstring related. Would this even be useful? | |
171 | ||
172 | ;;; Code: | |
bca0d607 | 173 | (defvar checkdoc-version "0.6.1" |
5b531322 KH |
174 | "Release version of checkdoc you are currently running.") |
175 | ||
849f465a KR |
176 | (require 'help-mode) ;; for help-xref-info-regexp |
177 | (require 'thingatpt) ;; for handy thing-at-point-looking-at | |
178 | ||
6d74f782 JB |
179 | (defvar compilation-error-regexp-alist) |
180 | (defvar compilation-mode-font-lock-keywords) | |
181 | ||
76667462 SM |
182 | (defgroup checkdoc nil |
183 | "Support for doc string checking in Emacs Lisp." | |
184 | :prefix "checkdoc" | |
185 | :group 'lisp | |
186 | :version "20.3") | |
187 | ||
b92317dc | 188 | (defcustom checkdoc-minor-mode-string " CDoc" |
cb711556 | 189 | "String to display in mode line when Checkdoc mode is enabled; nil for none." |
b92317dc GM |
190 | :type '(choice string (const :tag "None" nil)) |
191 | :group 'checkdoc | |
192 | :version "23.1") | |
193 | ||
5b531322 | 194 | (defcustom checkdoc-autofix-flag 'semiautomatic |
76667462 | 195 | "Non-nil means attempt auto-fixing of doc strings. |
5fecb21a RS |
196 | If this value is the symbol `query', then the user is queried before |
197 | any change is made. If the value is `automatic', then all changes are | |
5b531322 | 198 | made without asking unless the change is very-complex. If the value |
bca0d607 | 199 | is `semiautomatic' or any other value, then simple fixes are made |
5b531322 | 200 | without asking, and complex changes are made by asking the user first. |
5fecb21a | 201 | The value `never' is the same as nil, never ask or change anything." |
5b531322 KH |
202 | :group 'checkdoc |
203 | :type '(choice (const automatic) | |
5b531322 | 204 | (const query) |
59c9da9d AS |
205 | (const never) |
206 | (other :tag "semiautomatic" semiautomatic))) | |
5b531322 KH |
207 | |
208 | (defcustom checkdoc-bouncy-flag t | |
76667462 | 209 | "Non-nil means to \"bounce\" to auto-fix locations. |
5b531322 KH |
210 | Setting this to nil will silently make fixes that require no user |
211 | interaction. See `checkdoc-autofix-flag' for auto-fixing details." | |
212 | :group 'checkdoc | |
213 | :type 'boolean) | |
214 | ||
215 | (defcustom checkdoc-force-docstrings-flag t | |
76667462 | 216 | "Non-nil means that all checkable definitions should have documentation. |
5b531322 | 217 | Style guide dictates that interactive functions MUST have documentation, |
bca0d607 | 218 | and that it's good but not required practice to make non user visible items |
5fecb21a | 219 | have doc strings." |
5b531322 KH |
220 | :group 'checkdoc |
221 | :type 'boolean) | |
2d5a3812 | 222 | ;;;###autoload(put 'checkdoc-force-docstrings-flag 'safe-local-variable 'booleanp) |
5b531322 | 223 | |
5fe443de | 224 | (defcustom checkdoc-force-history-flag nil |
76667462 | 225 | "Non-nil means that files should have a History section or ChangeLog file. |
bca0d607 EL |
226 | This helps document the evolution of, and recent changes to, the package." |
227 | :group 'checkdoc | |
228 | :type 'boolean) | |
9b89e3ee | 229 | ;;;###autoload(put 'checkdoc-force-history-flag 'safe-local-variable 'booleanp) |
bca0d607 EL |
230 | |
231 | (defcustom checkdoc-permit-comma-termination-flag nil | |
76667462 | 232 | "Non-nil means the first line of a docstring may end with a comma. |
bca0d607 EL |
233 | Ordinarily, a full sentence is required. This may be misleading when |
234 | there is a substantial caveat to the one-line description -- the comma | |
235 | should be used when the first part could stand alone as a sentence, but | |
236 | it indicates that a modifying clause follows." | |
237 | :group 'checkdoc | |
238 | :type 'boolean) | |
2d5a3812 | 239 | ;;;###autoload(put 'checkdoc-permit-comma-termination-flag 'safe-local-variable 'booleanp) |
bca0d607 | 240 | |
5b531322 | 241 | (defcustom checkdoc-spellcheck-documentation-flag nil |
76667462 | 242 | "Non-nil means run Ispell on text based on value. |
5fecb21a | 243 | This is automatically set to nil if Ispell does not exist on your |
5b531322 KH |
244 | system. Possible values are: |
245 | ||
5fecb21a RS |
246 | nil - Don't spell-check during basic style checks. |
247 | defun - Spell-check when style checking a single defun | |
bca0d607 EL |
248 | buffer - Spell-check when style checking the whole buffer |
249 | interactive - Spell-check during any interactive check. | |
5fecb21a | 250 | t - Always spell-check" |
5b531322 KH |
251 | :group 'checkdoc |
252 | :type '(choice (const nil) | |
253 | (const defun) | |
254 | (const buffer) | |
255 | (const interactive) | |
256 | (const t))) | |
257 | ||
258 | (defvar checkdoc-ispell-lisp-words | |
314125ec | 259 | '("alist" "emacs" "etags" "keymap" "paren" "regexp" "sexp" "xemacs") |
5fecb21a | 260 | "List of words that are correct when spell-checking Lisp documentation.") |
5b531322 KH |
261 | |
262 | (defcustom checkdoc-max-keyref-before-warn 10 | |
76667462 | 263 | "The number of \\ [command-to-keystroke] tokens allowed in a doc string. |
5b531322 KH |
264 | Any more than this and a warning is generated suggesting that the construct |
265 | \\ {keymap} be used instead." | |
266 | :group 'checkdoc | |
267 | :type 'integer) | |
268 | ||
269 | (defcustom checkdoc-arguments-in-order-flag t | |
76667462 | 270 | "Non-nil means warn if arguments appear out of order. |
5b531322 KH |
271 | Setting this to nil will mean only checking that all the arguments |
272 | appear in the proper form in the documentation, not that they are in | |
273 | the same order as they appear in the argument list. No mention is | |
274 | made in the style guide relating to order." | |
275 | :group 'checkdoc | |
276 | :type 'boolean) | |
9b89e3ee | 277 | ;;;###autoload(put 'checkdoc-arguments-in-order-flag 'safe-local-variable 'booleanp) |
5b531322 KH |
278 | |
279 | (defvar checkdoc-style-hooks nil | |
280 | "Hooks called after the standard style check is completed. | |
281 | All hooks must return nil or a string representing the error found. | |
282 | Useful for adding new user implemented commands. | |
283 | ||
284 | Each hook is called with two parameters, (DEFUNINFO ENDPOINT). | |
285 | DEFUNINFO is the return value of `checkdoc-defun-info'. ENDPOINT is the | |
286 | location of end of the documentation string.") | |
287 | ||
288 | (defvar checkdoc-comment-style-hooks nil | |
289 | "Hooks called after the standard comment style check is completed. | |
290 | Must return nil if no errors are found, or a string describing the | |
291 | problem discovered. This is useful for adding additional checks.") | |
292 | ||
293 | (defvar checkdoc-diagnostic-buffer "*Style Warnings*" | |
0a0a3dee | 294 | "Name of warning message buffer.") |
5b531322 KH |
295 | |
296 | (defvar checkdoc-defun-regexp | |
297 | "^(def\\(un\\|var\\|custom\\|macro\\|const\\|subst\\|advice\\)\ | |
298 | \\s-+\\(\\(\\sw\\|\\s_\\)+\\)[ \t\n]+" | |
299 | "Regular expression used to identify a defun. | |
300 | A search leaves the cursor in front of the parameter list.") | |
301 | ||
302 | (defcustom checkdoc-verb-check-experimental-flag t | |
76667462 | 303 | "Non-nil means to attempt to check the voice of the doc string. |
5b531322 | 304 | This check keys off some words which are commonly misused. See the |
5fecb21a | 305 | variable `checkdoc-common-verbs-wrong-voice' if you wish to add your own." |
5b531322 KH |
306 | :group 'checkdoc |
307 | :type 'boolean) | |
308 | ||
bca0d607 | 309 | (defvar checkdoc-generate-compile-warnings-flag nil |
79796334 | 310 | "Non-nil means generate warnings in a buffer for browsing. |
bca0d607 EL |
311 | Do not set this by hand, use a function like `checkdoc-current-buffer' |
312 | with a universal argument.") | |
313 | ||
314 | (defcustom checkdoc-symbol-words nil | |
9b89e3ee GM |
315 | "A list of symbol names (strings) which also happen to make good words. |
316 | These words are ignored when unquoted symbols are searched for. | |
bca0d607 EL |
317 | This should be set in an Emacs Lisp file's local variables." |
318 | :group 'checkdoc | |
319 | :type '(repeat (symbol :tag "Word"))) | |
9b89e3ee GM |
320 | ;;;###autoload(put 'checkdoc-symbol-words 'safe-local-variable 'checkdoc-list-of-strings-p) |
321 | ||
322 | ;;;###autoload | |
323 | (defun checkdoc-list-of-strings-p (obj) | |
324 | ;; this is a function so it might be shared by checkdoc-proper-noun-list | |
325 | ;; and/or checkdoc-ispell-lisp-words in the future | |
326 | (and (listp obj) | |
327 | (not (memq nil (mapcar 'stringp obj))))) | |
bca0d607 EL |
328 | |
329 | (defvar checkdoc-proper-noun-list | |
330 | '("ispell" "xemacs" "emacs" "lisp") | |
331 | "List of words (not capitalized) which should be capitalized.") | |
332 | ||
333 | (defvar checkdoc-proper-noun-regexp | |
8bf7ed70 KR |
334 | ;; "[.!?]" is for noun at end of a sentence, since those chars |
335 | ;; are symbol syntax in emacs-lisp-mode and so don't match \\_>. | |
336 | ;; The \" allows it to be the last sentence in a docstring too. | |
f69c67b6 KR |
337 | (concat "\\_<" |
338 | (regexp-opt checkdoc-proper-noun-list t) | |
339 | "\\(\\_>\\|[.!?][ \t\n\"]\\)") | |
bca0d607 EL |
340 | "Regular expression derived from `checkdoc-proper-noun-regexp'.") |
341 | ||
5b531322 KH |
342 | (defvar checkdoc-common-verbs-regexp nil |
343 | "Regular expression derived from `checkdoc-common-verbs-regexp'.") | |
344 | ||
345 | (defvar checkdoc-common-verbs-wrong-voice | |
346 | '(("adds" . "add") | |
347 | ("allows" . "allow") | |
348 | ("appends" . "append") | |
6deb1543 KH |
349 | ("applies" . "apply") |
350 | ("arranges" . "arrange") | |
5b531322 KH |
351 | ("brings" . "bring") |
352 | ("calls" . "call") | |
353 | ("catches" . "catch") | |
354 | ("changes" . "change") | |
355 | ("checks" . "check") | |
356 | ("contains" . "contain") | |
1bd6facc | 357 | ("converts" . "convert") |
5b531322 KH |
358 | ("creates" . "create") |
359 | ("destroys" . "destroy") | |
360 | ("disables" . "disable") | |
361 | ("executes" . "execute") | |
6deb1543 | 362 | ("evals" . "evaluate") |
5b531322 KH |
363 | ("evaluates" . "evaluate") |
364 | ("finds" . "find") | |
365 | ("forces" . "force") | |
366 | ("gathers" . "gather") | |
367 | ("generates" . "generate") | |
368 | ("goes" . "go") | |
369 | ("guesses" . "guess") | |
370 | ("highlights" . "highlight") | |
371 | ("holds" . "hold") | |
372 | ("ignores" . "ignore") | |
373 | ("indents" . "indent") | |
374 | ("initializes" . "initialize") | |
375 | ("inserts" . "insert") | |
376 | ("installs" . "install") | |
377 | ("investigates" . "investigate") | |
378 | ("keeps" . "keep") | |
379 | ("kills" . "kill") | |
380 | ("leaves" . "leave") | |
381 | ("lets" . "let") | |
382 | ("loads" . "load") | |
383 | ("looks" . "look") | |
384 | ("makes" . "make") | |
385 | ("marks" . "mark") | |
386 | ("matches" . "match") | |
995e028a | 387 | ("moves" . "move") |
5b531322 KH |
388 | ("notifies" . "notify") |
389 | ("offers" . "offer") | |
390 | ("parses" . "parse") | |
391 | ("performs" . "perform") | |
392 | ("prepares" . "prepare") | |
393 | ("prepends" . "prepend") | |
394 | ("reads" . "read") | |
395 | ("raises" . "raise") | |
396 | ("removes" . "remove") | |
397 | ("replaces" . "replace") | |
398 | ("resets" . "reset") | |
399 | ("restores" . "restore") | |
400 | ("returns" . "return") | |
401 | ("runs" . "run") | |
402 | ("saves" . "save") | |
403 | ("says" . "say") | |
404 | ("searches" . "search") | |
405 | ("selects" . "select") | |
406 | ("sets" . "set") | |
407 | ("sex" . "s*x") | |
408 | ("shows" . "show") | |
409 | ("signifies" . "signify") | |
410 | ("sorts" . "sort") | |
411 | ("starts" . "start") | |
412 | ("stores" . "store") | |
413 | ("switches" . "switch") | |
414 | ("tells" . "tell") | |
415 | ("tests" . "test") | |
416 | ("toggles" . "toggle") | |
6deb1543 | 417 | ("tries" . "try") |
5b531322 KH |
418 | ("turns" . "turn") |
419 | ("undoes" . "undo") | |
420 | ("unloads" . "unload") | |
421 | ("unmarks" . "unmark") | |
422 | ("updates" . "update") | |
423 | ("uses" . "use") | |
424 | ("yanks" . "yank") | |
425 | ) | |
426 | "Alist of common words in the wrong voice and what should be used instead. | |
427 | Set `checkdoc-verb-check-experimental-flag' to nil to avoid this costly | |
428 | and experimental check. Do not modify this list without setting | |
429 | the value of `checkdoc-common-verbs-regexp' to nil which cause it to | |
430 | be re-created.") | |
431 | ||
432 | (defvar checkdoc-syntax-table nil | |
433 | "Syntax table used by checkdoc in document strings.") | |
434 | ||
435 | (if checkdoc-syntax-table | |
436 | nil | |
437 | (setq checkdoc-syntax-table (copy-syntax-table emacs-lisp-mode-syntax-table)) | |
bca0d607 | 438 | ;; When dealing with syntax in doc strings, make sure that - are encompassed |
5b531322 KH |
439 | ;; in words so we can use cheap \\> to get the end of a symbol, not the |
440 | ;; end of a word in a conglomerate. | |
441 | (modify-syntax-entry ?- "w" checkdoc-syntax-table) | |
442 | ) | |
a1506d29 | 443 | |
5b531322 KH |
444 | |
445 | ;;; Compatibility | |
446 | ;; | |
b372cfa9 RS |
447 | (defalias 'checkdoc-make-overlay |
448 | (if (featurep 'xemacs) 'make-extent 'make-overlay)) | |
449 | (defalias 'checkdoc-overlay-put | |
450 | (if (featurep 'xemacs) 'set-extent-property 'overlay-put)) | |
451 | (defalias 'checkdoc-delete-overlay | |
452 | (if (featurep 'xemacs) 'delete-extent 'delete-overlay)) | |
453 | (defalias 'checkdoc-overlay-start | |
454 | (if (featurep 'xemacs) 'extent-start 'overlay-start)) | |
455 | (defalias 'checkdoc-overlay-end | |
456 | (if (featurep 'xemacs) 'extent-end 'overlay-end)) | |
457 | (defalias 'checkdoc-mode-line-update | |
458 | (if (featurep 'xemacs) 'redraw-modeline 'force-mode-line-update)) | |
459 | (defalias 'checkdoc-char= | |
460 | (if (featurep 'xemacs) 'char= '=)) | |
5b531322 KH |
461 | |
462 | ;;; User level commands | |
463 | ;; | |
464 | ;;;###autoload | |
bca0d607 | 465 | (defun checkdoc () |
79796334 RS |
466 | "Interactively check the entire buffer for style errors. |
467 | The current status of the check will be displayed in a buffer which | |
bca0d607 | 468 | the users will view as each check is completed." |
5b531322 | 469 | (interactive) |
bca0d607 EL |
470 | (let ((status (list "Checking..." "-" "-" "-")) |
471 | (checkdoc-spellcheck-documentation-flag | |
84003f38 RS |
472 | (car (memq checkdoc-spellcheck-documentation-flag |
473 | '(buffer interactive t)))) | |
bca0d607 EL |
474 | ;; if the user set autofix to never, then that breaks the |
475 | ;; obviously requested asking implied by using this function. | |
476 | ;; Set it to paranoia level. | |
477 | (checkdoc-autofix-flag (if (or (not checkdoc-autofix-flag) | |
478 | (eq checkdoc-autofix-flag 'never)) | |
479 | 'query | |
480 | checkdoc-autofix-flag)) | |
481 | tmp) | |
482 | (checkdoc-display-status-buffer status) | |
483 | ;; check the comments | |
484 | (if (not buffer-file-name) | |
485 | (setcar status "Not checked") | |
486 | (if (checkdoc-file-comments-engine) | |
487 | (setcar status "Errors") | |
488 | (setcar status "Ok"))) | |
489 | (setcar (cdr status) "Checking...") | |
490 | (checkdoc-display-status-buffer status) | |
491 | ;; Check the documentation | |
492 | (setq tmp (checkdoc-interactive nil t)) | |
493 | (if tmp | |
494 | (setcar (cdr status) (format "%d Errors" (length tmp))) | |
495 | (setcar (cdr status) "Ok")) | |
496 | (setcar (cdr (cdr status)) "Checking...") | |
497 | (checkdoc-display-status-buffer status) | |
498 | ;; Check the message text | |
499 | (if (setq tmp (checkdoc-message-interactive nil t)) | |
500 | (setcar (cdr (cdr status)) (format "%d Errors" (length tmp))) | |
501 | (setcar (cdr (cdr status)) "Ok")) | |
502 | (setcar (cdr (cdr (cdr status))) "Checking...") | |
503 | (checkdoc-display-status-buffer status) | |
504 | ;; Rogue spacing | |
505 | (if (condition-case nil | |
506 | (checkdoc-rogue-spaces nil t) | |
507 | (error t)) | |
508 | (setcar (cdr (cdr (cdr status))) "Errors") | |
509 | (setcar (cdr (cdr (cdr status))) "Ok")) | |
510 | (checkdoc-display-status-buffer status))) | |
511 | ||
512 | (defun checkdoc-display-status-buffer (check) | |
513 | "Display and update the status buffer for the current checkdoc mode. | |
b08b261e JB |
514 | CHECK is a list of four strings stating the current status of each |
515 | test; the nth string describes the status of the nth test." | |
eb83be8a | 516 | (let (temp-buffer-setup-hook) |
5fe443de | 517 | (with-output-to-temp-buffer "*Checkdoc Status*" |
eb83be8a DL |
518 | (princ-list |
519 | "Buffer comments and tags: " (nth 0 check) "\n" | |
520 | "Documentation style: " (nth 1 check) "\n" | |
521 | "Message/Query text style: " (nth 2 check) "\n" | |
522 | "Unwanted Spaces: " (nth 3 check) | |
523 | ))) | |
bca0d607 | 524 | (shrink-window-if-larger-than-buffer |
5fe443de | 525 | (get-buffer-window "*Checkdoc Status*")) |
bca0d607 EL |
526 | (message nil) |
527 | (sit-for 0)) | |
5b531322 KH |
528 | |
529 | ;;;###autoload | |
bca0d607 EL |
530 | (defun checkdoc-interactive (&optional start-here showstatus) |
531 | "Interactively check the current buffer for doc string errors. | |
532 | Prefix argument START-HERE will start the checking from the current | |
533 | point, otherwise the check starts at the beginning of the current | |
534 | buffer. Allows navigation forward and backwards through document | |
535 | errors. Does not check for comment or space warnings. | |
536 | Optional argument SHOWSTATUS indicates that we should update the | |
537 | checkdoc status window instead of the usual behavior." | |
5b531322 | 538 | (interactive "P") |
5b531322 | 539 | (let ((checkdoc-spellcheck-documentation-flag |
84003f38 RS |
540 | (car (memq checkdoc-spellcheck-documentation-flag |
541 | '(interactive t))))) | |
b08b261e JB |
542 | (prog1 |
543 | ;; Due to a design flaw, this will never spell check | |
544 | ;; docstrings. | |
545 | (checkdoc-interactive-loop start-here showstatus | |
546 | 'checkdoc-next-error) | |
547 | ;; This is a workaround to perform spell checking. | |
548 | (checkdoc-interactive-ispell-loop start-here)))) | |
5b531322 KH |
549 | |
550 | ;;;###autoload | |
bca0d607 EL |
551 | (defun checkdoc-message-interactive (&optional start-here showstatus) |
552 | "Interactively check the current buffer for message string errors. | |
5b531322 KH |
553 | Prefix argument START-HERE will start the checking from the current |
554 | point, otherwise the check starts at the beginning of the current | |
555 | buffer. Allows navigation forward and backwards through document | |
bca0d607 EL |
556 | errors. Does not check for comment or space warnings. |
557 | Optional argument SHOWSTATUS indicates that we should update the | |
558 | checkdoc status window instead of the usual behavior." | |
5b531322 | 559 | (interactive "P") |
bca0d607 | 560 | (let ((checkdoc-spellcheck-documentation-flag |
84003f38 RS |
561 | (car (memq checkdoc-spellcheck-documentation-flag |
562 | '(interactive t))))) | |
b08b261e JB |
563 | (prog1 |
564 | ;; Due to a design flaw, this will never spell check messages. | |
565 | (checkdoc-interactive-loop start-here showstatus | |
566 | 'checkdoc-next-message-error) | |
567 | ;; This is a workaround to perform spell checking. | |
568 | (checkdoc-message-interactive-ispell-loop start-here)))) | |
bca0d607 EL |
569 | |
570 | (defun checkdoc-interactive-loop (start-here showstatus findfunc) | |
79796334 | 571 | "Interactively loop over all errors that can be found by a given method. |
b08b261e JB |
572 | |
573 | If START-HERE is nil, searching starts at the beginning of the current | |
574 | buffer, otherwise searching starts at START-HERE. SHOWSTATUS | |
575 | expresses the verbosity of the search, and whether ending the search | |
576 | will auto-exit this function. | |
577 | ||
bca0d607 | 578 | FINDFUNC is a symbol representing a function that will position the |
110c171f | 579 | cursor, and return error message text to present to the user. It is |
bca0d607 EL |
580 | assumed that the cursor will stop just before a major sexp, which will |
581 | be highlighted to present the user with feedback as to the offending | |
582 | style." | |
5b531322 KH |
583 | ;; Determine where to start the test |
584 | (let* ((begin (prog1 (point) | |
585 | (if (not start-here) (goto-char (point-min))))) | |
586 | ;; Assign a flag to spellcheck flag | |
587 | (checkdoc-spellcheck-documentation-flag | |
84003f38 RS |
588 | (car (memq checkdoc-spellcheck-documentation-flag |
589 | '(buffer interactive t)))) | |
5b531322 | 590 | ;; Fetch the error list |
bca0d607 EL |
591 | (err-list (list (funcall findfunc nil))) |
592 | (cdo nil) | |
593 | (returnme nil) | |
594 | c) | |
595 | (save-window-excursion | |
596 | (if (not (car err-list)) (setq err-list nil)) | |
597 | ;; Include whatever function point is in for good measure. | |
598 | (beginning-of-defun) | |
599 | (while err-list | |
600 | (goto-char (cdr (car err-list))) | |
601 | ;; The cursor should be just in front of the offending doc string | |
602 | (if (stringp (car (car err-list))) | |
603 | (setq cdo (save-excursion (checkdoc-make-overlay | |
604 | (point) (progn (forward-sexp 1) | |
605 | (point))))) | |
606 | (setq cdo (checkdoc-make-overlay | |
607 | (checkdoc-error-start (car (car err-list))) | |
608 | (checkdoc-error-end (car (car err-list)))))) | |
5b531322 KH |
609 | (unwind-protect |
610 | (progn | |
611 | (checkdoc-overlay-put cdo 'face 'highlight) | |
5fecb21a | 612 | ;; Make sure the whole doc string is visible if possible. |
5b531322 | 613 | (sit-for 0) |
d8693181 DL |
614 | (if (and (looking-at "\"") |
615 | (not (pos-visible-in-window-p | |
616 | (save-excursion (forward-sexp 1) (point)) | |
617 | (selected-window)))) | |
618 | (let ((l (count-lines (point) | |
619 | (save-excursion | |
620 | (forward-sexp 1) (point))))) | |
621 | (if (> l (window-height)) | |
622 | (recenter 1) | |
623 | (recenter (/ (- (window-height) l) 2)))) | |
624 | (recenter)) | |
bca0d607 EL |
625 | (message "%s (C-h,%se,n,p,q)" (checkdoc-error-text |
626 | (car (car err-list))) | |
627 | (if (checkdoc-error-unfixable (car (car err-list))) | |
628 | "" "f,")) | |
629 | (save-excursion | |
630 | (goto-char (checkdoc-error-start (car (car err-list)))) | |
631 | (if (not (pos-visible-in-window-p)) | |
632 | (recenter (- (window-height) 2))) | |
b372cfa9 | 633 | (setq c (read-event))) |
5b531322 | 634 | (if (not (integerp c)) (setq c ??)) |
bca0d607 EL |
635 | (cond |
636 | ;; Exit condition | |
637 | ((checkdoc-char= c ?\C-g) (signal 'quit nil)) | |
638 | ;; Request an auto-fix | |
639 | ((or (checkdoc-char= c ?y) (checkdoc-char= c ?f)) | |
640 | (checkdoc-delete-overlay cdo) | |
641 | (setq cdo nil) | |
642 | (goto-char (cdr (car err-list))) | |
643 | ;; `automatic-then-never' tells the autofix function | |
644 | ;; to only allow one fix to be automatic. The autofix | |
b08b261e | 645 | ;; function will then set the flag to 'never, allowing |
bca0d607 EL |
646 | ;; the checker to return a different error. |
647 | (let ((checkdoc-autofix-flag 'automatic-then-never) | |
648 | (fixed nil)) | |
649 | (funcall findfunc t) | |
650 | (setq fixed (not (eq checkdoc-autofix-flag | |
651 | 'automatic-then-never))) | |
652 | (if (not fixed) | |
653 | (progn | |
654 | (message "A Fix was not available.") | |
655 | (sit-for 2)) | |
656 | (setq err-list (cdr err-list)))) | |
657 | (beginning-of-defun) | |
96ef1feb | 658 | (let ((ne (funcall findfunc nil))) |
bca0d607 EL |
659 | (if ne |
660 | (setq err-list (cons ne err-list)) | |
661 | (cond ((not err-list) | |
662 | (message "No More Stylistic Errors.") | |
663 | (sit-for 2)) | |
664 | (t | |
665 | (message | |
666 | "No Additional style errors. Continuing...") | |
667 | (sit-for 2)))))) | |
668 | ;; Move to the next error (if available) | |
6d74f782 | 669 | ((or (checkdoc-char= c ?n) (checkdoc-char= c ?\s)) |
bca0d607 EL |
670 | (let ((ne (funcall findfunc nil))) |
671 | (if (not ne) | |
672 | (if showstatus | |
673 | (setq returnme err-list | |
674 | err-list nil) | |
675 | (if (not err-list) | |
676 | (message "No More Stylistic Errors.") | |
677 | (message "No Additional style errors. Continuing...")) | |
678 | (sit-for 2)) | |
679 | (setq err-list (cons ne err-list))))) | |
680 | ;; Go backwards in the list of errors | |
681 | ((or (checkdoc-char= c ?p) (checkdoc-char= c ?\C-?)) | |
682 | (if (/= (length err-list) 1) | |
683 | (progn | |
684 | (setq err-list (cdr err-list)) | |
685 | (goto-char (cdr (car err-list))) | |
686 | (beginning-of-defun)) | |
687 | (message "No Previous Errors.") | |
688 | (sit-for 2))) | |
689 | ;; Edit the buffer recursively. | |
690 | ((checkdoc-char= c ?e) | |
691 | (checkdoc-recursive-edit | |
692 | (checkdoc-error-text (car (car err-list)))) | |
693 | (checkdoc-delete-overlay cdo) | |
694 | (setq err-list (cdr err-list)) ;back up the error found. | |
695 | (beginning-of-defun) | |
696 | (let ((ne (funcall findfunc nil))) | |
697 | (if (not ne) | |
698 | (if showstatus | |
699 | (setq returnme err-list | |
700 | err-list nil) | |
701 | (message "No More Stylistic Errors.") | |
702 | (sit-for 2)) | |
703 | (setq err-list (cons ne err-list))))) | |
704 | ;; Quit checkdoc | |
705 | ((checkdoc-char= c ?q) | |
706 | (setq returnme err-list | |
707 | err-list nil | |
708 | begin (point))) | |
b08b261e | 709 | ;; Goofy stuff |
bca0d607 EL |
710 | (t |
711 | (if (get-buffer-window "*Checkdoc Help*") | |
712 | (progn | |
713 | (delete-window (get-buffer-window "*Checkdoc Help*")) | |
714 | (kill-buffer "*Checkdoc Help*")) | |
715 | (with-output-to-temp-buffer "*Checkdoc Help*" | |
716 | (princ-list | |
717 | "Checkdoc Keyboard Summary:\n" | |
718 | (if (checkdoc-error-unfixable (car (car err-list))) | |
719 | "" | |
720 | (concat | |
721 | "f, y - auto Fix this warning without asking (if\ | |
722 | available.)\n" | |
723 | " Very complex operations will still query.\n") | |
724 | ) | |
725 | "e - Enter recursive Edit. Press C-M-c to exit.\n" | |
726 | "SPC, n - skip to the Next error.\n" | |
727 | "DEL, p - skip to the Previous error.\n" | |
728 | "q - Quit checkdoc.\n" | |
729 | "C-h - Toggle this help buffer.")) | |
730 | (shrink-window-if-larger-than-buffer | |
731 | (get-buffer-window "*Checkdoc Help*")))))) | |
732 | (if cdo (checkdoc-delete-overlay cdo))))) | |
5b531322 | 733 | (goto-char begin) |
bca0d607 EL |
734 | (if (get-buffer "*Checkdoc Help*") (kill-buffer "*Checkdoc Help*")) |
735 | (message "Checkdoc: Done.") | |
736 | returnme)) | |
5b531322 | 737 | |
b08b261e JB |
738 | (defun checkdoc-interactive-ispell-loop (start-here) |
739 | "Interactively spell check doc strings in the current buffer. | |
740 | If START-HERE is nil, searching starts at the beginning of the current | |
741 | buffer, otherwise searching starts at START-HERE." | |
742 | (when checkdoc-spellcheck-documentation-flag | |
743 | (save-excursion | |
744 | ;; Move point to where we need to start. | |
745 | (if start-here | |
746 | ;; Include whatever function point is in for good measure. | |
747 | (beginning-of-defun) | |
748 | (goto-char (point-min))) | |
749 | ;; Loop over docstrings. | |
750 | (while (checkdoc-next-docstring) | |
751 | (message "Searching for doc string spell error...%d%%" | |
752 | (/ (* 100 (point)) (point-max))) | |
753 | (if (looking-at "\"") | |
754 | (checkdoc-ispell-docstring-engine | |
755 | (save-excursion (forward-sexp 1) (point-marker))))) | |
756 | (message "Checkdoc: Done.")))) | |
757 | ||
758 | (defun checkdoc-message-interactive-ispell-loop (start-here) | |
759 | "Interactively spell check messages in the current buffer. | |
760 | If START-HERE is nil, searching starts at the beginning of the current | |
761 | buffer, otherwise searching starts at START-HERE." | |
762 | (when checkdoc-spellcheck-documentation-flag | |
763 | (save-excursion | |
764 | ;; Move point to where we need to start. | |
765 | (if start-here | |
766 | ;; Include whatever function point is in for good measure. | |
767 | (beginning-of-defun) | |
768 | (goto-char (point-min))) | |
769 | ;; Loop over message strings. | |
770 | (while (checkdoc-message-text-next-string (point-max)) | |
771 | (message "Searching for message string spell error...%d%%" | |
772 | (/ (* 100 (point)) (point-max))) | |
773 | (if (looking-at "\"") | |
774 | (checkdoc-ispell-docstring-engine | |
775 | (save-excursion (forward-sexp 1) (point-marker))))) | |
776 | (message "Checkdoc: Done.")))) | |
777 | ||
778 | ||
bca0d607 | 779 | (defun checkdoc-next-error (enable-fix) |
5b531322 | 780 | "Find and return the next checkdoc error list, or nil. |
bca0d607 | 781 | Only documentation strings are checked. |
b08b261e JB |
782 | An error list is of the form (WARNING . POSITION) where WARNING is the |
783 | warning text, and POSITION is the point in the buffer where the error | |
784 | was found. We can use points and not markers because we promise not | |
785 | to edit the buffer before point without re-executing this check. | |
bca0d607 EL |
786 | Argument ENABLE-FIX will enable auto-fixing while looking for the next |
787 | error. This argument assumes that the cursor is already positioned to | |
788 | perform the fix." | |
789 | (if enable-fix | |
790 | (checkdoc-this-string-valid) | |
791 | (let ((msg nil) (p (point)) | |
792 | (checkdoc-autofix-flag nil)) | |
793 | (condition-case nil | |
794 | (while (and (not msg) (checkdoc-next-docstring)) | |
795 | (message "Searching for doc string error...%d%%" | |
796 | (/ (* 100 (point)) (point-max))) | |
797 | (if (setq msg (checkdoc-this-string-valid)) | |
798 | (setq msg (cons msg (point))))) | |
799 | ;; Quit.. restore position, Other errors, leave alone | |
800 | (quit (goto-char p))) | |
801 | msg))) | |
802 | ||
803 | (defun checkdoc-next-message-error (enable-fix) | |
c13599b6 | 804 | "Find and return the next checkdoc message related error list, or nil. |
bca0d607 EL |
805 | Only text for error and `y-or-n-p' strings are checked. See |
806 | `checkdoc-next-error' for details on the return value. | |
807 | Argument ENABLE-FIX turns on the auto-fix feature. This argument | |
808 | assumes that the cursor is already positioned to perform the fix." | |
809 | (if enable-fix | |
810 | (checkdoc-message-text-engine) | |
811 | (let ((msg nil) (p (point)) (type nil) | |
812 | (checkdoc-autofix-flag nil)) | |
813 | (condition-case nil | |
814 | (while (and (not msg) | |
815 | (setq type | |
816 | (checkdoc-message-text-next-string (point-max)))) | |
817 | (message "Searching for message string error...%d%%" | |
818 | (/ (* 100 (point)) (point-max))) | |
819 | (if (setq msg (checkdoc-message-text-engine type)) | |
820 | (setq msg (cons msg (point))))) | |
821 | ;; Quit.. restore position, Other errors, leave alone | |
822 | (quit (goto-char p))) | |
823 | msg))) | |
824 | ||
825 | (defun checkdoc-recursive-edit (msg) | |
826 | "Enter recursive edit to permit a user to fix some error checkdoc has found. | |
827 | MSG is the error that was found, which is displayed in a help buffer." | |
828 | (with-output-to-temp-buffer "*Checkdoc Help*" | |
829 | (princ-list | |
830 | "Error message:\n " msg | |
831 | "\n\nEdit to fix this problem, and press C-M-c to continue.")) | |
832 | (shrink-window-if-larger-than-buffer | |
833 | (get-buffer-window "*Checkdoc Help*")) | |
834 | (message "When you're done editing press C-M-c to continue.") | |
835 | (unwind-protect | |
836 | (recursive-edit) | |
837 | (if (get-buffer-window "*Checkdoc Help*") | |
838 | (progn | |
839 | (delete-window (get-buffer-window "*Checkdoc Help*")) | |
840 | (kill-buffer "*Checkdoc Help*"))))) | |
841 | ||
842 | ;;;###autoload | |
843 | (defun checkdoc-eval-current-buffer () | |
844 | "Evaluate and check documentation for the current buffer. | |
845 | Evaluation is done first because good documentation for something that | |
846 | doesn't work is just not useful. Comments, doc strings, and rogue | |
847 | spacing are all verified." | |
848 | (interactive) | |
b372cfa9 | 849 | (eval-buffer nil) |
bca0d607 | 850 | (checkdoc-current-buffer t)) |
5b531322 KH |
851 | |
852 | ;;;###autoload | |
bca0d607 EL |
853 | (defun checkdoc-current-buffer (&optional take-notes) |
854 | "Check current buffer for document, comment, error style, and rogue spaces. | |
855 | With a prefix argument (in Lisp, the argument TAKE-NOTES), | |
856 | store all errors found in a warnings buffer, | |
857 | otherwise stop after the first error." | |
858 | (interactive "P") | |
32226619 JB |
859 | (if (called-interactively-p 'interactive) |
860 | (message "Checking buffer for style...")) | |
bca0d607 EL |
861 | ;; Assign a flag to spellcheck flag |
862 | (let ((checkdoc-spellcheck-documentation-flag | |
84003f38 RS |
863 | (car (memq checkdoc-spellcheck-documentation-flag |
864 | '(buffer t)))) | |
bca0d607 EL |
865 | (checkdoc-autofix-flag (if take-notes 'never |
866 | checkdoc-autofix-flag)) | |
867 | (checkdoc-generate-compile-warnings-flag | |
868 | (or take-notes checkdoc-generate-compile-warnings-flag))) | |
869 | (if take-notes | |
870 | (checkdoc-start-section "checkdoc-current-buffer")) | |
871 | ;; every test is responsible for returning the cursor. | |
872 | (or (and buffer-file-name ;; only check comments in a file | |
873 | (checkdoc-comments)) | |
874 | (checkdoc-start) | |
875 | (checkdoc-message-text) | |
876 | (checkdoc-rogue-spaces) | |
32226619 | 877 | (not (called-interactively-p 'interactive)) |
bca0d607 EL |
878 | (if take-notes (checkdoc-show-diagnostics)) |
879 | (message "Checking buffer for style...Done.")))) | |
880 | ||
881 | ;;;###autoload | |
882 | (defun checkdoc-start (&optional take-notes) | |
883 | "Start scanning the current buffer for documentation string style errors. | |
884 | Only documentation strings are checked. | |
885 | Use `checkdoc-continue' to continue checking if an error cannot be fixed. | |
5b531322 KH |
886 | Prefix argument TAKE-NOTES means to collect all the warning messages into |
887 | a separate buffer." | |
888 | (interactive "P") | |
889 | (let ((p (point))) | |
890 | (goto-char (point-min)) | |
32226619 | 891 | (if (and take-notes (called-interactively-p 'interactive)) |
bca0d607 | 892 | (checkdoc-start-section "checkdoc-start")) |
5b531322 KH |
893 | (checkdoc-continue take-notes) |
894 | ;; Go back since we can't be here without success above. | |
895 | (goto-char p) | |
896 | nil)) | |
897 | ||
898 | ;;;###autoload | |
899 | (defun checkdoc-continue (&optional take-notes) | |
bca0d607 | 900 | "Find the next doc string in the current buffer which has a style error. |
5b531322 | 901 | Prefix argument TAKE-NOTES means to continue through the whole buffer and |
bca0d607 EL |
902 | save warnings in a separate buffer. Second optional argument START-POINT |
903 | is the starting location. If this is nil, `point-min' is used instead." | |
5b531322 | 904 | (interactive "P") |
96ef1feb | 905 | (let ((wrong nil) (msg nil) |
5b531322 KH |
906 | ;; Assign a flag to spellcheck flag |
907 | (checkdoc-spellcheck-documentation-flag | |
84003f38 RS |
908 | (car (memq checkdoc-spellcheck-documentation-flag |
909 | '(buffer t)))) | |
bca0d607 EL |
910 | (checkdoc-autofix-flag (if take-notes 'never |
911 | checkdoc-autofix-flag)) | |
912 | (checkdoc-generate-compile-warnings-flag | |
913 | (or take-notes checkdoc-generate-compile-warnings-flag))) | |
5b531322 KH |
914 | (save-excursion |
915 | ;; If we are taking notes, encompass the whole buffer, otherwise | |
916 | ;; the user is navigating down through the buffer. | |
5b531322 | 917 | (while (and (not wrong) (checkdoc-next-docstring)) |
bca0d607 | 918 | ;; OK, let's look at the doc string. |
04f3f5a2 | 919 | (setq msg (checkdoc-this-string-valid)) |
bca0d607 | 920 | (if msg (setq wrong (point))))) |
5b531322 KH |
921 | (if wrong |
922 | (progn | |
923 | (goto-char wrong) | |
bca0d607 | 924 | (if (not take-notes) |
e8592238 | 925 | (error "%s" (checkdoc-error-text msg))))) |
bca0d607 | 926 | (checkdoc-show-diagnostics) |
32226619 | 927 | (if (called-interactively-p 'interactive) |
bca0d607 | 928 | (message "No style warnings.")))) |
5b531322 KH |
929 | |
930 | (defun checkdoc-next-docstring () | |
5fecb21a RS |
931 | "Move to the next doc string after point, and return t. |
932 | Return nil if there are no more doc strings." | |
5b531322 KH |
933 | (if (not (re-search-forward checkdoc-defun-regexp nil t)) |
934 | nil | |
935 | ;; search drops us after the identifier. The next sexp is either | |
936 | ;; the argument list or the value of the variable. skip it. | |
937 | (forward-sexp 1) | |
938 | (skip-chars-forward " \n\t") | |
939 | t)) | |
940 | ||
23b809c2 | 941 | ;;;###autoload |
5b531322 | 942 | (defun checkdoc-comments (&optional take-notes) |
5fecb21a | 943 | "Find missing comment sections in the current Emacs Lisp file. |
5b531322 KH |
944 | Prefix argument TAKE-NOTES non-nil means to save warnings in a |
945 | separate buffer. Otherwise print a message. This returns the error | |
946 | if there is one." | |
947 | (interactive "P") | |
948 | (if take-notes (checkdoc-start-section "checkdoc-comments")) | |
949 | (if (not buffer-file-name) | |
a4370a77 | 950 | (error "Can only check comments for a file buffer")) |
5b531322 | 951 | (let* ((checkdoc-spellcheck-documentation-flag |
84003f38 RS |
952 | (car (memq checkdoc-spellcheck-documentation-flag |
953 | '(buffer t)))) | |
bca0d607 | 954 | (checkdoc-autofix-flag (if take-notes 'never checkdoc-autofix-flag)) |
bca0d607 EL |
955 | (e (checkdoc-file-comments-engine)) |
956 | (checkdoc-generate-compile-warnings-flag | |
957 | (or take-notes checkdoc-generate-compile-warnings-flag))) | |
e8592238 | 958 | (if e (error "%s" (checkdoc-error-text e))) |
bca0d607 | 959 | (checkdoc-show-diagnostics) |
5b531322 KH |
960 | e)) |
961 | ||
962 | ;;;###autoload | |
bca0d607 | 963 | (defun checkdoc-rogue-spaces (&optional take-notes interact) |
5b531322 KH |
964 | "Find extra spaces at the end of lines in the current file. |
965 | Prefix argument TAKE-NOTES non-nil means to save warnings in a | |
966 | separate buffer. Otherwise print a message. This returns the error | |
bca0d607 EL |
967 | if there is one. |
968 | Optional argument INTERACT permits more interactive fixing." | |
5b531322 KH |
969 | (interactive "P") |
970 | (if take-notes (checkdoc-start-section "checkdoc-rogue-spaces")) | |
bca0d607 EL |
971 | (let* ((checkdoc-autofix-flag (if take-notes 'never checkdoc-autofix-flag)) |
972 | (e (checkdoc-rogue-space-check-engine nil nil interact)) | |
973 | (checkdoc-generate-compile-warnings-flag | |
974 | (or take-notes checkdoc-generate-compile-warnings-flag))) | |
32226619 | 975 | (if (not (called-interactively-p 'interactive)) |
5b531322 | 976 | e |
bca0d607 | 977 | (if e |
274f1353 | 978 | (message "%s" (checkdoc-error-text e)) |
bca0d607 EL |
979 | (checkdoc-show-diagnostics) |
980 | (message "Space Check: done."))))) | |
5b531322 | 981 | |
bca0d607 EL |
982 | ;;;###autoload |
983 | (defun checkdoc-message-text (&optional take-notes) | |
984 | "Scan the buffer for occurrences of the error function, and verify text. | |
985 | Optional argument TAKE-NOTES causes all errors to be logged." | |
986 | (interactive "P") | |
987 | (if take-notes (checkdoc-start-section "checkdoc-message-text")) | |
988 | (let* ((p (point)) e | |
989 | (checkdoc-autofix-flag (if take-notes 'never checkdoc-autofix-flag)) | |
990 | (checkdoc-generate-compile-warnings-flag | |
991 | (or take-notes checkdoc-generate-compile-warnings-flag))) | |
992 | (setq e (checkdoc-message-text-search)) | |
32226619 | 993 | (if (not (called-interactively-p 'interactive)) |
bca0d607 EL |
994 | e |
995 | (if e | |
e8592238 | 996 | (error "%s" (checkdoc-error-text e)) |
bca0d607 EL |
997 | (checkdoc-show-diagnostics))) |
998 | (goto-char p)) | |
32226619 JB |
999 | (if (called-interactively-p 'interactive) |
1000 | (message "Checking interactive message text...done."))) | |
a1506d29 | 1001 | |
5b531322 KH |
1002 | ;;;###autoload |
1003 | (defun checkdoc-eval-defun () | |
6deb1543 | 1004 | "Evaluate the current form with `eval-defun' and check its documentation. |
5b531322 KH |
1005 | Evaluation is done first so the form will be read before the |
1006 | documentation is checked. If there is a documentation error, then the display | |
1007 | of what was evaluated will be overwritten by the diagnostic message." | |
1008 | (interactive) | |
2e898692 | 1009 | (call-interactively 'eval-defun) |
5b531322 KH |
1010 | (checkdoc-defun)) |
1011 | ||
1012 | ;;;###autoload | |
1013 | (defun checkdoc-defun (&optional no-error) | |
5fecb21a RS |
1014 | "Examine the doc string of the function or variable under point. |
1015 | Call `error' if the doc string has problems. If NO-ERROR is | |
5b531322 | 1016 | non-nil, then do not call error, but call `message' instead. |
5fecb21a | 1017 | If the doc string passes the test, then check the function for rogue white |
5b531322 KH |
1018 | space at the end of each line." |
1019 | (interactive) | |
1020 | (save-excursion | |
1021 | (beginning-of-defun) | |
1022 | (if (not (looking-at checkdoc-defun-regexp)) | |
1023 | ;; I found this more annoying than useful. | |
1024 | ;;(if (not no-error) | |
bca0d607 | 1025 | ;; (message "Cannot check this sexp's doc string.")) |
5b531322 KH |
1026 | nil |
1027 | ;; search drops us after the identifier. The next sexp is either | |
1028 | ;; the argument list or the value of the variable. skip it. | |
1029 | (goto-char (match-end 0)) | |
1030 | (forward-sexp 1) | |
1031 | (skip-chars-forward " \n\t") | |
1032 | (let* ((checkdoc-spellcheck-documentation-flag | |
84003f38 RS |
1033 | (car (memq checkdoc-spellcheck-documentation-flag |
1034 | '(defun t)))) | |
a4370a77 EL |
1035 | (beg (save-excursion (beginning-of-defun) (point))) |
1036 | (end (save-excursion (end-of-defun) (point))) | |
5b531322 | 1037 | (msg (checkdoc-this-string-valid))) |
bca0d607 | 1038 | (if msg (if no-error |
274f1353 | 1039 | (message "%s" (checkdoc-error-text msg)) |
e8592238 | 1040 | (error "%s" (checkdoc-error-text msg))) |
a4370a77 | 1041 | (setq msg (checkdoc-message-text-search beg end)) |
bca0d607 | 1042 | (if msg (if no-error |
274f1353 | 1043 | (message "%s" (checkdoc-error-text msg)) |
e8592238 | 1044 | (error "%s" (checkdoc-error-text msg))) |
a4370a77 | 1045 | (setq msg (checkdoc-rogue-space-check-engine beg end)) |
bca0d607 | 1046 | (if msg (if no-error |
274f1353 | 1047 | (message "%s" (checkdoc-error-text msg)) |
e8592238 | 1048 | (error "%s" (checkdoc-error-text msg)))))) |
32226619 JB |
1049 | (if (called-interactively-p 'interactive) |
1050 | (message "Checkdoc: done.")))))) | |
5b531322 KH |
1051 | |
1052 | ;;; Ispell interface for forcing a spell check | |
1053 | ;; | |
1054 | ||
bca0d607 EL |
1055 | ;;;###autoload |
1056 | (defun checkdoc-ispell (&optional take-notes) | |
1057 | "Check the style and spelling of everything interactively. | |
1058 | Calls `checkdoc' with spell-checking turned on. | |
1059 | Prefix argument TAKE-NOTES is the same as for `checkdoc'" | |
1060 | (interactive) | |
1061 | (let ((checkdoc-spellcheck-documentation-flag t)) | |
1062 | (call-interactively 'checkdoc nil current-prefix-arg))) | |
1063 | ||
5b531322 KH |
1064 | ;;;###autoload |
1065 | (defun checkdoc-ispell-current-buffer (&optional take-notes) | |
bca0d607 | 1066 | "Check the style and spelling of the current buffer. |
5b531322 KH |
1067 | Calls `checkdoc-current-buffer' with spell-checking turned on. |
1068 | Prefix argument TAKE-NOTES is the same as for `checkdoc-current-buffer'" | |
1069 | (interactive) | |
1070 | (let ((checkdoc-spellcheck-documentation-flag t)) | |
1071 | (call-interactively 'checkdoc-current-buffer nil current-prefix-arg))) | |
1072 | ||
1073 | ;;;###autoload | |
1074 | (defun checkdoc-ispell-interactive (&optional take-notes) | |
1075 | "Check the style and spelling of the current buffer interactively. | |
1076 | Calls `checkdoc-interactive' with spell-checking turned on. | |
bca0d607 | 1077 | Prefix argument TAKE-NOTES is the same as for `checkdoc-interactive'" |
5b531322 KH |
1078 | (interactive) |
1079 | (let ((checkdoc-spellcheck-documentation-flag t)) | |
1080 | (call-interactively 'checkdoc-interactive nil current-prefix-arg))) | |
1081 | ||
1082 | ;;;###autoload | |
bca0d607 EL |
1083 | (defun checkdoc-ispell-message-interactive (&optional take-notes) |
1084 | "Check the style and spelling of message text interactively. | |
1085 | Calls `checkdoc-message-interactive' with spell-checking turned on. | |
1086 | Prefix argument TAKE-NOTES is the same as for `checkdoc-message-interactive'" | |
1087 | (interactive) | |
1088 | (let ((checkdoc-spellcheck-documentation-flag t)) | |
1089 | (call-interactively 'checkdoc-message-interactive nil current-prefix-arg))) | |
1090 | ||
1091 | ;;;###autoload | |
1092 | (defun checkdoc-ispell-message-text (&optional take-notes) | |
1093 | "Check the style and spelling of message text interactively. | |
1094 | Calls `checkdoc-message-text' with spell-checking turned on. | |
1095 | Prefix argument TAKE-NOTES is the same as for `checkdoc-message-text'" | |
1096 | (interactive) | |
1097 | (let ((checkdoc-spellcheck-documentation-flag t)) | |
1098 | (call-interactively 'checkdoc-message-text nil current-prefix-arg))) | |
1099 | ||
1100 | ;;;###autoload | |
1101 | (defun checkdoc-ispell-start (&optional take-notes) | |
5b531322 | 1102 | "Check the style and spelling of the current buffer. |
bca0d607 EL |
1103 | Calls `checkdoc-start' with spell-checking turned on. |
1104 | Prefix argument TAKE-NOTES is the same as for `checkdoc-start'" | |
5b531322 KH |
1105 | (interactive) |
1106 | (let ((checkdoc-spellcheck-documentation-flag t)) | |
bca0d607 | 1107 | (call-interactively 'checkdoc-start nil current-prefix-arg))) |
5b531322 KH |
1108 | |
1109 | ;;;###autoload | |
1110 | (defun checkdoc-ispell-continue (&optional take-notes) | |
1111 | "Check the style and spelling of the current buffer after point. | |
1112 | Calls `checkdoc-continue' with spell-checking turned on. | |
1113 | Prefix argument TAKE-NOTES is the same as for `checkdoc-continue'" | |
1114 | (interactive) | |
1115 | (let ((checkdoc-spellcheck-documentation-flag t)) | |
1116 | (call-interactively 'checkdoc-continue nil current-prefix-arg))) | |
1117 | ||
1118 | ;;;###autoload | |
1119 | (defun checkdoc-ispell-comments (&optional take-notes) | |
1120 | "Check the style and spelling of the current buffer's comments. | |
1121 | Calls `checkdoc-comments' with spell-checking turned on. | |
1122 | Prefix argument TAKE-NOTES is the same as for `checkdoc-comments'" | |
1123 | (interactive) | |
1124 | (let ((checkdoc-spellcheck-documentation-flag t)) | |
1125 | (call-interactively 'checkdoc-comments nil current-prefix-arg))) | |
1126 | ||
1127 | ;;;###autoload | |
1128 | (defun checkdoc-ispell-defun (&optional take-notes) | |
5fecb21a | 1129 | "Check the style and spelling of the current defun with Ispell. |
5b531322 KH |
1130 | Calls `checkdoc-defun' with spell-checking turned on. |
1131 | Prefix argument TAKE-NOTES is the same as for `checkdoc-defun'" | |
1132 | (interactive) | |
1133 | (let ((checkdoc-spellcheck-documentation-flag t)) | |
1134 | (call-interactively 'checkdoc-defun nil current-prefix-arg))) | |
1135 | ||
bca0d607 EL |
1136 | ;;; Error Management |
1137 | ;; | |
1138 | ;; Errors returned from checkdoc functions can have various | |
1139 | ;; features and behaviors, so we need some ways of specifying | |
1140 | ;; them, and making them easier to use in the wacked-out interfaces | |
1141 | ;; people are requesting | |
1142 | (defun checkdoc-create-error (text start end &optional unfixable) | |
1143 | "Used to create the return error text returned from all engines. | |
1144 | TEXT is the descriptive text of the error. START and END define the region | |
1145 | it is sensible to highlight when describing the problem. | |
1146 | Optional argument UNFIXABLE means that the error has no auto-fix available. | |
1147 | ||
1148 | A list of the form (TEXT START END UNFIXABLE) is returned if we are not | |
1149 | generating a buffered list of errors." | |
1150 | (if checkdoc-generate-compile-warnings-flag | |
1151 | (progn (checkdoc-error start text) | |
1152 | nil) | |
1153 | (list text start end unfixable))) | |
1154 | ||
1155 | (defun checkdoc-error-text (err) | |
1156 | "Return the text specified in the checkdoc ERR." | |
1157 | ;; string-p part is for backwards compatibility | |
1158 | (if (stringp err) err (car err))) | |
1159 | ||
1160 | (defun checkdoc-error-start (err) | |
1161 | "Return the start point specified in the checkdoc ERR." | |
1162 | ;; string-p part is for backwards compatibility | |
1163 | (if (stringp err) nil (nth 1 err))) | |
1164 | ||
1165 | (defun checkdoc-error-end (err) | |
1166 | "Return the end point specified in the checkdoc ERR." | |
1167 | ;; string-p part is for backwards compatibility | |
1168 | (if (stringp err) nil (nth 2 err))) | |
1169 | ||
1170 | (defun checkdoc-error-unfixable (err) | |
1171 | "Return the t if we cannot autofix the error specified in the checkdoc ERR." | |
1172 | ;; string-p part is for backwards compatibility | |
1173 | (if (stringp err) nil (nth 3 err))) | |
1174 | ||
5b531322 KH |
1175 | ;;; Minor Mode specification |
1176 | ;; | |
5b531322 | 1177 | |
82bc80bf | 1178 | (defvar checkdoc-minor-mode-map |
5b531322 KH |
1179 | (let ((map (make-sparse-keymap)) |
1180 | (pmap (make-sparse-keymap))) | |
1181 | ;; Override some bindings | |
1182 | (define-key map "\C-\M-x" 'checkdoc-eval-defun) | |
bca0d607 | 1183 | (define-key map "\C-x`" 'checkdoc-continue) |
f8246027 | 1184 | (if (not (featurep 'xemacs)) |
5b531322 KH |
1185 | (define-key map [menu-bar emacs-lisp eval-buffer] |
1186 | 'checkdoc-eval-current-buffer)) | |
bca0d607 | 1187 | ;; Add some new bindings under C-c ? |
5b531322 KH |
1188 | (define-key pmap "x" 'checkdoc-defun) |
1189 | (define-key pmap "X" 'checkdoc-ispell-defun) | |
1190 | (define-key pmap "`" 'checkdoc-continue) | |
1191 | (define-key pmap "~" 'checkdoc-ispell-continue) | |
bca0d607 EL |
1192 | (define-key pmap "s" 'checkdoc-start) |
1193 | (define-key pmap "S" 'checkdoc-ispell-start) | |
5b531322 KH |
1194 | (define-key pmap "d" 'checkdoc) |
1195 | (define-key pmap "D" 'checkdoc-ispell) | |
5b531322 KH |
1196 | (define-key pmap "b" 'checkdoc-current-buffer) |
1197 | (define-key pmap "B" 'checkdoc-ispell-current-buffer) | |
1198 | (define-key pmap "e" 'checkdoc-eval-current-buffer) | |
a4370a77 | 1199 | (define-key pmap "m" 'checkdoc-message-text) |
bca0d607 | 1200 | (define-key pmap "M" 'checkdoc-ispell-message-text) |
5b531322 KH |
1201 | (define-key pmap "c" 'checkdoc-comments) |
1202 | (define-key pmap "C" 'checkdoc-ispell-comments) | |
1203 | (define-key pmap " " 'checkdoc-rogue-spaces) | |
1204 | ||
1205 | ;; bind our submap into map | |
1206 | (define-key map "\C-c?" pmap) | |
1207 | map) | |
1208 | "Keymap used to override evaluation key-bindings for documentation checking.") | |
1209 | ||
182f6205 JB |
1210 | (define-obsolete-variable-alias 'checkdoc-minor-keymap |
1211 | 'checkdoc-minor-mode-map "21.1") | |
82bc80bf | 1212 | |
5b531322 KH |
1213 | ;; Add in a menubar with easy-menu |
1214 | ||
82bc80bf | 1215 | (easy-menu-define |
76efe10e | 1216 | nil checkdoc-minor-mode-map "Checkdoc Minor Mode Menu" |
82bc80bf SM |
1217 | '("CheckDoc" |
1218 | ["Interactive Buffer Style Check" checkdoc t] | |
1219 | ["Interactive Buffer Style and Spelling Check" checkdoc-ispell t] | |
1220 | ["Check Buffer" checkdoc-current-buffer t] | |
1221 | ["Check and Spell Buffer" checkdoc-ispell-current-buffer t] | |
1222 | "---" | |
1223 | ["Interactive Style Check" checkdoc-interactive t] | |
1224 | ["Interactive Style and Spelling Check" checkdoc-ispell-interactive t] | |
1225 | ["Find First Style Error" checkdoc-start t] | |
1226 | ["Find First Style or Spelling Error" checkdoc-ispell-start t] | |
1227 | ["Next Style Error" checkdoc-continue t] | |
1228 | ["Next Style or Spelling Error" checkdoc-ispell-continue t] | |
1229 | ["Interactive Message Text Style Check" checkdoc-message-interactive t] | |
1230 | ["Interactive Message Text Style and Spelling Check" | |
1231 | checkdoc-ispell-message-interactive t] | |
1232 | ["Check Message Text" checkdoc-message-text t] | |
1233 | ["Check and Spell Message Text" checkdoc-ispell-message-text t] | |
1234 | ["Check Comment Style" checkdoc-comments buffer-file-name] | |
1235 | ["Check Comment Style and Spelling" checkdoc-ispell-comments | |
1236 | buffer-file-name] | |
1237 | ["Check for Rogue Spaces" checkdoc-rogue-spaces t] | |
1238 | "---" | |
1239 | ["Check Defun" checkdoc-defun t] | |
1240 | ["Check and Spell Defun" checkdoc-ispell-defun t] | |
1241 | ["Check and Evaluate Defun" checkdoc-eval-defun t] | |
1242 | ["Check and Evaluate Buffer" checkdoc-eval-current-buffer t] | |
1243 | )) | |
5b531322 KH |
1244 | ;; XEmacs requires some weird stuff to add this menu in a minor mode. |
1245 | ;; What is it? | |
1246 | ||
5b531322 | 1247 | ;;;###autoload |
b7f30cf5 | 1248 | (define-minor-mode checkdoc-minor-mode |
5fecb21a | 1249 | "Toggle Checkdoc minor mode, a mode for checking Lisp doc strings. |
314125ec GM |
1250 | With prefix ARG, turn Checkdoc minor mode on if ARG is positive, otherwise |
1251 | turn it off. | |
5b531322 | 1252 | |
5fecb21a | 1253 | In Checkdoc minor mode, the usual bindings for `eval-defun' which is |
07051573 | 1254 | bound to \\<checkdoc-minor-mode-map>\\[checkdoc-eval-defun] and `checkdoc-eval-current-buffer' are overridden to include |
5b531322 KH |
1255 | checking of documentation strings. |
1256 | ||
82bc80bf | 1257 | \\{checkdoc-minor-mode-map}" |
b92317dc | 1258 | nil checkdoc-minor-mode-string nil |
90620d3d | 1259 | :group 'checkdoc) |
5b531322 KH |
1260 | |
1261 | ;;; Subst utils | |
1262 | ;; | |
1263 | (defsubst checkdoc-run-hooks (hookvar &rest args) | |
1264 | "Run hooks in HOOKVAR with ARGS." | |
1265 | (if (fboundp 'run-hook-with-args-until-success) | |
1266 | (apply 'run-hook-with-args-until-success hookvar args) | |
1267 | ;; This method was similar to above. We ignore the warning | |
5fecb21a | 1268 | ;; since we will use the above for future Emacs versions |
5b531322 KH |
1269 | (apply 'run-hook-with-args hookvar args))) |
1270 | ||
1271 | (defsubst checkdoc-create-common-verbs-regexp () | |
1272 | "Rebuild the contents of `checkdoc-common-verbs-regexp'." | |
1273 | (or checkdoc-common-verbs-regexp | |
1274 | (setq checkdoc-common-verbs-regexp | |
1275 | (concat "\\<\\(" | |
1276 | (mapconcat (lambda (e) (concat (car e))) | |
1277 | checkdoc-common-verbs-wrong-voice "\\|") | |
1278 | "\\)\\>")))) | |
1279 | ||
1280 | ;; Profiler says this is not yet faster than just calling assoc | |
1281 | ;;(defun checkdoc-word-in-alist-vector (word vector) | |
1282 | ;; "Check to see if WORD is in the car of an element of VECTOR. | |
1283 | ;;VECTOR must be sorted. The CDR should be a replacement. Since the | |
1284 | ;;word list is getting bigger, it is time for a quick bisecting search." | |
1285 | ;; (let ((max (length vector)) (min 0) i | |
1286 | ;; (found nil) (fw nil)) | |
1287 | ;; (setq i (/ max 2)) | |
1288 | ;; (while (and (not found) (/= min max)) | |
1289 | ;; (setq fw (car (aref vector i))) | |
1290 | ;; (cond ((string= word fw) (setq found (cdr (aref vector i)))) | |
1291 | ;; ((string< word fw) (setq max i)) | |
1292 | ;; (t (setq min i))) | |
1293 | ;; (setq i (/ (+ max min) 2)) | |
1294 | ;; ) | |
1295 | ;; found)) | |
1296 | ||
1297 | ;;; Checking engines | |
1298 | ;; | |
1299 | (defun checkdoc-this-string-valid () | |
5fecb21a | 1300 | "Return a message string if the current doc string is invalid. |
5b531322 KH |
1301 | Check for style only, such as the first line always being a complete |
1302 | sentence, whitespace restrictions, and making sure there are no | |
1303 | hard-coded key-codes such as C-[char] or mouse-[number] in the comment. | |
1304 | See the style guide in the Emacs Lisp manual for more details." | |
1305 | ||
5fecb21a | 1306 | ;; Jump over comments between the last object and the doc string |
5b531322 KH |
1307 | (while (looking-at "[ \t\n]*;") |
1308 | (forward-line 1) | |
1309 | (beginning-of-line) | |
1310 | (skip-chars-forward " \n\t")) | |
1311 | ||
bca0d607 EL |
1312 | (let ((fp (checkdoc-defun-info)) |
1313 | (err nil)) | |
1314 | (setq | |
1315 | err | |
1316 | ;; * Every command, function, or variable intended for users to know | |
1317 | ;; about should have a documentation string. | |
1318 | ;; | |
1319 | ;; * An internal variable or subroutine of a Lisp program might as well | |
1320 | ;; have a documentation string. In earlier Emacs versions, you could | |
1321 | ;; save space by using a comment instead of a documentation string, | |
1322 | ;; but that is no longer the case. | |
1323 | (if (and (not (nth 1 fp)) ; not a variable | |
1324 | (or (nth 2 fp) ; is interactive | |
1325 | checkdoc-force-docstrings-flag) ;or we always complain | |
1326 | (not (checkdoc-char= (following-char) ?\"))) ; no doc string | |
1327 | ;; Sometimes old code has comments where the documentation should | |
84f473b0 | 1328 | ;; be. Let's see if we can find the comment, and offer to turn it |
bca0d607 | 1329 | ;; into documentation for them. |
eb83be8a DL |
1330 | (let ((have-comment nil) |
1331 | (comment-start ";")) ; in case it's not default | |
bca0d607 EL |
1332 | (condition-case nil |
1333 | (progn | |
1334 | (forward-sexp -1) | |
1335 | (forward-sexp 1) | |
1336 | (skip-chars-forward "\n \t") | |
1337 | (setq have-comment (looking-at comment-start))) | |
1338 | (error nil)) | |
1339 | (if have-comment | |
1340 | (if (or (eq checkdoc-autofix-flag | |
1341 | 'automatic-then-never) | |
1342 | (checkdoc-y-or-n-p | |
1343 | "Convert comment to documentation? ")) | |
1344 | (save-excursion | |
1345 | ;; Our point is at the beginning of the comment! | |
1346 | ;; Insert a quote, then remove the comment chars. | |
1347 | (insert "\"") | |
84f473b0 | 1348 | (let ((docstring-start-point (point))) |
bca0d607 | 1349 | (while (looking-at comment-start) |
84f473b0 EL |
1350 | (while (looking-at comment-start) |
1351 | (delete-char 1)) | |
1352 | (if (looking-at "[ \t]+") | |
1353 | (delete-region (match-beginning 0) (match-end 0))) | |
1354 | (forward-line 1) | |
1355 | (beginning-of-line) | |
1356 | (skip-chars-forward " \t") | |
1357 | (if (looking-at comment-start) | |
1358 | (progn | |
1359 | (beginning-of-line) | |
1360 | (zap-to-char 1 ?\;)))) | |
bca0d607 | 1361 | (beginning-of-line) |
84f473b0 EL |
1362 | (forward-char -1) |
1363 | (insert "\"") | |
1364 | (forward-char -1) | |
1365 | ;; quote any double-quote characters in the comment. | |
1366 | (while (search-backward "\"" docstring-start-point t) | |
1367 | (insert "\\")) | |
1368 | (if (eq checkdoc-autofix-flag 'automatic-then-never) | |
1369 | (setq checkdoc-autofix-flag 'never)))) | |
bca0d607 EL |
1370 | (checkdoc-create-error |
1371 | "You should convert this comment to documentation" | |
1372 | (point) (save-excursion (end-of-line) (point)))) | |
1373 | (checkdoc-create-error | |
1374 | (if (nth 2 fp) | |
1375 | "All interactive functions should have documentation" | |
1376 | "All variables and subroutines might as well have a \ | |
1377 | documentation string") | |
1378 | (point) (+ (point) 1) t))))) | |
1379 | (if (and (not err) (looking-at "\"")) | |
1380 | (let ((old-syntax-table (syntax-table))) | |
1381 | (unwind-protect | |
1382 | (progn | |
1383 | (set-syntax-table checkdoc-syntax-table) | |
1384 | (checkdoc-this-string-valid-engine fp)) | |
1385 | (set-syntax-table old-syntax-table))) | |
1386 | err))) | |
1387 | ||
1388 | (defun checkdoc-this-string-valid-engine (fp) | |
1389 | "Return an error list or string if the current doc string is invalid. | |
5b531322 | 1390 | Depends on `checkdoc-this-string-valid' to reset the syntax table so that |
bca0d607 | 1391 | regexp short cuts work. FP is the function defun information." |
5b531322 KH |
1392 | (let ((case-fold-search nil) |
1393 | ;; Use a marker so if an early check modifies the text, | |
1394 | ;; we won't accidentally loose our place. This could cause | |
5fecb21a | 1395 | ;; end-of doc string whitespace to also delete the " char. |
bca0d607 EL |
1396 | (s (point)) |
1397 | (e (if (looking-at "\"") | |
1398 | (save-excursion (forward-sexp 1) (point-marker)) | |
1399 | (point)))) | |
5b531322 KH |
1400 | (or |
1401 | ;; * *Do not* indent subsequent lines of a documentation string so that | |
1402 | ;; the text is lined up in the source code with the text of the first | |
1403 | ;; line. This looks nice in the source code, but looks bizarre when | |
1404 | ;; users view the documentation. Remember that the indentation | |
1405 | ;; before the starting double-quote is not part of the string! | |
1406 | (save-excursion | |
1407 | (forward-line 1) | |
1408 | (beginning-of-line) | |
1409 | (if (and (< (point) e) | |
1410 | (looking-at "\\([ \t]+\\)[^ \t\n]")) | |
1411 | (if (checkdoc-autofix-ask-replace (match-beginning 1) | |
1412 | (match-end 1) | |
a4370a77 | 1413 | "Remove this whitespace? " |
5b531322 KH |
1414 | "") |
1415 | nil | |
bca0d607 EL |
1416 | (checkdoc-create-error |
1417 | "Second line should not have indentation" | |
1418 | (match-beginning 1) | |
1419 | (match-end 1))))) | |
9c07782e GM |
1420 | ;; * Check for '(' in column 0. |
1421 | (save-excursion | |
1422 | (when (re-search-forward "^(" e t) | |
1423 | (if (checkdoc-autofix-ask-replace (match-beginning 0) | |
1424 | (match-end 0) | |
1425 | "Escape this '('? " | |
1426 | "\\(") | |
1427 | nil | |
1428 | (checkdoc-create-error | |
1429 | "Open parenthesis in column 0 should be escaped" | |
1430 | (match-beginning 0) (match-end 0))))) | |
5b531322 KH |
1431 | ;; * Do not start or end a documentation string with whitespace. |
1432 | (let (start end) | |
1433 | (if (or (if (looking-at "\"\\([ \t\n]+\\)") | |
1434 | (setq start (match-beginning 1) | |
1435 | end (match-end 1))) | |
1436 | (save-excursion | |
1437 | (forward-sexp 1) | |
1438 | (forward-char -1) | |
1439 | (if (/= (skip-chars-backward " \t\n") 0) | |
1440 | (setq start (point) | |
1441 | end (1- e))))) | |
1442 | (if (checkdoc-autofix-ask-replace | |
a4370a77 | 1443 | start end "Remove this whitespace? " "") |
5b531322 | 1444 | nil |
bca0d607 EL |
1445 | (checkdoc-create-error |
1446 | "Documentation strings should not start or end with whitespace" | |
1447 | start end)))) | |
5b531322 KH |
1448 | ;; * The first line of the documentation string should consist of one |
1449 | ;; or two complete sentences that stand on their own as a summary. | |
1450 | ;; `M-x apropos' displays just the first line, and if it doesn't | |
1451 | ;; stand on its own, the result looks bad. In particular, start the | |
1452 | ;; first line with a capital letter and end with a period. | |
1453 | (save-excursion | |
1454 | (end-of-line) | |
1455 | (skip-chars-backward " \t\n") | |
1456 | (if (> (point) e) (goto-char e)) ;of the form (defun n () "doc" nil) | |
1457 | (forward-char -1) | |
1458 | (cond | |
1459 | ((and (checkdoc-char= (following-char) ?\") | |
1460 | ;; A backslashed double quote at the end of a sentence | |
1461 | (not (checkdoc-char= (preceding-char) ?\\))) | |
1462 | ;; We might have to add a period in this case | |
1463 | (forward-char -1) | |
84f473b0 | 1464 | (if (looking-at "[.!?]") |
5b531322 KH |
1465 | nil |
1466 | (forward-char 1) | |
1467 | (if (checkdoc-autofix-ask-replace | |
a4370a77 | 1468 | (point) (1+ (point)) "Add period to sentence? " |
5b531322 KH |
1469 | ".\"" t) |
1470 | nil | |
bca0d607 EL |
1471 | (checkdoc-create-error |
1472 | "First sentence should end with punctuation" | |
1473 | (point) (1+ (point)))))) | |
84f473b0 | 1474 | ((looking-at "[\\!?;:.)]") |
5b531322 KH |
1475 | ;; These are ok |
1476 | nil) | |
bca0d607 EL |
1477 | ((and checkdoc-permit-comma-termination-flag (looking-at ",")) |
1478 | nil) | |
5b531322 | 1479 | (t |
bca0d607 | 1480 | ;; If it is not a complete sentence, let's see if we can |
5b531322 KH |
1481 | ;; predict a clever way to make it one. |
1482 | (let ((msg "First line is not a complete sentence") | |
1483 | (e (point))) | |
1484 | (beginning-of-line) | |
1485 | (if (re-search-forward "\\. +" e t) | |
1486 | ;; Here we have found a complete sentence, but no break. | |
1487 | (if (checkdoc-autofix-ask-replace | |
1488 | (1+ (match-beginning 0)) (match-end 0) | |
a4370a77 | 1489 | "First line not a complete sentence. Add RET here? " |
5b531322 KH |
1490 | "\n" t) |
1491 | (let (l1 l2) | |
1492 | (forward-line 1) | |
1493 | (end-of-line) | |
1494 | (setq l1 (current-column) | |
1495 | l2 (save-excursion | |
1496 | (forward-line 1) | |
1497 | (end-of-line) | |
1498 | (current-column))) | |
1499 | (if (> (+ l1 l2 1) 80) | |
5fecb21a | 1500 | (setq msg "Incomplete auto-fix; doc string \ |
a4370a77 | 1501 | may require more formatting") |
5b531322 KH |
1502 | ;; We can merge these lines! Replace this CR |
1503 | ;; with a space. | |
1504 | (delete-char 1) (insert " ") | |
1505 | (setq msg nil)))) | |
bca0d607 | 1506 | ;; Let's see if there is enough room to draw the next |
5b531322 KH |
1507 | ;; line's sentence up here. I often get hit w/ |
1508 | ;; auto-fill moving my words around. | |
1509 | (let ((numc (progn (end-of-line) (- 80 (current-column)))) | |
1510 | (p (point))) | |
1511 | (forward-line 1) | |
1512 | (beginning-of-line) | |
84f473b0 | 1513 | (if (and (re-search-forward "[.!?:\"]\\([ \t\n]+\\|\"\\)" |
bca0d607 EL |
1514 | (save-excursion |
1515 | (end-of-line) | |
1516 | (point)) | |
5b531322 KH |
1517 | t) |
1518 | (< (current-column) numc)) | |
1519 | (if (checkdoc-autofix-ask-replace | |
1520 | p (1+ p) | |
5fecb21a | 1521 | "1st line not a complete sentence. Join these lines? " |
5b531322 KH |
1522 | " " t) |
1523 | (progn | |
1524 | ;; They said yes. We have more fill work to do... | |
bca0d607 EL |
1525 | (goto-char (match-beginning 1)) |
1526 | (delete-region (point) (match-end 1)) | |
5b531322 KH |
1527 | (insert "\n") |
1528 | (setq msg nil)))))) | |
bca0d607 EL |
1529 | (if msg |
1530 | (checkdoc-create-error msg s (save-excursion | |
1531 | (goto-char s) | |
1532 | (end-of-line) | |
1533 | (point))) | |
1534 | nil) )))) | |
5b531322 KH |
1535 | ;; Continuation of above. Make sure our sentence is capitalized. |
1536 | (save-excursion | |
1537 | (skip-chars-forward "\"\\*") | |
1538 | (if (looking-at "[a-z]") | |
1539 | (if (checkdoc-autofix-ask-replace | |
1540 | (match-beginning 0) (match-end 0) | |
a4370a77 | 1541 | "Capitalize your sentence? " (upcase (match-string 0)) |
5b531322 KH |
1542 | t) |
1543 | nil | |
bca0d607 EL |
1544 | (checkdoc-create-error |
1545 | "First line should be capitalized" | |
1546 | (match-beginning 0) (match-end 0))) | |
5b531322 | 1547 | nil)) |
5b531322 KH |
1548 | ;; * Don't write key sequences directly in documentation strings. |
1549 | ;; Instead, use the `\\[...]' construct to stand for them. | |
1550 | (save-excursion | |
1551 | (let ((f nil) (m nil) (start (point)) | |
04f3f5a2 | 1552 | (re "[^`A-Za-z0-9_]\\([CMA]-[a-zA-Z]\\|\\(\\([CMA]-\\)?\ |
5b531322 KH |
1553 | mouse-[0-3]\\)\\)\\>")) |
1554 | ;; Find the first key sequence not in a sample | |
1555 | (while (and (not f) (setq m (re-search-forward re e t))) | |
1556 | (setq f (not (checkdoc-in-sample-code-p start e)))) | |
1557 | (if m | |
bca0d607 EL |
1558 | (checkdoc-create-error |
1559 | (concat | |
1560 | "Keycode " (match-string 1) | |
1561 | " embedded in doc string. Use \\\\<keymap> & \\\\[function] " | |
1562 | "instead") | |
1563 | (match-beginning 1) (match-end 1) t)))) | |
5b531322 KH |
1564 | ;; It is not practical to use `\\[...]' very many times, because |
1565 | ;; display of the documentation string will become slow. So use this | |
1566 | ;; to describe the most important commands in your major mode, and | |
1567 | ;; then use `\\{...}' to display the rest of the mode's keymap. | |
1568 | (save-excursion | |
25d91d94 SM |
1569 | (if (and (re-search-forward "\\\\\\\\\\[\\w+" e t |
1570 | (1+ checkdoc-max-keyref-before-warn)) | |
1571 | (not (re-search-forward "\\\\\\\\{\\w+}" e t))) | |
bca0d607 EL |
1572 | (checkdoc-create-error |
1573 | "Too many occurrences of \\[function]. Use \\{keymap} instead" | |
1574 | s (marker-position e)))) | |
5fecb21a | 1575 | ;; Ambiguous quoted symbol. When a symbol is both bound and fbound, |
a4370a77 EL |
1576 | ;; and is referred to in documentation, it should be prefixed with |
1577 | ;; something to disambiguate it. This check must be before the | |
1578 | ;; 80 column check because it will probably break that. | |
1579 | (save-excursion | |
1580 | (let ((case-fold-search t) | |
bca0d607 EL |
1581 | (ret nil) mb me) |
1582 | (while (and (re-search-forward "`\\(\\sw\\(\\sw\\|\\s_\\)+\\)'" e t) | |
1583 | (not ret)) | |
1584 | (let* ((ms1 (match-string 1)) | |
1585 | (sym (intern-soft ms1))) | |
1586 | (setq mb (match-beginning 1) | |
1587 | me (match-end 1)) | |
1588 | (if (and sym (boundp sym) (fboundp sym) | |
1589 | (save-excursion | |
1590 | (goto-char mb) | |
1591 | (forward-word -1) | |
1592 | (not (looking-at | |
1593 | "variable\\|option\\|function\\|command\\|symbol")))) | |
a4370a77 | 1594 | (if (checkdoc-autofix-ask-replace |
bca0d607 EL |
1595 | mb me "Prefix this ambiguous symbol? " ms1 t) |
1596 | ;; We didn't actually replace anything. Here we find | |
a4370a77 EL |
1597 | ;; out what special word form they wish to use as |
1598 | ;; a prefix. | |
1599 | (let ((disambiguate | |
1600 | (completing-read | |
5b76833f | 1601 | "Disambiguating Keyword (default variable): " |
a4370a77 EL |
1602 | '(("function") ("command") ("variable") |
1603 | ("option") ("symbol")) | |
1604 | nil t nil nil "variable"))) | |
1605 | (goto-char (1- mb)) | |
1606 | (insert disambiguate " ") | |
1607 | (forward-word 1)) | |
1608 | (setq ret | |
bca0d607 EL |
1609 | (format "Disambiguate %s by preceding w/ \ |
1610 | function,command,variable,option or symbol." ms1)))))) | |
1611 | (if ret | |
1612 | (checkdoc-create-error ret mb me) | |
1613 | nil))) | |
5b531322 KH |
1614 | ;; * Format the documentation string so that it fits in an |
1615 | ;; Emacs window on an 80-column screen. It is a good idea | |
1616 | ;; for most lines to be no wider than 60 characters. The | |
1617 | ;; first line can be wider if necessary to fit the | |
1618 | ;; information that ought to be there. | |
1619 | (save-excursion | |
bca0d607 EL |
1620 | (let ((start (point)) |
1621 | (eol nil)) | |
5b531322 | 1622 | (while (and (< (point) e) |
bca0d607 EL |
1623 | (or (progn (end-of-line) (setq eol (point)) |
1624 | (< (current-column) 80)) | |
5b531322 KH |
1625 | (progn (beginning-of-line) |
1626 | (re-search-forward "\\\\\\\\[[<{]" | |
bca0d607 | 1627 | eol t)) |
5b531322 KH |
1628 | (checkdoc-in-sample-code-p start e))) |
1629 | (forward-line 1)) | |
1630 | (end-of-line) | |
1631 | (if (and (< (point) e) (> (current-column) 80)) | |
bca0d607 EL |
1632 | (checkdoc-create-error |
1633 | "Some lines are over 80 columns wide" | |
1634 | s (save-excursion (goto-char s) (end-of-line) (point)) )))) | |
5b531322 | 1635 | ;; Here we deviate to tests based on a variable or function. |
bca0d607 EL |
1636 | ;; We must do this before checking for symbols in quotes because there |
1637 | ;; is a chance that just such a symbol might really be an argument. | |
5b531322 KH |
1638 | (cond ((eq (nth 1 fp) t) |
1639 | ;; This is if we are in a variable | |
1640 | (or | |
1641 | ;; * The documentation string for a variable that is a | |
bca0d607 EL |
1642 | ;; yes-or-no flag should start with words such as Non-nil |
1643 | ;; means..., to make it clear that all non-`nil' values are | |
5b531322 KH |
1644 | ;; equivalent and indicate explicitly what `nil' and non-`nil' |
1645 | ;; mean. | |
1646 | ;; * If a user option variable records a true-or-false | |
1647 | ;; condition, give it a name that ends in `-flag'. | |
1648 | ||
1649 | ;; If the variable has -flag in the name, make sure | |
1650 | (if (and (string-match "-flag$" (car fp)) | |
1651 | (not (looking-at "\"\\*?Non-nil\\s-+means\\s-+"))) | |
bca0d607 | 1652 | (checkdoc-create-error |
995e028a | 1653 | "Flag variable doc strings should usually start: Non-nil means" |
bca0d607 | 1654 | s (marker-position e) t)) |
145b6377 SM |
1655 | ;; Don't rename variable to "foo-flag". This is unnecessary |
1656 | ;; and such names often end up inconvenient when the variable | |
1657 | ;; is later expanded to non-boolean values. --Stef | |
5fecb21a | 1658 | ;; If the doc string starts with "Non-nil means" |
145b6377 SM |
1659 | ;; (if (and (looking-at "\"\\*?Non-nil\\s-+means\\s-+") |
1660 | ;; (not (string-match "-flag$" (car fp)))) | |
1661 | ;; (let ((newname | |
1662 | ;; (if (string-match "-p$" (car fp)) | |
1663 | ;; (concat (substring (car fp) 0 -2) "-flag") | |
1664 | ;; (concat (car fp) "-flag")))) | |
1665 | ;; (if (checkdoc-y-or-n-p | |
1666 | ;; (format | |
1667 | ;; "Rename to %s and Query-Replace all occurrences? " | |
1668 | ;; newname)) | |
1669 | ;; (progn | |
1670 | ;; (beginning-of-defun) | |
1671 | ;; (query-replace-regexp | |
1672 | ;; (concat "\\<" (regexp-quote (car fp)) "\\>") | |
1673 | ;; newname)) | |
1674 | ;; (checkdoc-create-error | |
1675 | ;; "Flag variable names should normally end in `-flag'" s | |
1676 | ;; (marker-position e))))) | |
5b531322 KH |
1677 | ;; Done with variables |
1678 | )) | |
1679 | (t | |
1680 | ;; This if we are in a function definition | |
1681 | (or | |
1682 | ;; * When a function's documentation string mentions the value | |
1683 | ;; of an argument of the function, use the argument name in | |
1684 | ;; capital letters as if it were a name for that value. Thus, | |
1685 | ;; the documentation string of the function `/' refers to its | |
1686 | ;; second argument as `DIVISOR', because the actual argument | |
1687 | ;; name is `divisor'. | |
1688 | ||
1689 | ;; Addendum: Make sure they appear in the doc in the same | |
1690 | ;; order that they are found in the arg list. | |
1691 | (let ((args (cdr (cdr (cdr (cdr fp))))) | |
1692 | (last-pos 0) | |
1693 | (found 1) | |
1694 | (order (and (nth 3 fp) (car (nth 3 fp)))) | |
a4370a77 EL |
1695 | (nocheck (append '("&optional" "&rest") (nth 3 fp))) |
1696 | (inopts nil)) | |
5b531322 KH |
1697 | (while (and args found (> found last-pos)) |
1698 | (if (member (car args) nocheck) | |
a4370a77 EL |
1699 | (setq args (cdr args) |
1700 | inopts t) | |
5b531322 KH |
1701 | (setq last-pos found |
1702 | found (save-excursion | |
1703 | (re-search-forward | |
1704 | (concat "\\<" (upcase (car args)) | |
1705 | ;; Require whitespace OR | |
1706 | ;; ITEMth<space> OR | |
1707 | ;; ITEMs<space> | |
2e898692 | 1708 | "\\(\\>\\|th\\>\\|s\\>\\|[.,;:]\\)") |
5b531322 KH |
1709 | e t))) |
1710 | (if (not found) | |
1711 | (let ((case-fold-search t)) | |
bca0d607 | 1712 | ;; If the symbol was not found, let's see if we |
5b531322 KH |
1713 | ;; can find it with a different capitalization |
1714 | ;; and see if the user wants to capitalize it. | |
1715 | (if (save-excursion | |
1716 | (re-search-forward | |
84f473b0 EL |
1717 | (concat "\\<\\(" (car args) |
1718 | ;; Require whitespace OR | |
1719 | ;; ITEMth<space> OR | |
1720 | ;; ITEMs<space> | |
1721 | "\\)\\(\\>\\|th\\>\\|s\\>\\)") | |
1722 | e t)) | |
5b531322 KH |
1723 | (if (checkdoc-autofix-ask-replace |
1724 | (match-beginning 1) (match-end 1) | |
1725 | (format | |
995e028a | 1726 | "If this is the argument `%s', it should appear as %s. Fix? " |
5b531322 KH |
1727 | (car args) (upcase (car args))) |
1728 | (upcase (car args)) t) | |
1729 | (setq found (match-beginning 1)))))) | |
1730 | (if found (setq args (cdr args))))) | |
1731 | (if (not found) | |
a4370a77 EL |
1732 | ;; It wasn't found at all! Offer to attach this new symbol |
1733 | ;; to the end of the documentation string. | |
bca0d607 EL |
1734 | (if (checkdoc-y-or-n-p |
1735 | (format | |
1736 | "Add %s documentation to end of doc string? " | |
1737 | (upcase (car args)))) | |
5fecb21a | 1738 | ;; Now do some magic and invent a doc string. |
a4370a77 EL |
1739 | (save-excursion |
1740 | (goto-char e) (forward-char -1) | |
1741 | (insert "\n" | |
1742 | (if inopts "Optional a" "A") | |
1743 | "rgument " (upcase (car args)) | |
1744 | " ") | |
1745 | (insert (read-string "Describe: ")) | |
1746 | (if (not (save-excursion (forward-char -1) | |
1747 | (looking-at "[.?!]"))) | |
1748 | (insert ".")) | |
1749 | nil) | |
bca0d607 EL |
1750 | (checkdoc-create-error |
1751 | (format | |
995e028a | 1752 | "Argument `%s' should appear (as %s) in the doc string" |
bca0d607 EL |
1753 | (car args) (upcase (car args))) |
1754 | s (marker-position e))) | |
5b531322 KH |
1755 | (if (or (and order (eq order 'yes)) |
1756 | (and (not order) checkdoc-arguments-in-order-flag)) | |
1757 | (if (< found last-pos) | |
bca0d607 EL |
1758 | (checkdoc-create-error |
1759 | "Arguments occur in the doc string out of order" | |
1760 | s (marker-position e) t))))) | |
1761 | ;; * For consistency, phrase the verb in the first sentence of a | |
995e028a RS |
1762 | ;; documentation string for functions as an imperative. |
1763 | ;; For instance, use `Return the cons of A and | |
bca0d607 EL |
1764 | ;; B.' in preference to `Returns the cons of A and B.' |
1765 | ;; Usually it looks good to do likewise for the rest of the | |
1766 | ;; first paragraph. Subsequent paragraphs usually look better | |
1767 | ;; if they have proper subjects. | |
1768 | ;; | |
1769 | ;; This is the least important of the above tests. Make sure | |
1770 | ;; it occurs last. | |
1771 | (and checkdoc-verb-check-experimental-flag | |
1772 | (save-excursion | |
b08b261e | 1773 | ;; Maybe rebuild the monster-regexp |
bca0d607 EL |
1774 | (checkdoc-create-common-verbs-regexp) |
1775 | (let ((lim (save-excursion | |
1776 | (end-of-line) | |
1777 | ;; check string-continuation | |
1778 | (if (checkdoc-char= (preceding-char) ?\\) | |
1779 | (progn (forward-line 1) | |
1780 | (end-of-line))) | |
1781 | (point))) | |
1782 | (rs nil) replace original (case-fold-search t)) | |
1783 | (while (and (not rs) | |
1784 | (re-search-forward | |
1785 | checkdoc-common-verbs-regexp | |
1786 | lim t)) | |
1787 | (setq original (buffer-substring-no-properties | |
1788 | (match-beginning 1) (match-end 1)) | |
1789 | rs (assoc (downcase original) | |
1790 | checkdoc-common-verbs-wrong-voice)) | |
1791 | (if (not rs) (error "Verb voice alist corrupted")) | |
1792 | (setq replace (let ((case-fold-search nil)) | |
66e9f105 JB |
1793 | (if (string-match-p "^[A-Z]" original) |
1794 | (capitalize (cdr rs)) | |
1795 | (cdr rs)))) | |
bca0d607 EL |
1796 | (if (checkdoc-autofix-ask-replace |
1797 | (match-beginning 1) (match-end 1) | |
995e028a RS |
1798 | (format "Use the imperative for \"%s\". \ |
1799 | Replace with \"%s\"? " original replace) | |
bca0d607 EL |
1800 | replace t) |
1801 | (setq rs nil))) | |
1802 | (if rs | |
1803 | ;; there was a match, but no replace | |
1804 | (checkdoc-create-error | |
1805 | (format | |
995e028a | 1806 | "Probably \"%s\" should be imperative \"%s\"" |
bca0d607 EL |
1807 | original replace) |
1808 | (match-beginning 1) (match-end 1)))))) | |
5b531322 KH |
1809 | ;; Done with functions |
1810 | ))) | |
bca0d607 EL |
1811 | ;;* When a documentation string refers to a Lisp symbol, write it as |
1812 | ;; it would be printed (which usually means in lower case), with | |
1813 | ;; single-quotes around it. For example: `lambda'. There are two | |
1814 | ;; exceptions: write t and nil without single-quotes. (In this | |
1815 | ;; manual, we normally do use single-quotes for those symbols.) | |
1816 | (save-excursion | |
1817 | (let ((found nil) (start (point)) (msg nil) (ms nil)) | |
1818 | (while (and (not msg) | |
1819 | (re-search-forward | |
82bc80bf | 1820 | "[^-([`':a-zA-Z]\\(\\w+[:-]\\(\\w\\|\\s_\\)+\\)[^]']" |
bca0d607 EL |
1821 | e t)) |
1822 | (setq ms (match-string 1)) | |
66e9f105 JB |
1823 | ;; A . is a \s_ char, so we must remove periods from |
1824 | ;; sentences more carefully. | |
1825 | (when (string-match-p "\\.$" ms) | |
1826 | (setq ms (substring ms 0 (1- (length ms))))) | |
bca0d607 EL |
1827 | (if (and (not (checkdoc-in-sample-code-p start e)) |
1828 | (not (checkdoc-in-example-string-p start e)) | |
1829 | (not (member ms checkdoc-symbol-words)) | |
1830 | (setq found (intern-soft ms)) | |
1831 | (or (boundp found) (fboundp found))) | |
1832 | (progn | |
1833 | (setq msg (format "Add quotes around Lisp symbol `%s'? " | |
1834 | ms)) | |
1835 | (if (checkdoc-autofix-ask-replace | |
1836 | (match-beginning 1) (+ (match-beginning 1) | |
1837 | (length ms)) | |
1838 | msg (concat "`" ms "'") t) | |
1839 | (setq msg nil) | |
1840 | (setq msg | |
1841 | (format "Lisp symbol `%s' should appear in quotes" | |
1842 | ms)))))) | |
1843 | (if msg | |
1844 | (checkdoc-create-error msg (match-beginning 1) | |
1845 | (+ (match-beginning 1) | |
1846 | (length ms))) | |
1847 | nil))) | |
1848 | ;; t and nil case | |
1849 | (save-excursion | |
1850 | (if (re-search-forward "\\(`\\(t\\|nil\\)'\\)" e t) | |
1851 | (if (checkdoc-autofix-ask-replace | |
1852 | (match-beginning 1) (match-end 1) | |
1853 | (format "%s should not appear in quotes. Remove? " | |
1854 | (match-string 2)) | |
1855 | (match-string 2) t) | |
1856 | nil | |
1857 | (checkdoc-create-error | |
995e028a | 1858 | "Symbols t and nil should not appear in `...' quotes" |
bca0d607 EL |
1859 | (match-beginning 1) (match-end 1))))) |
1860 | ;; Here is some basic sentence formatting | |
1861 | (checkdoc-sentencespace-region-engine (point) e) | |
1862 | ;; Here are common proper nouns that should always appear capitalized. | |
1863 | (checkdoc-proper-noun-region-engine (point) e) | |
1864 | ;; Make sure the doc string has correctly spelled English words | |
1865 | ;; in it. This function is extracted due to its complexity, | |
5fecb21a | 1866 | ;; and reliance on the Ispell program. |
5b531322 KH |
1867 | (checkdoc-ispell-docstring-engine e) |
1868 | ;; User supplied checks | |
1869 | (save-excursion (checkdoc-run-hooks 'checkdoc-style-hooks fp e)) | |
1870 | ;; Done! | |
1871 | ))) | |
1872 | ||
1873 | (defun checkdoc-defun-info nil | |
1874 | "Return a list of details about the current sexp. | |
1875 | It is a list of the form: | |
5fecb21a | 1876 | (NAME VARIABLE INTERACTIVE NODOCPARAMS PARAMETERS ...) |
5b531322 KH |
1877 | where NAME is the name, VARIABLE is t if this is a `defvar', |
1878 | INTERACTIVE is nil if this is not an interactive function, otherwise | |
1879 | it is the position of the `interactive' call, and PARAMETERS is a | |
1880 | string which is the name of each variable in the function's argument | |
1881 | list. The NODOCPARAMS is a sublist of parameters specified by a checkdoc | |
1882 | comment for a given defun. If the first element is not a string, then | |
1883 | the token checkdoc-order: <TOKEN> exists, and TOKEN is a symbol read | |
1884 | from the comment." | |
1885 | (save-excursion | |
1886 | (beginning-of-defun) | |
1887 | (let ((defun (looking-at "(def\\(un\\|macro\\|subst\\|advice\\)")) | |
1888 | (is-advice (looking-at "(defadvice")) | |
1889 | (lst nil) | |
1890 | (ret nil) | |
1891 | (oo (make-vector 3 0))) ;substitute obarray for `read' | |
1892 | (forward-char 1) | |
1893 | (forward-sexp 1) | |
1894 | (skip-chars-forward " \n\t") | |
1895 | (setq ret | |
1896 | (list (buffer-substring-no-properties | |
1897 | (point) (progn (forward-sexp 1) (point))))) | |
1898 | (if (not defun) | |
1899 | (setq ret (cons t ret)) | |
1900 | ;; The variable spot | |
1901 | (setq ret (cons nil ret)) | |
1902 | ;; Interactive | |
1903 | (save-excursion | |
1904 | (setq ret (cons | |
82bc80bf | 1905 | (re-search-forward "^\\s-*(interactive" |
5b531322 KH |
1906 | (save-excursion (end-of-defun) (point)) |
1907 | t) | |
1908 | ret))) | |
1909 | (skip-chars-forward " \t\n") | |
1910 | (let ((bss (buffer-substring (point) (save-excursion (forward-sexp 1) | |
1911 | (point)))) | |
1912 | ;; Overload th main obarray so read doesn't intern the | |
1913 | ;; local symbols of the function we are checking. | |
1914 | ;; Without this we end up cluttering the symbol space w/ | |
1915 | ;; useless symbols. | |
1916 | (obarray oo)) | |
1917 | ;; Ok, check for checkdoc parameter comment here | |
1918 | (save-excursion | |
1919 | (setq ret | |
1920 | (cons | |
1921 | (let ((sl1 nil)) | |
1922 | (if (re-search-forward ";\\s-+checkdoc-order:\\s-+" | |
1923 | (save-excursion (end-of-defun) | |
1924 | (point)) | |
1925 | t) | |
1926 | (setq sl1 (list (cond ((looking-at "nil") 'no) | |
1927 | ((looking-at "t") 'yes))))) | |
1928 | (if (re-search-forward ";\\s-+checkdoc-params:\\s-+" | |
1929 | (save-excursion (end-of-defun) | |
1930 | (point)) | |
1931 | t) | |
1932 | (let ((sl nil)) | |
1933 | (goto-char (match-end 0)) | |
bca0d607 EL |
1934 | (condition-case nil |
1935 | (setq lst (read (current-buffer))) | |
1936 | (error (setq lst nil))) ; error in text | |
1937 | (if (not (listp lst)) ; not a list of args | |
1938 | (setq lst (list lst))) | |
1939 | (if (and lst (not (symbolp (car lst)))) ;weird arg | |
1940 | (setq lst nil)) | |
5b531322 KH |
1941 | (while lst |
1942 | (setq sl (cons (symbol-name (car lst)) sl) | |
1943 | lst (cdr lst))) | |
1944 | (setq sl1 (append sl1 sl)))) | |
1945 | sl1) | |
1946 | ret))) | |
bca0d607 | 1947 | ;; Read the list of parameters, but do not put the symbols in |
5b531322 KH |
1948 | ;; the standard obarray. |
1949 | (setq lst (read bss))) | |
1950 | ;; This is because read will intern nil if it doesn't into the | |
1951 | ;; new obarray. | |
1952 | (if (not (listp lst)) (setq lst nil)) | |
1953 | (if is-advice nil | |
1954 | (while lst | |
1955 | (setq ret (cons (symbol-name (car lst)) ret) | |
1956 | lst (cdr lst))))) | |
1957 | (nreverse ret)))) | |
1958 | ||
1959 | (defun checkdoc-in-sample-code-p (start limit) | |
5fecb21a | 1960 | "Return non-nil if the current point is in a code fragment. |
5b531322 | 1961 | A code fragment is identified by an open parenthesis followed by a |
bca0d607 EL |
1962 | symbol which is a valid function or a word in all CAPS, or a parenthesis |
1963 | that is quoted with the ' character. Only the region from START to LIMIT | |
1964 | is is allowed while searching for the bounding parenthesis." | |
5b531322 KH |
1965 | (save-match-data |
1966 | (save-restriction | |
1967 | (narrow-to-region start limit) | |
1968 | (save-excursion | |
1969 | (and (condition-case nil (progn (up-list 1) t) (error nil)) | |
1970 | (condition-case nil (progn (forward-list -1) t) (error nil)) | |
1971 | (or (save-excursion (forward-char -1) (looking-at "'(")) | |
1972 | (and (looking-at "(\\(\\(\\w\\|[-:_]\\)+\\)[ \t\n;]") | |
1973 | (let ((ms (buffer-substring-no-properties | |
1974 | (match-beginning 1) (match-end 1)))) | |
1975 | ;; if this string is function bound, we are in | |
1976 | ;; sample code. If it has a - or : character in | |
1977 | ;; the name, then it is probably supposed to be bound | |
1978 | ;; but isn't yet. | |
1979 | (or (fboundp (intern-soft ms)) | |
bca0d607 EL |
1980 | (let ((case-fold-search nil)) |
1981 | (string-match "^[A-Z-]+$" ms)) | |
5b531322 KH |
1982 | (string-match "\\w[-:_]+\\w" ms)))))))))) |
1983 | ||
bca0d607 EL |
1984 | (defun checkdoc-in-example-string-p (start limit) |
1985 | "Return non-nil if the current point is in an \"example string\". | |
1986 | This string is identified by the characters \\\" surrounding the text. | |
1987 | The text checked is between START and LIMIT." | |
1988 | (save-match-data | |
1989 | (save-excursion | |
1990 | (let ((p (point)) | |
1991 | (c 0)) | |
1992 | (goto-char start) | |
1993 | (while (and (< (point) p) (re-search-forward "\\\\\"" limit t)) | |
1994 | (setq c (1+ c))) | |
1995 | (and (< 0 c) (= (% c 2) 0)))))) | |
1996 | ||
1997 | (defun checkdoc-proper-noun-region-engine (begin end) | |
1998 | "Check all text between BEGIN and END for lower case proper nouns. | |
1999 | These are Emacs centric proper nouns which should be capitalized for | |
2000 | consistency. Return an error list if any are not fixed, but | |
2001 | internally skip over no answers. | |
2002 | If the offending word is in a piece of quoted text, then it is skipped." | |
2003 | (save-excursion | |
2004 | (let ((case-fold-search nil) | |
2005 | (errtxt nil) bb be | |
2006 | (old-syntax-table (syntax-table))) | |
2007 | (unwind-protect | |
2008 | (progn | |
2009 | (set-syntax-table checkdoc-syntax-table) | |
2010 | (goto-char begin) | |
2011 | (while (re-search-forward checkdoc-proper-noun-regexp end t) | |
2012 | (let ((text (match-string 1)) | |
2013 | (b (match-beginning 1)) | |
2014 | (e (match-end 1))) | |
2015 | (if (and (not (save-excursion | |
2016 | (goto-char b) | |
2017 | (forward-char -1) | |
2018 | (looking-at "`\\|\"\\|\\.\\|\\\\"))) | |
84f473b0 EL |
2019 | ;; surrounded by /, as in a URL or filename: /emacs/ |
2020 | (not (and (= ?/ (char-after e)) | |
2021 | (= ?/ (char-before b)))) | |
36bfa3af | 2022 | (not (checkdoc-in-example-string-p begin end)) |
849f465a KR |
2023 | ;; info or url links left alone |
2024 | (not (thing-at-point-looking-at | |
2025 | help-xref-info-regexp)) | |
2026 | (not (thing-at-point-looking-at | |
2027 | help-xref-url-regexp))) | |
bca0d607 EL |
2028 | (if (checkdoc-autofix-ask-replace |
2029 | b e (format "Text %s should be capitalized. Fix? " | |
2030 | text) | |
2031 | (capitalize text) t) | |
2032 | nil | |
2033 | (if errtxt | |
2034 | ;; If there is already an error, then generate | |
2035 | ;; the warning output if applicable | |
2036 | (if checkdoc-generate-compile-warnings-flag | |
2037 | (checkdoc-create-error | |
2038 | (format | |
2039 | "Name %s should appear capitalized as %s" | |
2040 | text (capitalize text)) | |
2041 | b e)) | |
2042 | (setq errtxt | |
2043 | (format | |
2044 | "Name %s should appear capitalized as %s" | |
2045 | text (capitalize text)) | |
2046 | bb b be e))))))) | |
2047 | (set-syntax-table old-syntax-table)) | |
2048 | (if errtxt (checkdoc-create-error errtxt bb be))))) | |
2049 | ||
2050 | (defun checkdoc-sentencespace-region-engine (begin end) | |
2051 | "Make sure all sentences have double spaces between BEGIN and END." | |
84f473b0 EL |
2052 | (if sentence-end-double-space |
2053 | (save-excursion | |
2054 | (let ((case-fold-search nil) | |
2055 | (errtxt nil) bb be | |
2056 | (old-syntax-table (syntax-table))) | |
2057 | (unwind-protect | |
2058 | (progn | |
2059 | (set-syntax-table checkdoc-syntax-table) | |
2060 | (goto-char begin) | |
2e898692 | 2061 | (while (re-search-forward "[^ .0-9]\\(\\. \\)[^ \n]" end t) |
84f473b0 EL |
2062 | (let ((b (match-beginning 1)) |
2063 | (e (match-end 1))) | |
2e898692 SM |
2064 | (unless (or (checkdoc-in-sample-code-p begin end) |
2065 | (checkdoc-in-example-string-p begin end) | |
2066 | (save-excursion | |
2067 | (goto-char b) | |
2068 | (condition-case nil | |
2069 | (progn | |
2070 | (forward-sexp -1) | |
2071 | ;; piece of an abbreviation | |
e8f2a5d5 | 2072 | ;; FIXME etc |
2e898692 SM |
2073 | (looking-at |
2074 | "\\([a-z]\\|[iI]\\.?e\\|[eE]\\.?g\\)\\.")) | |
2075 | (error t)))) | |
2076 | (if (checkdoc-autofix-ask-replace | |
2077 | b e | |
2078 | "There should be two spaces after a period. Fix? " | |
2079 | ". ") | |
2080 | nil | |
2081 | (if errtxt | |
2082 | ;; If there is already an error, then generate | |
2083 | ;; the warning output if applicable | |
2084 | (if checkdoc-generate-compile-warnings-flag | |
2085 | (checkdoc-create-error | |
2086 | "There should be two spaces after a period" | |
2087 | b e)) | |
2088 | (setq errtxt | |
2089 | "There should be two spaces after a period" | |
2090 | bb b be e))))))) | |
84f473b0 EL |
2091 | (set-syntax-table old-syntax-table)) |
2092 | (if errtxt (checkdoc-create-error errtxt bb be)))))) | |
bca0d607 | 2093 | |
5b531322 KH |
2094 | ;;; Ispell engine |
2095 | ;; | |
2096 | (eval-when-compile (require 'ispell)) | |
2097 | ||
2098 | (defun checkdoc-ispell-init () | |
5fecb21a | 2099 | "Initialize Ispell process (default version) with Lisp words. |
5b531322 KH |
2100 | The words used are from `checkdoc-ispell-lisp-words'. If `ispell' |
2101 | cannot be loaded, then set `checkdoc-spellcheck-documentation-flag' to | |
2102 | nil." | |
2103 | (require 'ispell) | |
2104 | (if (not (symbol-value 'ispell-process)) ;Silence byteCompiler | |
2105 | (condition-case nil | |
2106 | (progn | |
2107 | (ispell-buffer-local-words) | |
5fecb21a | 2108 | ;; This code copied in part from ispell.el Emacs 19.34 |
5b531322 KH |
2109 | (let ((w checkdoc-ispell-lisp-words)) |
2110 | (while w | |
2111 | (process-send-string | |
2112 | ;; Silence byte compiler | |
2113 | (symbol-value 'ispell-process) | |
2114 | (concat "@" (car w) "\n")) | |
2115 | (setq w (cdr w))))) | |
2116 | (error (setq checkdoc-spellcheck-documentation-flag nil))))) | |
2117 | ||
2118 | (defun checkdoc-ispell-docstring-engine (end) | |
5fecb21a RS |
2119 | "Run the Ispell tools on the doc string between point and END. |
2120 | Since Ispell isn't Lisp-smart, we must pre-process the doc string | |
2121 | before using the Ispell engine on it." | |
bca0d607 EL |
2122 | (if (or (not checkdoc-spellcheck-documentation-flag) |
2123 | ;; If the user wants no questions or fixing, then we must | |
2124 | ;; disable spell checking as not useful. | |
b08b261e | 2125 | (not checkdoc-autofix-flag) |
bca0d607 | 2126 | (eq checkdoc-autofix-flag 'never)) |
5b531322 KH |
2127 | nil |
2128 | (checkdoc-ispell-init) | |
2129 | (save-excursion | |
2130 | (skip-chars-forward "^a-zA-Z") | |
2131 | (let ((word nil) (sym nil) (case-fold-search nil) (err nil)) | |
2132 | (while (and (not err) (< (point) end)) | |
2133 | (if (save-excursion (forward-char -1) (looking-at "[('`]")) | |
2134 | ;; Skip lists describing meta-syntax, or bound variables | |
2135 | (forward-sexp 1) | |
2136 | (setq word (buffer-substring-no-properties | |
2137 | (point) (progn | |
2138 | (skip-chars-forward "a-zA-Z-") | |
2139 | (point))) | |
2140 | sym (intern-soft word)) | |
2141 | (if (and sym (or (boundp sym) (fboundp sym))) | |
bca0d607 | 2142 | ;; This is probably repetitive in most cases, but not always. |
5b531322 KH |
2143 | nil |
2144 | ;; Find out how we spell-check this word. | |
2145 | (if (or | |
0a0a3dee | 2146 | ;; All caps w/ option th, or s tacked on the end |
bca0d607 | 2147 | ;; for pluralization or numberthness. |
0a0a3dee | 2148 | (string-match "^[A-Z][A-Z]+\\(s\\|th\\)?$" word) |
5b531322 KH |
2149 | (looking-at "}") ; a keymap expression |
2150 | ) | |
2151 | nil | |
2152 | (save-excursion | |
2153 | (if (not (eq checkdoc-autofix-flag 'never)) | |
2154 | (let ((lk last-input-event)) | |
2155 | (ispell-word nil t) | |
2156 | (if (not (equal last-input-event lk)) | |
2157 | (progn | |
2158 | (sit-for 0) | |
2159 | (message "Continuing...")))) | |
2160 | ;; Nothing here. | |
2161 | ))))) | |
2162 | (skip-chars-forward "^a-zA-Z")) | |
2163 | err)))) | |
2164 | ||
2165 | ;;; Rogue space checking engine | |
2166 | ;; | |
bca0d607 EL |
2167 | (defun checkdoc-rogue-space-check-engine (&optional start end interact) |
2168 | "Return a message list if there is a line with white space at the end. | |
5b531322 | 2169 | If `checkdoc-autofix-flag' permits, delete that whitespace instead. |
c67c14f3 | 2170 | If optional arguments START and END are non-nil, bound the check to |
bca0d607 EL |
2171 | this region. |
2172 | Optional argument INTERACT may permit the user to fix problems on the fly." | |
5b531322 | 2173 | (let ((p (point)) |
bca0d607 | 2174 | (msg nil) s e (f nil)) |
5b531322 KH |
2175 | (if (not start) (setq start (point-min))) |
2176 | ;; If end is nil, it means end of buffer to search anyway | |
2177 | (or | |
bca0d607 | 2178 | ;; Check for an error if `? ' or `?\ ' is used at the end of a line. |
5b531322 KH |
2179 | ;; (It's dangerous) |
2180 | (progn | |
2181 | (goto-char start) | |
bca0d607 EL |
2182 | (while (and (not msg) (re-search-forward "\\?\\\\?[ \t][ \t]*$" end t)) |
2183 | (setq msg | |
2184 | "Don't use `? ' at the end of a line. \ | |
2185 | News agents may remove it" | |
2186 | s (match-beginning 0) e (match-end 0) f t) | |
2187 | ;; If interactive is passed down, give them a chance to fix things. | |
2188 | (if (and interact (y-or-n-p (concat msg ". Fix? "))) | |
2189 | (progn | |
2190 | (checkdoc-recursive-edit msg) | |
2191 | (setq msg nil) | |
2192 | (goto-char s) | |
2193 | (beginning-of-line))))) | |
2194 | ;; Check for, and potentially remove whitespace appearing at the | |
5b531322 KH |
2195 | ;; end of different lines. |
2196 | (progn | |
2197 | (goto-char start) | |
5fecb21a | 2198 | ;; There is no documentation in the Emacs Lisp manual about this check, |
5b531322 | 2199 | ;; it is intended to help clean up messy code and reduce the file size. |
bca0d607 | 2200 | (while (and (not msg) (re-search-forward "[^ \t\n;]\\([ \t]+\\)$" end t)) |
5b531322 KH |
2201 | ;; This is not a complex activity |
2202 | (if (checkdoc-autofix-ask-replace | |
2203 | (match-beginning 1) (match-end 1) | |
5fecb21a | 2204 | "White space at end of line. Remove? " "") |
5b531322 | 2205 | nil |
bca0d607 EL |
2206 | (setq msg "White space found at end of line" |
2207 | s (match-beginning 1) e (match-end 1)))))) | |
5b531322 KH |
2208 | ;; Return an error and leave the cursor at that spot, or restore |
2209 | ;; the cursor. | |
2210 | (if msg | |
bca0d607 | 2211 | (checkdoc-create-error msg s e f) |
5b531322 KH |
2212 | (goto-char p) |
2213 | nil))) | |
2214 | ||
2215 | ;;; Comment checking engine | |
2216 | ;; | |
2217 | (eval-when-compile | |
2218 | ;; We must load this to: | |
bca0d607 | 2219 | ;; a) get symbols for compile and |
5b531322 KH |
2220 | ;; b) determine if we have lm-history symbol which doesn't always exist |
2221 | (require 'lisp-mnt)) | |
2222 | ||
e8f2a5d5 GM |
2223 | (defvar generate-autoload-cookie) |
2224 | ||
5b531322 | 2225 | (defun checkdoc-file-comments-engine () |
bca0d607 | 2226 | "Return a message list if this file does not match the Emacs standard. |
5b531322 KH |
2227 | This checks for style only, such as the first line, Commentary:, |
2228 | Code:, and others referenced in the style guide." | |
2229 | (if (featurep 'lisp-mnt) | |
2230 | nil | |
2231 | (require 'lisp-mnt) | |
bca0d607 | 2232 | ;; Old XEmacs don't have `lm-commentary-mark' |
5b531322 KH |
2233 | (if (and (not (fboundp 'lm-commentary-mark)) (boundp 'lm-commentary)) |
2234 | (defalias 'lm-commentary-mark 'lm-commentary))) | |
2235 | (save-excursion | |
2236 | (let* ((f1 (file-name-nondirectory (buffer-file-name))) | |
2237 | (fn (file-name-sans-extension f1)) | |
bca0d607 EL |
2238 | (fe (substring f1 (length fn))) |
2239 | (err nil)) | |
5b531322 | 2240 | (goto-char (point-min)) |
bca0d607 EL |
2241 | ;; This file has been set up where ERR is a variable. Each check is |
2242 | ;; asked, and the function will make sure that if the user does not | |
2243 | ;; auto-fix some error, that we still move on to the next auto-fix, | |
2244 | ;; AND we remember the past errors. | |
2245 | (setq | |
2246 | err | |
5b531322 KH |
2247 | ;; Lisp Maintenance checks first |
2248 | ;; Was: (lm-verify) -> not flexible enough for some people | |
2249 | ;; * Summary at the beginning of the file: | |
2250 | (if (not (lm-summary)) | |
2251 | ;; This certifies as very complex so always ask unless | |
2252 | ;; it's set to never | |
bca0d607 | 2253 | (if (checkdoc-y-or-n-p "There is no first line summary! Add one? ") |
5b531322 KH |
2254 | (progn |
2255 | (goto-char (point-min)) | |
2256 | (insert ";;; " fn fe " --- " (read-string "Summary: ") "\n")) | |
bca0d607 EL |
2257 | (checkdoc-create-error |
2258 | "The first line should be of the form: \";;; package --- Summary\"" | |
2259 | (point-min) (save-excursion (goto-char (point-min)) (end-of-line) | |
2260 | (point)))) | |
2261 | nil)) | |
2262 | (setq | |
2263 | err | |
2264 | (or | |
2265 | ;; * Commentary Section | |
2266 | (if (not (lm-commentary-mark)) | |
2267 | (progn | |
2268 | (goto-char (point-min)) | |
2269 | (cond | |
2270 | ((re-search-forward | |
2271 | "write\\s-+to\\s-+the\\s-+Free Software Foundation, Inc." | |
2272 | nil t) | |
2273 | (re-search-forward "^;;\\s-*\n\\|^\n" nil t)) | |
2274 | ((or (re-search-forward "^;;; History" nil t) | |
2275 | (re-search-forward "^;;; Code" nil t) | |
2276 | (re-search-forward "^(require" nil t) | |
c9d557f5 | 2277 | (re-search-forward "^(" nil t)) |
81e213dc CY |
2278 | (beginning-of-line)) |
2279 | (t (re-search-forward ";;; .* --- .*\n"))) | |
bca0d607 EL |
2280 | (if (checkdoc-y-or-n-p |
2281 | "You should have a \";;; Commentary:\", add one? ") | |
2282 | (insert "\n;;; Commentary:\n;; \n\n") | |
2283 | (checkdoc-create-error | |
2284 | "You should have a section marked \";;; Commentary:\"" | |
2285 | nil nil t))) | |
2286 | nil) | |
2287 | err)) | |
2288 | (setq | |
2289 | err | |
2290 | (or | |
2291 | ;; * History section. Say nothing if there is a file ChangeLog | |
2292 | (if (or (not checkdoc-force-history-flag) | |
2293 | (file-exists-p "ChangeLog") | |
2294 | (file-exists-p "../ChangeLog") | |
2295 | (let ((fn 'lm-history-mark)) ;bestill byte-compiler | |
2296 | (and (fboundp fn) (funcall fn)))) | |
2297 | nil | |
2298 | (progn | |
2299 | (goto-char (or (lm-commentary-mark) (point-min))) | |
2300 | (cond | |
2301 | ((re-search-forward | |
2302 | "write\\s-+to\\s-+the\\s-+Free Software Foundation, Inc." | |
2303 | nil t) | |
2304 | (re-search-forward "^;;\\s-*\n\\|^\n" nil t)) | |
2305 | ((or (re-search-forward "^;;; Code" nil t) | |
2306 | (re-search-forward "^(require" nil t) | |
c9d557f5 | 2307 | (re-search-forward "^(" nil t)) |
bca0d607 EL |
2308 | (beginning-of-line))) |
2309 | (if (checkdoc-y-or-n-p | |
2310 | "You should have a \";;; History:\", add one? ") | |
2311 | (insert "\n;;; History:\n;; \n\n") | |
2312 | (checkdoc-create-error | |
2313 | "You should have a section marked \";;; History:\" or use a ChangeLog" | |
2314 | (point) nil)))) | |
2315 | err)) | |
2316 | (setq | |
2317 | err | |
2318 | (or | |
2319 | ;; * Code section | |
2320 | (if (not (lm-code-mark)) | |
68634374 KR |
2321 | (let ((cont t) |
2322 | pos) | |
bca0d607 | 2323 | (goto-char (point-min)) |
68634374 KR |
2324 | ;; match ";;;###autoload" cookie to keep it with the form |
2325 | (require 'autoload) | |
2326 | (while (and cont (re-search-forward | |
2327 | (concat "^\\(" | |
2328 | (regexp-quote generate-autoload-cookie) | |
2329 | "\n\\)?" | |
2330 | "(") | |
2331 | nil t)) | |
2332 | (setq pos (match-beginning 0) | |
2333 | cont (looking-at "require\\s-+"))) | |
bca0d607 EL |
2334 | (if (and (not cont) |
2335 | (checkdoc-y-or-n-p | |
2336 | "There is no ;;; Code: marker. Insert one? ")) | |
68634374 KR |
2337 | (progn (goto-char pos) |
2338 | (insert ";;; Code:\n\n") | |
bca0d607 EL |
2339 | nil) |
2340 | (checkdoc-create-error | |
2341 | "You should have a section marked \";;; Code:\"" | |
2342 | (point) nil))) | |
2343 | nil) | |
2344 | err)) | |
2345 | (setq | |
2346 | err | |
2347 | (or | |
2348 | ;; * A footer. Not compartmentalized from lm-verify: too bad. | |
2349 | ;; The following is partially clipped from lm-verify | |
2350 | (save-excursion | |
2351 | (goto-char (point-max)) | |
2352 | (if (not (re-search-backward | |
65a30f58 | 2353 | (concat "^;;;[ \t]+" (regexp-quote fn) "\\(" (regexp-quote fe) |
bca0d607 EL |
2354 | "\\)?[ \t]+ends here[ \t]*$" |
2355 | "\\|^;;;[ \t]+ End of file[ \t]+" | |
65a30f58 | 2356 | (regexp-quote fn) "\\(" (regexp-quote fe) "\\)?") |
bca0d607 EL |
2357 | nil t)) |
2358 | (if (checkdoc-y-or-n-p "No identifiable footer! Add one? ") | |
2359 | (progn | |
2360 | (goto-char (point-max)) | |
2361 | (insert "\n(provide '" fn ")\n\n;;; " fn fe " ends here\n")) | |
2362 | (checkdoc-create-error | |
2363 | (format "The footer should be: (provide '%s)\\n;;; %s%s ends here" | |
2364 | fn fn fe) | |
2365 | (1- (point-max)) (point-max))))) | |
2366 | err)) | |
2367 | ;; The below checks will not return errors if the user says NO | |
bca0d607 EL |
2368 | |
2369 | ;; Let's spellcheck the commentary section. This is the only | |
2370 | ;; section that is easy to pick out, and it is also the most | |
2371 | ;; visible section (with the finder). | |
2372 | (let ((cm (lm-commentary-mark))) | |
d547e25f LK |
2373 | (when cm |
2374 | (save-excursion | |
2375 | (goto-char cm) | |
2376 | (let ((e (copy-marker (lm-commentary-end)))) | |
2377 | ;; Since the comments talk about Lisp, use the | |
2378 | ;; specialized spell-checker we also used for doc | |
2379 | ;; strings. | |
2380 | (checkdoc-sentencespace-region-engine (point) e) | |
2381 | (checkdoc-proper-noun-region-engine (point) e) | |
2382 | (checkdoc-ispell-docstring-engine e))))) | |
bca0d607 EL |
2383 | (setq |
2384 | err | |
2385 | (or | |
2386 | ;; Generic Full-file checks (should be comment related) | |
2387 | (checkdoc-run-hooks 'checkdoc-comment-style-hooks) | |
2388 | err)) | |
2389 | ;; Done with full file comment checks | |
2390 | err))) | |
5b531322 KH |
2391 | |
2392 | (defun checkdoc-outside-major-sexp () | |
2393 | "Return t if point is outside the bounds of a valid sexp." | |
2394 | (save-match-data | |
2395 | (save-excursion | |
2396 | (let ((p (point))) | |
2397 | (or (progn (beginning-of-defun) (bobp)) | |
2398 | (progn (end-of-defun) (< (point) p))))))) | |
2399 | ||
a4370a77 EL |
2400 | ;;; `error' and `message' text verifier. |
2401 | ;; | |
a4370a77 | 2402 | (defun checkdoc-message-text-search (&optional beg end) |
bca0d607 | 2403 | "Search between BEG and END for a style error with message text. |
a4370a77 EL |
2404 | Optional arguments BEG and END represent the boundary of the check. |
2405 | The default boundary is the entire buffer." | |
bca0d607 EL |
2406 | (let ((e nil) |
2407 | (type nil)) | |
a4370a77 EL |
2408 | (if (not (or beg end)) (setq beg (point-min) end (point-max))) |
2409 | (goto-char beg) | |
bca0d607 EL |
2410 | (while (setq type (checkdoc-message-text-next-string end)) |
2411 | (setq e (checkdoc-message-text-engine type))) | |
a4370a77 | 2412 | e)) |
a1506d29 | 2413 | |
bca0d607 EL |
2414 | (defun checkdoc-message-text-next-string (end) |
2415 | "Move cursor to the next checkable message string after point. | |
2416 | Return the message classification. | |
2417 | Argument END is the maximum bounds to search in." | |
2418 | (let ((return nil)) | |
2419 | (while (and (not return) | |
2420 | (re-search-forward | |
2421 | "(\\s-*\\(\\(\\w\\|\\s_\\)*error\\|\ | |
2422 | \\(\\w\\|\\s_\\)*y-or-n-p\\(-with-timeout\\)?\ | |
2423 | \\|checkdoc-autofix-ask-replace\\)[ \t\n]+" end t)) | |
2424 | (let* ((fn (match-string 1)) | |
2425 | (type (cond ((string-match "error" fn) | |
2426 | 'error) | |
2427 | (t 'y-or-n-p)))) | |
2428 | (if (string-match "checkdoc-autofix-ask-replace" fn) | |
2429 | (progn (forward-sexp 2) | |
2430 | (skip-chars-forward " \t\n"))) | |
2431 | (if (and (eq type 'y-or-n-p) | |
2432 | (looking-at "(format[ \t\n]+")) | |
2433 | (goto-char (match-end 0))) | |
2434 | (skip-chars-forward " \t\n") | |
2435 | (if (not (looking-at "\"")) | |
2436 | nil | |
2437 | (setq return type)))) | |
2438 | return)) | |
2439 | ||
2440 | (defun checkdoc-message-text-engine (&optional type) | |
a4370a77 | 2441 | "Return or fix errors found in strings passed to a message display function. |
bca0d607 EL |
2442 | According to the documentation for the function `error', the error list |
2443 | should not end with a period, and should start with a capital letter. | |
a4370a77 EL |
2444 | The function `y-or-n-p' has similar constraints. |
2445 | Argument TYPE specifies the type of question, such as `error or `y-or-n-p." | |
bca0d607 EL |
2446 | ;; If type is nil, then attempt to derive it. |
2447 | (if (not type) | |
2448 | (save-excursion | |
2449 | (up-list -1) | |
2450 | (if (looking-at "(format") | |
2451 | (up-list -1)) | |
2452 | (setq type | |
2453 | (cond ((looking-at "(error") | |
2454 | 'error) | |
2455 | (t 'y-or-n-p))))) | |
a4370a77 EL |
2456 | (let ((case-fold-search nil)) |
2457 | (or | |
2458 | ;; From the documentation of the symbol `error': | |
2459 | ;; In Emacs, the convention is that error messages start with a capital | |
2460 | ;; letter but *do not* end with a period. Please follow this convention | |
2461 | ;; for the sake of consistency. | |
2462 | (if (and (save-excursion (forward-char 1) | |
2463 | (looking-at "[a-z]\\w+")) | |
2464 | (not (checkdoc-autofix-ask-replace | |
2465 | (match-beginning 0) (match-end 0) | |
2466 | "Capitalize your message text? " | |
2467 | (capitalize (match-string 0)) | |
2468 | t))) | |
bca0d607 EL |
2469 | (checkdoc-create-error |
2470 | "Messages should start with a capital letter" | |
2471 | (match-beginning 0) (match-end 0)) | |
a4370a77 | 2472 | nil) |
bca0d607 EL |
2473 | ;; In general, sentences should have two spaces after the period. |
2474 | (checkdoc-sentencespace-region-engine (point) | |
2475 | (save-excursion (forward-sexp 1) | |
2476 | (point))) | |
2477 | ;; Look for proper nouns in this region too. | |
2478 | (checkdoc-proper-noun-region-engine (point) | |
2479 | (save-excursion (forward-sexp 1) | |
2480 | (point))) | |
2481 | ;; Here are message type specific questions. | |
a4370a77 EL |
2482 | (if (and (eq type 'error) |
2483 | (save-excursion (forward-sexp 1) | |
2484 | (forward-char -2) | |
2485 | (looking-at "\\.")) | |
2486 | (not (checkdoc-autofix-ask-replace (match-beginning 0) | |
2487 | (match-end 0) | |
2488 | "Remove period from error? " | |
2489 | "" | |
2490 | t))) | |
bca0d607 EL |
2491 | (checkdoc-create-error |
2492 | "Error messages should *not* end with a period" | |
2493 | (match-beginning 0) (match-end 0)) | |
a4370a77 EL |
2494 | nil) |
2495 | ;; `y-or-n-p' documentation explicitly says: | |
2496 | ;; It should end in a space; `y-or-n-p' adds `(y or n) ' to it. | |
2497 | ;; I added the ? requirement. Without it, it is unclear that we | |
2498 | ;; ask a question and it appears to be an undocumented style. | |
bca0d607 EL |
2499 | (if (eq type 'y-or-n-p) |
2500 | (if (not (save-excursion (forward-sexp 1) | |
2501 | (forward-char -3) | |
2502 | (not (looking-at "\\? ")))) | |
2503 | nil | |
2504 | (if (save-excursion (forward-sexp 1) | |
2505 | (forward-char -2) | |
2506 | (looking-at "\\?")) | |
2507 | ;; If we see a ?, then replace with "? ". | |
2508 | (if (checkdoc-autofix-ask-replace | |
2509 | (match-beginning 0) (match-end 0) | |
995e028a | 2510 | "`y-or-n-p' argument should end with \"? \". Fix? " |
bca0d607 EL |
2511 | "? " t) |
2512 | nil | |
2513 | (checkdoc-create-error | |
995e028a | 2514 | "`y-or-n-p' argument should end with \"? \"" |
bca0d607 EL |
2515 | (match-beginning 0) (match-end 0))) |
2516 | (if (save-excursion (forward-sexp 1) | |
2517 | (forward-char -2) | |
2518 | (looking-at " ")) | |
2519 | (if (checkdoc-autofix-ask-replace | |
2520 | (match-beginning 0) (match-end 0) | |
995e028a | 2521 | "`y-or-n-p' argument should end with \"? \". Fix? " |
bca0d607 EL |
2522 | "? " t) |
2523 | nil | |
2524 | (checkdoc-create-error | |
995e028a | 2525 | "`y-or-n-p' argument should end with \"? \"" |
bca0d607 EL |
2526 | (match-beginning 0) (match-end 0))) |
2527 | (if (and ;; if this isn't true, we have a problem. | |
2528 | (save-excursion (forward-sexp 1) | |
2529 | (forward-char -1) | |
2530 | (looking-at "\"")) | |
2531 | (checkdoc-autofix-ask-replace | |
2532 | (match-beginning 0) (match-end 0) | |
995e028a | 2533 | "`y-or-n-p' argument should end with \"? \". Fix? " |
bca0d607 EL |
2534 | "? \"" t)) |
2535 | nil | |
2536 | (checkdoc-create-error | |
995e028a | 2537 | "`y-or-n-p' argument should end with \"? \"" |
bca0d607 EL |
2538 | (match-beginning 0) (match-end 0))))))) |
2539 | ;; Now, let's just run the spell checker on this guy. | |
2540 | (checkdoc-ispell-docstring-engine (save-excursion (forward-sexp 1) | |
2541 | (point))) | |
a4370a77 EL |
2542 | ))) |
2543 | ||
5b531322 KH |
2544 | ;;; Auto-fix helper functions |
2545 | ;; | |
bca0d607 EL |
2546 | (defun checkdoc-y-or-n-p (question) |
2547 | "Like `y-or-n-p', but pays attention to `checkdoc-autofix-flag'. | |
2548 | Argument QUESTION is the prompt passed to `y-or-n-p'." | |
2549 | (prog1 | |
2550 | (if (or (not checkdoc-autofix-flag) | |
2551 | (eq checkdoc-autofix-flag 'never)) | |
2552 | nil | |
2553 | (y-or-n-p question)) | |
2554 | (if (eq checkdoc-autofix-flag 'automatic-then-never) | |
2555 | (setq checkdoc-autofix-flag 'never)))) | |
2556 | ||
5b531322 KH |
2557 | (defun checkdoc-autofix-ask-replace (start end question replacewith |
2558 | &optional complex) | |
2559 | "Highlight between START and END and queries the user with QUESTION. | |
2560 | If the user says yes, or if `checkdoc-autofix-flag' permits, replace | |
2561 | the region marked by START and END with REPLACEWITH. If optional flag | |
2562 | COMPLEX is non-nil, then we may ask the user a question. See the | |
2563 | documentation for `checkdoc-autofix-flag' for details. | |
2564 | ||
2565 | If a section is auto-replaced without asking the user, this function | |
2566 | will pause near the fixed code so the user will briefly see what | |
2567 | happened. | |
2568 | ||
bca0d607 EL |
2569 | This function returns non-nil if the text was replaced. |
2570 | ||
2571 | This function will not modify `match-data'." | |
2572 | (if (and checkdoc-autofix-flag | |
2573 | (not (eq checkdoc-autofix-flag 'never))) | |
5b531322 | 2574 | (let ((o (checkdoc-make-overlay start end)) |
bca0d607 EL |
2575 | (ret nil) |
2576 | (md (match-data))) | |
5b531322 KH |
2577 | (unwind-protect |
2578 | (progn | |
2579 | (checkdoc-overlay-put o 'face 'highlight) | |
2580 | (if (or (eq checkdoc-autofix-flag 'automatic) | |
bca0d607 | 2581 | (eq checkdoc-autofix-flag 'automatic-then-never) |
5b531322 KH |
2582 | (and (eq checkdoc-autofix-flag 'semiautomatic) |
2583 | (not complex)) | |
2584 | (and (or (eq checkdoc-autofix-flag 'query) complex) | |
2585 | (y-or-n-p question))) | |
2586 | (save-excursion | |
2587 | (goto-char start) | |
2588 | ;; On the off chance this is automatic, display | |
bca0d607 | 2589 | ;; the question anyway so the user knows what's |
5b531322 KH |
2590 | ;; going on. |
2591 | (if checkdoc-bouncy-flag (message "%s -> done" question)) | |
2592 | (delete-region start end) | |
2593 | (insert replacewith) | |
2594 | (if checkdoc-bouncy-flag (sit-for 0)) | |
2595 | (setq ret t))) | |
bca0d607 EL |
2596 | (checkdoc-delete-overlay o) |
2597 | (set-match-data md)) | |
2598 | (checkdoc-delete-overlay o) | |
2599 | (set-match-data md)) | |
2600 | (if (eq checkdoc-autofix-flag 'automatic-then-never) | |
2601 | (setq checkdoc-autofix-flag 'never)) | |
5b531322 KH |
2602 | ret))) |
2603 | ||
2604 | ;;; Warning management | |
2605 | ;; | |
2606 | (defvar checkdoc-output-font-lock-keywords | |
f578d9f8 | 2607 | '(("^\\*\\*\\* \\(.+\\.el\\): \\([^ \n]+\\)" |
bca0d607 | 2608 | (1 font-lock-function-name-face) |
f578d9f8 | 2609 | (2 font-lock-comment-face))) |
5b531322 KH |
2610 | "Keywords used to highlight a checkdoc diagnostic buffer.") |
2611 | ||
f578d9f8 SM |
2612 | (defvar checkdoc-output-error-regex-alist |
2613 | '(("^\\(.+\\.el\\):\\([0-9]+\\): " 1 2))) | |
5b531322 | 2614 | |
bca0d607 EL |
2615 | (defvar checkdoc-pending-errors nil |
2616 | "Non-nil when there are errors that have not been displayed yet.") | |
2617 | ||
f578d9f8 SM |
2618 | (define-derived-mode checkdoc-output-mode compilation-mode "Checkdoc" |
2619 | "Set up the major mode for the buffer containing the list of errors." | |
2620 | (set (make-local-variable 'compilation-error-regexp-alist) | |
2621 | checkdoc-output-error-regex-alist) | |
2622 | (set (make-local-variable 'compilation-mode-font-lock-keywords) | |
2623 | checkdoc-output-font-lock-keywords)) | |
5b531322 | 2624 | |
84f473b0 EL |
2625 | (defun checkdoc-buffer-label () |
2626 | "The name to use for a checkdoc buffer in the error list." | |
2627 | (if (buffer-file-name) | |
780b142e | 2628 | (file-relative-name (buffer-file-name)) |
84f473b0 EL |
2629 | (concat "#<buffer "(buffer-name) ">"))) |
2630 | ||
5b531322 KH |
2631 | (defun checkdoc-start-section (check-type) |
2632 | "Initialize the checkdoc diagnostic buffer for a pass. | |
2633 | Create the header so that the string CHECK-TYPE is displayed as the | |
2634 | function called to create the messages." | |
780b142e SM |
2635 | (let ((dir default-directory) |
2636 | (label (checkdoc-buffer-label))) | |
2637 | (with-current-buffer (get-buffer-create checkdoc-diagnostic-buffer) | |
2638 | (checkdoc-output-mode) | |
2639 | (setq default-directory dir) | |
2640 | (goto-char (point-max)) | |
b260aab7 SM |
2641 | (let ((inhibit-read-only t)) |
2642 | (insert "\n\n\C-l\n*** " label ": " | |
2643 | check-type " V " checkdoc-version))))) | |
5b531322 KH |
2644 | |
2645 | (defun checkdoc-error (point msg) | |
2646 | "Store POINT and MSG as errors in the checkdoc diagnostic buffer." | |
bca0d607 | 2647 | (setq checkdoc-pending-errors t) |
780b142e SM |
2648 | (let ((text (list "\n" (checkdoc-buffer-label) ":" |
2649 | (int-to-string | |
2650 | (count-lines (point-min) (or point (point-min)))) | |
2651 | ": " msg))) | |
2652 | (with-current-buffer (get-buffer checkdoc-diagnostic-buffer) | |
2653 | (goto-char (point-max)) | |
b260aab7 SM |
2654 | (let ((inhibit-read-only t)) |
2655 | (apply 'insert text))))) | |
5b531322 KH |
2656 | |
2657 | (defun checkdoc-show-diagnostics () | |
2658 | "Display the checkdoc diagnostic buffer in a temporary window." | |
bca0d607 EL |
2659 | (if checkdoc-pending-errors |
2660 | (let ((b (get-buffer checkdoc-diagnostic-buffer))) | |
2661 | (if b (progn (pop-to-buffer b) | |
2662 | (goto-char (point-max)) | |
2663 | (re-search-backward "\C-l" nil t) | |
2664 | (beginning-of-line) | |
2665 | (forward-line 1) | |
2666 | (recenter 0))) | |
2667 | (other-window -1) | |
2668 | (setq checkdoc-pending-errors nil) | |
2669 | nil))) | |
5b531322 | 2670 | |
5b531322 KH |
2671 | (custom-add-option 'emacs-lisp-mode-hook |
2672 | (lambda () (checkdoc-minor-mode 1))) | |
2673 | ||
82bc80bf SM |
2674 | (add-to-list 'debug-ignored-errors |
2675 | "Argument `.*' should appear (as .*) in the doc string") | |
b008007c SM |
2676 | (add-to-list 'debug-ignored-errors |
2677 | "Lisp symbol `.*' should appear in quotes") | |
2e898692 | 2678 | (add-to-list 'debug-ignored-errors "Disambiguate .* by preceding .*") |
82bc80bf | 2679 | |
5b531322 | 2680 | (provide 'checkdoc) |
5fecb21a | 2681 | |
76667462 | 2682 | ;; arch-tag: c49a7ec8-3bb7-46f2-bfbc-d5f26e033b26 |
5b531322 | 2683 | ;;; checkdoc.el ends here |