91 |
;; The variable `checkdoc-spellcheck-documentation-flag' can be set |
;; The variable `checkdoc-spellcheck-documentation-flag' can be set |
92 |
;; to customize how spell checking is to be done. Since spell |
;; to customize how spell checking is to be done. Since spell |
93 |
;; checking can be quite slow, you can optimize how best you want your |
;; checking can be quite slow, you can optimize how best you want your |
94 |
;; checking done. The default is 'defun, which spell checks each time |
;; checking done. The default is `defun', which spell checks each time |
95 |
;; `checkdoc-defun' or `checkdoc-eval-defun' is used. Setting to nil |
;; `checkdoc-defun' or `checkdoc-eval-defun' is used. Setting to nil |
96 |
;; prevents spell checking during normal usage. |
;; prevents spell checking during normal usage. |
97 |
;; Setting this variable to nil does not mean you cannot take |
;; Setting this variable to nil does not mean you cannot take |
301 |
:type 'boolean) |
:type 'boolean) |
302 |
|
|
303 |
(defvar checkdoc-generate-compile-warnings-flag nil |
(defvar checkdoc-generate-compile-warnings-flag nil |
304 |
"Non-nil means generage warnings in a buffer for browsing. |
"Non-nil means generate warnings in a buffer for browsing. |
305 |
Do not set this by hand, use a function like `checkdoc-current-buffer' |
Do not set this by hand, use a function like `checkdoc-current-buffer' |
306 |
with a universal argument.") |
with a universal argument.") |
307 |
|
|
426 |
;; end of a word in a conglomerate. |
;; end of a word in a conglomerate. |
427 |
(modify-syntax-entry ?- "w" checkdoc-syntax-table) |
(modify-syntax-entry ?- "w" checkdoc-syntax-table) |
428 |
) |
) |
429 |
|
|
430 |
|
|
431 |
;;; Compatibility |
;;; Compatibility |
432 |
;; |
;; |
461 |
;; |
;; |
462 |
;;;###autoload |
;;;###autoload |
463 |
(defun checkdoc () |
(defun checkdoc () |
464 |
"Interactivly check the entire buffer for style errors. |
"Interactively check the entire buffer for style errors. |
465 |
The current status of the ckeck will be displayed in a buffer which |
The current status of the check will be displayed in a buffer which |
466 |
the users will view as each check is completed." |
the users will view as each check is completed." |
467 |
(interactive) |
(interactive) |
468 |
(let ((status (list "Checking..." "-" "-" "-")) |
(let ((status (list "Checking..." "-" "-" "-")) |
469 |
(checkdoc-spellcheck-documentation-flag |
(checkdoc-spellcheck-documentation-flag |
470 |
(member checkdoc-spellcheck-documentation-flag |
(car (memq checkdoc-spellcheck-documentation-flag |
471 |
'(buffer interactive t))) |
'(buffer interactive t)))) |
472 |
;; if the user set autofix to never, then that breaks the |
;; if the user set autofix to never, then that breaks the |
473 |
;; obviously requested asking implied by using this function. |
;; obviously requested asking implied by using this function. |
474 |
;; Set it to paranoia level. |
;; Set it to paranoia level. |
509 |
|
|
510 |
(defun checkdoc-display-status-buffer (check) |
(defun checkdoc-display-status-buffer (check) |
511 |
"Display and update the status buffer for the current checkdoc mode. |
"Display and update the status buffer for the current checkdoc mode. |
512 |
CHECK is a vector stating the current status of each test as an |
CHECK is a list of four strings stating the current status of each |
513 |
element is the status of that level of teset." |
test; the nth string describes the status of the nth test." |
514 |
(let (temp-buffer-setup-hook) |
(let (temp-buffer-setup-hook) |
515 |
(with-output-to-temp-buffer " *Checkdoc Status*" |
(with-output-to-temp-buffer " *Checkdoc Status*" |
516 |
(princ-list |
(princ-list |
535 |
checkdoc status window instead of the usual behavior." |
checkdoc status window instead of the usual behavior." |
536 |
(interactive "P") |
(interactive "P") |
537 |
(let ((checkdoc-spellcheck-documentation-flag |
(let ((checkdoc-spellcheck-documentation-flag |
538 |
(member checkdoc-spellcheck-documentation-flag |
(car (memq checkdoc-spellcheck-documentation-flag |
539 |
'(interactive t)))) |
'(interactive t))))) |
540 |
(checkdoc-interactive-loop start-here showstatus 'checkdoc-next-error))) |
(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 |
;;;###autoload |
549 |
(defun checkdoc-message-interactive (&optional start-here showstatus) |
(defun checkdoc-message-interactive (&optional start-here showstatus) |
556 |
checkdoc status window instead of the usual behavior." |
checkdoc status window instead of the usual behavior." |
557 |
(interactive "P") |
(interactive "P") |
558 |
(let ((checkdoc-spellcheck-documentation-flag |
(let ((checkdoc-spellcheck-documentation-flag |
559 |
(member checkdoc-spellcheck-documentation-flag |
(car (memq checkdoc-spellcheck-documentation-flag |
560 |
'(interactive t)))) |
'(interactive t))))) |
561 |
(checkdoc-interactive-loop start-here showstatus |
(prog1 |
562 |
'checkdoc-next-message-error))) |
;; 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) |
(defun checkdoc-interactive-loop (start-here showstatus findfunc) |
569 |
"Interactivly loop over all errors that can be found by a given method. |
"Interactively loop over all errors that can be found by a given method. |
570 |
Searching starts at START-HERE. SHOWSTATUS expresses the verbosity |
|
571 |
of the search, and wether ending the search will auto-exit this function. |
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 |
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 |
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 |
assumed that the cursor will stop just before a major sexp, which will |
583 |
(if (not start-here) (goto-char (point-min))))) |
(if (not start-here) (goto-char (point-min))))) |
584 |
;; Assign a flag to spellcheck flag |
;; Assign a flag to spellcheck flag |
585 |
(checkdoc-spellcheck-documentation-flag |
(checkdoc-spellcheck-documentation-flag |
586 |
(member checkdoc-spellcheck-documentation-flag |
(car (memq checkdoc-spellcheck-documentation-flag |
587 |
'(buffer interactive t))) |
'(buffer interactive t)))) |
588 |
;; Fetch the error list |
;; Fetch the error list |
589 |
(err-list (list (funcall findfunc nil))) |
(err-list (list (funcall findfunc nil))) |
590 |
(cdo nil) |
(cdo nil) |
628 |
(goto-char (checkdoc-error-start (car (car err-list)))) |
(goto-char (checkdoc-error-start (car (car err-list)))) |
629 |
(if (not (pos-visible-in-window-p)) |
(if (not (pos-visible-in-window-p)) |
630 |
(recenter (- (window-height) 2))) |
(recenter (- (window-height) 2))) |
631 |
(setq c (checkdoc-read-event)))1 |
(setq c (checkdoc-read-event))) |
632 |
(if (not (integerp c)) (setq c ??)) |
(if (not (integerp c)) (setq c ??)) |
633 |
(cond |
(cond |
634 |
;; Exit condition |
;; Exit condition |
640 |
(goto-char (cdr (car err-list))) |
(goto-char (cdr (car err-list))) |
641 |
;; `automatic-then-never' tells the autofix function |
;; `automatic-then-never' tells the autofix function |
642 |
;; to only allow one fix to be automatic. The autofix |
;; to only allow one fix to be automatic. The autofix |
643 |
;; function will than set the flag to 'never, allowing |
;; function will then set the flag to 'never, allowing |
644 |
;; the checker to return a different error. |
;; the checker to return a different error. |
645 |
(let ((checkdoc-autofix-flag 'automatic-then-never) |
(let ((checkdoc-autofix-flag 'automatic-then-never) |
646 |
(fixed nil)) |
(fixed nil)) |
705 |
(setq returnme err-list |
(setq returnme err-list |
706 |
err-list nil |
err-list nil |
707 |
begin (point))) |
begin (point))) |
708 |
;; Goofy s tuff |
;; Goofy stuff |
709 |
(t |
(t |
710 |
(if (get-buffer-window "*Checkdoc Help*") |
(if (get-buffer-window "*Checkdoc Help*") |
711 |
(progn |
(progn |
734 |
(message "Checkdoc: Done.") |
(message "Checkdoc: Done.") |
735 |
returnme)) |
returnme)) |
736 |
|
|
737 |
|
(defun checkdoc-interactive-ispell-loop (start-here) |
738 |
|
"Interactively spell check doc strings in the current buffer. |
739 |
|
If START-HERE is nil, searching starts at the beginning of the current |
740 |
|
buffer, otherwise searching starts at START-HERE." |
741 |
|
(when checkdoc-spellcheck-documentation-flag |
742 |
|
(save-excursion |
743 |
|
;; Move point to where we need to start. |
744 |
|
(if start-here |
745 |
|
;; Include whatever function point is in for good measure. |
746 |
|
(beginning-of-defun) |
747 |
|
(goto-char (point-min))) |
748 |
|
;; Loop over docstrings. |
749 |
|
(while (checkdoc-next-docstring) |
750 |
|
(message "Searching for doc string spell error...%d%%" |
751 |
|
(/ (* 100 (point)) (point-max))) |
752 |
|
(if (looking-at "\"") |
753 |
|
(checkdoc-ispell-docstring-engine |
754 |
|
(save-excursion (forward-sexp 1) (point-marker))))) |
755 |
|
(message "Checkdoc: Done.")))) |
756 |
|
|
757 |
|
(defun checkdoc-message-interactive-ispell-loop (start-here) |
758 |
|
"Interactively spell check messages in the current buffer. |
759 |
|
If START-HERE is nil, searching starts at the beginning of the current |
760 |
|
buffer, otherwise searching starts at START-HERE." |
761 |
|
(when checkdoc-spellcheck-documentation-flag |
762 |
|
(save-excursion |
763 |
|
;; Move point to where we need to start. |
764 |
|
(if start-here |
765 |
|
;; Include whatever function point is in for good measure. |
766 |
|
(beginning-of-defun) |
767 |
|
(goto-char (point-min))) |
768 |
|
;; Loop over message strings. |
769 |
|
(while (checkdoc-message-text-next-string (point-max)) |
770 |
|
(message "Searching for message string spell error...%d%%" |
771 |
|
(/ (* 100 (point)) (point-max))) |
772 |
|
(if (looking-at "\"") |
773 |
|
(checkdoc-ispell-docstring-engine |
774 |
|
(save-excursion (forward-sexp 1) (point-marker))))) |
775 |
|
(message "Checkdoc: Done.")))) |
776 |
|
|
777 |
|
|
778 |
(defun checkdoc-next-error (enable-fix) |
(defun checkdoc-next-error (enable-fix) |
779 |
"Find and return the next checkdoc error list, or nil. |
"Find and return the next checkdoc error list, or nil. |
780 |
Only documentation strings are checked. |
Only documentation strings are checked. |
781 |
Add error vector is of the form (WARNING . POSITION) where WARNING |
An error list is of the form (WARNING . POSITION) where WARNING is the |
782 |
is the warning text, and POSITION is the point in the buffer where the |
warning text, and POSITION is the point in the buffer where the error |
783 |
error was found. We can use points and not markers because we promise |
was found. We can use points and not markers because we promise not |
784 |
not to edit the buffer before point without re-executing this check. |
to edit the buffer before point without re-executing this check. |
785 |
Argument ENABLE-FIX will enable auto-fixing while looking for the next |
Argument ENABLE-FIX will enable auto-fixing while looking for the next |
786 |
error. This argument assumes that the cursor is already positioned to |
error. This argument assumes that the cursor is already positioned to |
787 |
perform the fix." |
perform the fix." |
858 |
(if (interactive-p) (message "Checking buffer for style...")) |
(if (interactive-p) (message "Checking buffer for style...")) |
859 |
;; Assign a flag to spellcheck flag |
;; Assign a flag to spellcheck flag |
860 |
(let ((checkdoc-spellcheck-documentation-flag |
(let ((checkdoc-spellcheck-documentation-flag |
861 |
(memq checkdoc-spellcheck-documentation-flag '(buffer t))) |
(car (memq checkdoc-spellcheck-documentation-flag |
862 |
|
'(buffer t)))) |
863 |
(checkdoc-autofix-flag (if take-notes 'never |
(checkdoc-autofix-flag (if take-notes 'never |
864 |
checkdoc-autofix-flag)) |
checkdoc-autofix-flag)) |
865 |
(checkdoc-generate-compile-warnings-flag |
(checkdoc-generate-compile-warnings-flag |
903 |
(let ((wrong nil) (msg nil) (errors nil) |
(let ((wrong nil) (msg nil) (errors nil) |
904 |
;; Assign a flag to spellcheck flag |
;; Assign a flag to spellcheck flag |
905 |
(checkdoc-spellcheck-documentation-flag |
(checkdoc-spellcheck-documentation-flag |
906 |
(member checkdoc-spellcheck-documentation-flag |
(car (memq checkdoc-spellcheck-documentation-flag |
907 |
'(buffer t))) |
'(buffer t)))) |
908 |
(checkdoc-autofix-flag (if take-notes 'never |
(checkdoc-autofix-flag (if take-notes 'never |
909 |
checkdoc-autofix-flag)) |
checkdoc-autofix-flag)) |
910 |
(checkdoc-generate-compile-warnings-flag |
(checkdoc-generate-compile-warnings-flag |
947 |
(if (not buffer-file-name) |
(if (not buffer-file-name) |
948 |
(error "Can only check comments for a file buffer")) |
(error "Can only check comments for a file buffer")) |
949 |
(let* ((checkdoc-spellcheck-documentation-flag |
(let* ((checkdoc-spellcheck-documentation-flag |
950 |
(member checkdoc-spellcheck-documentation-flag |
(car (memq checkdoc-spellcheck-documentation-flag |
951 |
'(buffer t))) |
'(buffer t)))) |
952 |
(checkdoc-autofix-flag (if take-notes 'never checkdoc-autofix-flag)) |
(checkdoc-autofix-flag (if take-notes 'never checkdoc-autofix-flag)) |
953 |
(e (checkdoc-file-comments-engine)) |
(e (checkdoc-file-comments-engine)) |
954 |
(checkdoc-generate-compile-warnings-flag |
(checkdoc-generate-compile-warnings-flag |
995 |
(checkdoc-show-diagnostics))) |
(checkdoc-show-diagnostics))) |
996 |
(goto-char p)) |
(goto-char p)) |
997 |
(if (interactive-p) (message "Checking interactive message text...done."))) |
(if (interactive-p) (message "Checking interactive message text...done."))) |
998 |
|
|
999 |
;;;###autoload |
;;;###autoload |
1000 |
(defun checkdoc-eval-defun () |
(defun checkdoc-eval-defun () |
1001 |
"Evaluate the current form with `eval-defun' and check its documentation. |
"Evaluate the current form with `eval-defun' and check its documentation. |
1027 |
(forward-sexp 1) |
(forward-sexp 1) |
1028 |
(skip-chars-forward " \n\t") |
(skip-chars-forward " \n\t") |
1029 |
(let* ((checkdoc-spellcheck-documentation-flag |
(let* ((checkdoc-spellcheck-documentation-flag |
1030 |
(member checkdoc-spellcheck-documentation-flag |
(car (memq checkdoc-spellcheck-documentation-flag |
1031 |
'(defun t))) |
'(defun t)))) |
1032 |
(beg (save-excursion (beginning-of-defun) (point))) |
(beg (save-excursion (beginning-of-defun) (point))) |
1033 |
(end (save-excursion (end-of-defun) (point))) |
(end (save-excursion (end-of-defun) (point))) |
1034 |
(msg (checkdoc-this-string-valid))) |
(msg (checkdoc-this-string-valid))) |
1203 |
map) |
map) |
1204 |
"Keymap used to override evaluation key-bindings for documentation checking.") |
"Keymap used to override evaluation key-bindings for documentation checking.") |
1205 |
|
|
1206 |
(defvar checkdoc-minor-keymap checkdoc-minor-mode-map |
(defvaralias 'checkdoc-minor-keymap 'checkdoc-minor-mode-map) |
1207 |
"Obsolete! Use `checkdoc-minor-mode-map'.") |
(make-obsolete-variable 'checkdoc-minor-keymap |
1208 |
|
'checkdoc-minor-mode-map) |
1209 |
|
|
1210 |
;; Add in a menubar with easy-menu |
;; Add in a menubar with easy-menu |
1211 |
|
|
1212 |
(easy-menu-define |
(easy-menu-define |
1213 |
checkdoc-minor-menu checkdoc-minor-mode-map "Checkdoc Minor Mode Menu" |
nil checkdoc-minor-mode-map "Checkdoc Minor Mode Menu" |
1214 |
'("CheckDoc" |
'("CheckDoc" |
1215 |
["Interactive Buffer Style Check" checkdoc t] |
["Interactive Buffer Style Check" checkdoc t] |
1216 |
["Interactive Buffer Style and Spelling Check" checkdoc-ispell t] |
["Interactive Buffer Style and Spelling Check" checkdoc-ispell t] |
1251 |
checking of documentation strings. |
checking of documentation strings. |
1252 |
|
|
1253 |
\\{checkdoc-minor-mode-map}" |
\\{checkdoc-minor-mode-map}" |
1254 |
nil " CDoc" nil) |
nil " CDoc" nil |
1255 |
|
:group 'checkdoc) |
1256 |
|
|
1257 |
;;; Subst utils |
;;; Subst utils |
1258 |
;; |
;; |
1656 |
(concat (car fp) "-flag")))) |
(concat (car fp) "-flag")))) |
1657 |
(if (checkdoc-y-or-n-p |
(if (checkdoc-y-or-n-p |
1658 |
(format |
(format |
1659 |
"Rename to %s and Query-Replace all occurances? " |
"Rename to %s and Query-Replace all occurrences? " |
1660 |
newname)) |
newname)) |
1661 |
(progn |
(progn |
1662 |
(beginning-of-defun) |
(beginning-of-defun) |
1762 |
;; it occurs last. |
;; it occurs last. |
1763 |
(and checkdoc-verb-check-experimental-flag |
(and checkdoc-verb-check-experimental-flag |
1764 |
(save-excursion |
(save-excursion |
1765 |
;; Maybe rebuild the monster-regex |
;; Maybe rebuild the monster-regexp |
1766 |
(checkdoc-create-common-verbs-regexp) |
(checkdoc-create-common-verbs-regexp) |
1767 |
(let ((lim (save-excursion |
(let ((lim (save-excursion |
1768 |
(end-of-line) |
(end-of-line) |
2392 |
(while (setq type (checkdoc-message-text-next-string end)) |
(while (setq type (checkdoc-message-text-next-string end)) |
2393 |
(setq e (checkdoc-message-text-engine type))) |
(setq e (checkdoc-message-text-engine type))) |
2394 |
e)) |
e)) |
2395 |
|
|
2396 |
(defun checkdoc-message-text-next-string (end) |
(defun checkdoc-message-text-next-string (end) |
2397 |
"Move cursor to the next checkable message string after point. |
"Move cursor to the next checkable message string after point. |
2398 |
Return the message classification. |
Return the message classification. |
2639 |
(if (looking-at "\\(\\(\\w+\\|\\s_\\)+\\.el\\):\\([0-9]+\\):") |
(if (looking-at "\\(\\(\\w+\\|\\s_\\)+\\.el\\):\\([0-9]+\\):") |
2640 |
(let ((l (string-to-int (match-string 3))) |
(let ((l (string-to-int (match-string 3))) |
2641 |
(f (match-string 1))) |
(f (match-string 1))) |
2642 |
(if (not (get-buffer f)) |
(if (not (get-file-buffer f)) |
2643 |
(error "Can't find buffer %s" f)) |
(error "Can't find buffer %s" f)) |
2644 |
(switch-to-buffer-other-window (get-buffer f)) |
(switch-to-buffer-other-window (get-file-buffer f)) |
2645 |
(goto-line l)))) |
(goto-line l)))) |
2646 |
|
|
2647 |
(defun checkdoc-buffer-label () |
(defun checkdoc-buffer-label () |