| 1 |
|
|---|
| 2 |
|
|---|
| 3 |
|
|---|
| 4 |
|
|---|
| 5 |
|
|---|
| 6 |
|
|---|
| 7 |
|
|---|
| 8 |
|
|---|
| 9 |
|
|---|
| 10 |
|
|---|
| 11 |
|
|---|
| 12 |
|
|---|
| 13 |
|
|---|
| 14 |
|
|---|
| 15 |
|
|---|
| 16 |
|
|---|
| 17 |
|
|---|
| 18 |
|
|---|
| 19 |
|
|---|
| 20 |
|
|---|
| 21 |
|
|---|
| 22 |
|
|---|
| 23 |
|
|---|
| 24 |
|
|---|
| 25 |
|
|---|
| 26 |
|
|---|
| 27 |
|
|---|
| 28 |
|
|---|
| 29 |
|
|---|
| 30 |
|
|---|
| 31 |
|
|---|
| 32 |
|
|---|
| 33 |
|
|---|
| 34 |
|
|---|
| 35 |
|
|---|
| 36 |
|
|---|
| 37 |
|
|---|
| 38 |
|
|---|
| 39 |
|
|---|
| 40 |
|
|---|
| 41 |
|
|---|
| 42 |
|
|---|
| 43 |
|
|---|
| 44 |
|
|---|
| 45 |
|
|---|
| 46 |
|
|---|
| 47 |
|
|---|
| 48 |
|
|---|
| 49 |
|
|---|
| 50 |
|
|---|
| 51 |
|
|---|
| 52 |
|
|---|
| 53 |
|
|---|
| 54 |
|
|---|
| 55 |
|
|---|
| 56 |
|
|---|
| 57 |
|
|---|
| 58 |
|
|---|
| 59 |
|
|---|
| 60 |
|
|---|
| 61 |
|
|---|
| 62 |
|
|---|
| 63 |
|
|---|
| 64 |
|
|---|
| 65 |
|
|---|
| 66 |
|
|---|
| 67 |
|
|---|
| 68 |
|
|---|
| 69 |
|
|---|
| 70 |
|
|---|
| 71 |
|
|---|
| 72 |
|
|---|
| 73 |
|
|---|
| 74 |
|
|---|
| 75 |
|
|---|
| 76 |
|
|---|
| 77 |
|
|---|
| 78 |
|
|---|
| 79 |
|
|---|
| 80 |
|
|---|
| 81 |
|
|---|
| 82 |
|
|---|
| 83 |
|
|---|
| 84 |
|
|---|
| 85 |
|
|---|
| 86 |
|
|---|
| 87 |
|
|---|
| 88 |
|
|---|
| 89 |
|
|---|
| 90 |
|
|---|
| 91 |
|
|---|
| 92 |
|
|---|
| 93 |
|
|---|
| 94 |
|
|---|
| 95 |
|
|---|
| 96 |
|
|---|
| 97 |
|
|---|
| 98 |
|
|---|
| 99 |
|
|---|
| 100 |
|
|---|
| 101 |
|
|---|
| 102 |
|
|---|
| 103 |
|
|---|
| 104 |
|
|---|
| 105 |
|
|---|
| 106 |
|
|---|
| 107 |
|
|---|
| 108 |
|
|---|
| 109 |
|
|---|
| 110 |
|
|---|
| 111 |
|
|---|
| 112 |
|
|---|
| 113 |
|
|---|
| 114 |
|
|---|
| 115 |
|
|---|
| 116 |
|
|---|
| 117 |
|
|---|
| 118 |
|
|---|
| 119 |
|
|---|
| 120 |
|
|---|
| 121 |
|
|---|
| 122 |
|
|---|
| 123 |
|
|---|
| 124 |
|
|---|
| 125 |
|
|---|
| 126 |
|
|---|
| 127 |
|
|---|
| 128 |
|
|---|
| 129 |
|
|---|
| 130 |
|
|---|
| 131 |
|
|---|
| 132 |
|
|---|
| 133 |
|
|---|
| 134 |
|
|---|
| 135 |
|
|---|
| 136 |
|
|---|
| 137 |
|
|---|
| 138 |
|
|---|
| 139 |
|
|---|
| 140 |
|
|---|
| 141 |
|
|---|
| 142 |
|
|---|
| 143 |
|
|---|
| 144 |
|
|---|
| 145 |
|
|---|
| 146 |
|
|---|
| 147 |
|
|---|
| 148 |
|
|---|
| 149 |
|
|---|
| 150 |
|
|---|
| 151 |
|
|---|
| 152 |
|
|---|
| 153 |
|
|---|
| 154 |
|
|---|
| 155 |
|
|---|
| 156 |
|
|---|
| 157 |
|
|---|
| 158 |
|
|---|
| 159 |
|
|---|
| 160 |
|
|---|
| 161 |
|
|---|
| 162 |
|
|---|
| 163 |
|
|---|
| 164 |
|
|---|
| 165 |
|
|---|
| 166 |
|
|---|
| 167 |
|
|---|
| 168 |
|
|---|
| 169 |
|
|---|
| 170 |
|
|---|
| 171 |
|
|---|
| 172 |
|
|---|
| 173 |
|
|---|
| 174 |
|
|---|
| 175 |
(defvar checkdoc-version "0.6.1" |
|---|
| 176 |
"Release version of checkdoc you are currently running.") |
|---|
| 177 |
|
|---|
| 178 |
|
|---|
| 179 |
(eval-and-compile |
|---|
| 180 |
(condition-case () |
|---|
| 181 |
(require 'custom) |
|---|
| 182 |
(error nil)) |
|---|
| 183 |
(if (and (featurep 'custom) (fboundp 'custom-declare-variable)) |
|---|
| 184 |
nil |
|---|
| 185 |
|
|---|
| 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. |
|---|
| 204 |
If this value is the symbol `query', then the user is queried before |
|---|
| 205 |
any change is made. If the value is `automatic', then all changes are |
|---|
| 206 |
made without asking unless the change is very-complex. If the value |
|---|
| 207 |
is `semiautomatic' or any other value, then simple fixes are made |
|---|
| 208 |
without asking, and complex changes are made by asking the user first. |
|---|
| 209 |
The 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. |
|---|
| 218 |
Setting this to nil will silently make fixes that require no user |
|---|
| 219 |
interaction. 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. |
|---|
| 225 |
Style guide dictates that interactive functions MUST have documentation, |
|---|
| 226 |
and that it's good but not required practice to make non user visible items |
|---|
| 227 |
have 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. |
|---|
| 234 |
This 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. |
|---|
| 240 |
Ordinarily, a full sentence is required. This may be misleading when |
|---|
| 241 |
there is a substantial caveat to the one-line description -- the comma |
|---|
| 242 |
should be used when the first part could stand alone as a sentence, but |
|---|
| 243 |
it 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. |
|---|
| 250 |
This is automatically set to nil if Ispell does not exist on your |
|---|
| 251 |
system. 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" "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. |
|---|
| 271 |
Any 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. |
|---|
| 278 |
Setting this to nil will mean only checking that all the arguments |
|---|
| 279 |
appear in the proper form in the documentation, not that they are in |
|---|
| 280 |
the same order as they appear in the argument list. No mention is |
|---|
| 281 |
made 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. |
|---|
| 287 |
All hooks must return nil or a string representing the error found. |
|---|
| 288 |
Useful for adding new user implemented commands. |
|---|
| 289 |
|
|---|
| 290 |
Each hook is called with two parameters, (DEFUNINFO ENDPOINT). |
|---|
| 291 |
DEFUNINFO is the return value of `checkdoc-defun-info'. ENDPOINT is the |
|---|
| 292 |
location 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. |
|---|
| 296 |
Must return nil if no errors are found, or a string describing the |
|---|
| 297 |
problem 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. |
|---|
| 306 |
A 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. |
|---|
| 310 |
This check keys off some words which are commonly misused. See the |
|---|
| 311 |
variable `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. |
|---|
| 317 |
Do not set this by hand, use a function like `checkdoc-current-buffer' |
|---|
| 318 |
with a universal argument.") |
|---|
| 319 |
|
|---|
| 320 |
(defcustom checkdoc-symbol-words nil |
|---|
| 321 |
"A list of symbols which also happen to make good words. |
|---|
| 322 |
These symbol-words are ignored when unquoted symbols are searched for. |
|---|
| 323 |
This 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. |
|---|
| 425 |
Set `checkdoc-verb-check-experimental-flag' to nil to avoid this costly |
|---|
| 426 |
and experimental check. Do not modify this list without setting |
|---|
| 427 |
the value of `checkdoc-common-verbs-regexp' to nil which cause it to |
|---|
| 428 |
be 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 |
|
|---|
| 437 |
|
|---|
| 438 |
|
|---|
| 439 |
(modify-syntax-entry ?- "w" checkdoc-syntax-table) |
|---|
| 440 |
) |
|---|
| 441 |
|
|---|
| 442 |
|
|---|
| 443 |
|
|---|
| 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 |
|
|---|
| 461 |
|
|---|
| 462 |
|
|---|
| 463 |
(defun checkdoc () |
|---|
| 464 |
"Interactively check the entire buffer for style errors. |
|---|
| 465 |
The current status of the check will be displayed in a buffer which |
|---|
| 466 |
the users will view as each check is completed." |
|---|
| 467 |
(interactive) |
|---|
| 468 |
(let ((status (list "Checking..." "-" "-" "-")) |
|---|
| 469 |
(checkdoc-spellcheck-documentation-flag |
|---|
| 470 |
(car (memq checkdoc-spellcheck-documentation-flag |
|---|
| 471 |
'(buffer interactive t)))) |
|---|
| 472 |
|
|---|
| 473 |
|
|---|
| 474 |
|
|---|
| 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 |
|
|---|
| 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 |
|
|---|
| 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 |
|
|---|
| 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 |
|
|---|
| 503 |
(if (condition-case nil |
|---|
| 504 |
(checkdoc-rogue-spaces nil t) |
|---|
| 505 |
(error t)) |
|---|
| 506 |
(setcar (cdr (cdr (cdr status))) "Errors") |
|---|
| 507 |
(setcar (cdr (cdr (cdr status))) "Ok")) |
|---|
| 508 |
(checkdoc-display-status-buffer status))) |
|---|
| 509 |
|
|---|
| 510 |
(defun checkdoc-display-status-buffer (check) |
|---|
| 511 |
"Display and update the status buffer for the current checkdoc mode. |
|---|
| 512 |
CHECK is a list of four strings stating the current status of each |
|---|
| 513 |
test; 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 |
|
|---|
| 528 |
(defun checkdoc-interactive (&optional start-here showstatus) |
|---|
| 529 |
"Interactively check the current buffer for doc string errors. |
|---|
| 530 |
Prefix argument START-HERE will start the checking from the current |
|---|
| 531 |
point, otherwise the check starts at the beginning of the current |
|---|
| 532 |
buffer. Allows navigation forward and backwards through document |
|---|
| 533 |
errors. Does not check for comment or space warnings. |
|---|
| 534 |
Optional argument SHOWSTATUS indicates that we should update the |
|---|
| 535 |
checkdoc status window instead of the usual behavior." |
|---|
| 536 |
(interactive "P") |
|---|
| 537 |
(let ((checkdoc-spellcheck-documentation-flag |
|---|
| 538 |
(car (memq checkdoc-spellcheck-documentation-flag |
|---|
| 539 |
'(interactive t))))) |
|---|
| 540 |
(prog1 |
|---|
| 541 |
|
|---|
| 542 |
|
|---|
| 543 |
(checkdoc-interactive-loop start-here showstatus |
|---|
| 544 |
'checkdoc-next-error) |
|---|
| 545 |
|
|---|
| 546 |
(checkdoc-interactive-ispell-loop start-here)))) |
|---|
| 547 |
|
|---|
| 548 |
|
|---|
| 549 |
(defun checkdoc-message-interactive (&optional start-here showstatus) |
|---|
| 550 |
"Interactively check the current buffer for message string errors. |
|---|
| 551 |
Prefix argument START-HERE will start the checking from the current |
|---|
| 552 |
point, otherwise the check starts at the beginning of the current |
|---|
| 553 |
buffer. Allows navigation forward and backwards through document |
|---|
| 554 |
errors. Does not check for comment or space warnings. |
|---|
| 555 |
Optional argument SHOWSTATUS indicates that we should update the |
|---|
| 556 |
checkdoc 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 |
|
|---|
| 563 |
(checkdoc-interactive-loop start-here showstatus |
|---|
| 564 |
'checkdoc-next-message-error) |
|---|
| 565 |
|
|---|
| 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 |
|
|---|
| 571 |
If START-HERE is nil, searching starts at the beginning of the current |
|---|
| 572 |
buffer, otherwise searching starts at START-HERE. SHOWSTATUS |
|---|
| 573 |
expresses the verbosity of the search, and whether ending the search |
|---|
| 574 |
will auto-exit this function. |
|---|
| 575 |
|
|---|
| 576 |
FINDFUNC is a symbol representing a function that will position the |
|---|
| 577 |
cursor, and return error message text to present to the user. It is |
|---|
| 578 |
assumed that the cursor will stop just before a major sexp, which will |
|---|
| 579 |
be highlighted to present the user with feedback as to the offending |
|---|
| 580 |
style." |
|---|
| 581 |
|
|---|
| 582 |
(let* ((begin (prog1 (point) |
|---|
| 583 |
(if (not start-here) (goto-char (point-min))))) |
|---|
| 584 |
|
|---|
| 585 |
(checkdoc-spellcheck-documentation-flag |
|---|
| 586 |
(car (memq checkdoc-spellcheck-documentation-flag |
|---|
| 587 |
'(buffer interactive t)))) |
|---|
| 588 |
|
|---|
| 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 |
|
|---|
| 596 |
(beginning-of-defun) |
|---|
| 597 |
(while err-list |
|---|
| 598 |
(goto-char (cdr (car err-list))) |
|---|
| 599 |
|
|---|
| 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 |
|
|---|
| 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 |
|
|---|
| 635 |
((checkdoc-char= c ?\C-g) (signal 'quit nil)) |
|---|
| 636 |
|
|---|
| 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 |
|
|---|
| 642 |
|
|---|
| 643 |
|
|---|
| 644 |
|
|---|
| 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 |
|
|---|
| 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 |
|
|---|
| 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 |
|
|---|
| 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)) |
|---|
| 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 |
|
|---|
| 703 |
((checkdoc-char= c ?q) |
|---|
| 704 |
(setq returnme err-list |
|---|
| 705 |
err-list nil |
|---|
| 706 |
begin (point))) |
|---|
| 707 |
|
|---|
| 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< |
|---|