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