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