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