-;;; checkdoc --- Check documentation strings for style requirements
+;;; checkdoc.el --- check documentation strings for style requirements
;;; Copyright (C) 1997, 1998, 2001 Free Software Foundation
;; The variable `checkdoc-spellcheck-documentation-flag' can be set
;; to customize how spell checking is to be done. Since spell
;; checking can be quite slow, you can optimize how best you want your
-;; checking done. The default is 'defun, which spell checks each time
+;; checking done. The default is `defun', which spell checks each time
;; `checkdoc-defun' or `checkdoc-eval-defun' is used. Setting to nil
;; prevents spell checking during normal usage.
;; Setting this variable to nil does not mean you cannot take
;; From custom web page for compatibility between versions of custom:
(eval-and-compile
- (condition-case ()
- (require 'custom)
- (error nil))
- (if (and (featurep 'custom) (fboundp 'custom-declare-variable))
- nil ;; We've got what we needed
- ;; We have the old custom-library, hack around it!
- (defmacro defgroup (&rest args)
- nil)
- (defmacro custom-add-option (&rest args)
- nil)
- (defmacro defcustom (var value doc &rest args)
- (` (defvar (, var) (, value) (, doc))))))
+ (condition-case ()
+ (require 'custom)
+ (error nil))
+ (if (and (featurep 'custom) (fboundp 'custom-declare-variable))
+ nil ;; We've got what we needed
+ ;; We have the old custom-library, hack around it!
+ (defmacro defgroup (&rest args)
+ nil)
+ (defmacro custom-add-option (&rest args)
+ nil)
+ (defmacro defcustom (var value doc &rest args)
+ `(defvar ,var ,value ,doc))))
(defcustom checkdoc-autofix-flag 'semiautomatic
"*Non-nil means attempt auto-fixing of doc strings.
:type 'boolean)
(defvar checkdoc-generate-compile-warnings-flag nil
- "Non-nil means generage warnings in a buffer for browsing.
+ "Non-nil means generate warnings in a buffer for browsing.
Do not set this by hand, use a function like `checkdoc-current-buffer'
with a universal argument.")
;; end of a word in a conglomerate.
(modify-syntax-entry ?- "w" checkdoc-syntax-table)
)
-
+
;;; Compatibility
;;
(defalias 'checkdoc-call-eval-buffer 'eval-current-buffer)
)
-;; Emacs 20 has this handy function.
-(if (not (fboundp 'princ-list))
- (defun princ-list (&rest args)
- "Call `princ' on ARGS."
- (mapcar 'princ args)))
-
;; Emacs 20s have MULE characters which don't equate to numbers.
(if (fboundp 'char=)
(defalias 'checkdoc-char= 'char=)
(defalias 'checkdoc-char= '=))
-;; Emacs 19.28 and earlier don't have the handy 'add-to-list function
-(if (fboundp 'add-to-list)
-
- (defalias 'checkdoc-add-to-list 'add-to-list)
-
- (defun checkdoc-add-to-list (list-var element)
- "Add to the value of LIST-VAR the element ELEMENT if it isn't there yet."
- (if (not (member element (symbol-value list-var)))
- (set list-var (cons element (symbol-value list-var)))))
- )
-
-;; To be safe in new Emacsen, we want to read events, not characters
-(if (fboundp 'read-event)
- (defalias 'checkdoc-read-event 'read-event)
- (defalias 'checkdoc-read-event 'read-char))
+;; Read events, not characters
+(defalias 'checkdoc-read-event 'read-event)
;;; User level commands
;;
;;;###autoload
(defun checkdoc ()
- "Interactivly check the entire buffer for style errors.
-The current status of the ckeck will be displayed in a buffer which
+ "Interactively check the entire buffer for style errors.
+The current status of the check will be displayed in a buffer which
the users will view as each check is completed."
(interactive)
(let ((status (list "Checking..." "-" "-" "-"))
(checkdoc-spellcheck-documentation-flag
- (member checkdoc-spellcheck-documentation-flag
- '(buffer interactive t)))
+ (car (memq checkdoc-spellcheck-documentation-flag
+ '(buffer interactive t))))
;; if the user set autofix to never, then that breaks the
;; obviously requested asking implied by using this function.
;; Set it to paranoia level.
(defun checkdoc-display-status-buffer (check)
"Display and update the status buffer for the current checkdoc mode.
-CHECK is a vector stating the current status of each test as an
-element is the status of that level of teset."
+CHECK is a list of four strings stating the current status of each
+test; the nth string describes the status of the nth test."
(let (temp-buffer-setup-hook)
(with-output-to-temp-buffer " *Checkdoc Status*"
(princ-list
checkdoc status window instead of the usual behavior."
(interactive "P")
(let ((checkdoc-spellcheck-documentation-flag
- (member checkdoc-spellcheck-documentation-flag
- '(interactive t))))
- (checkdoc-interactive-loop start-here showstatus 'checkdoc-next-error)))
+ (car (memq checkdoc-spellcheck-documentation-flag
+ '(interactive t)))))
+ (prog1
+ ;; Due to a design flaw, this will never spell check
+ ;; docstrings.
+ (checkdoc-interactive-loop start-here showstatus
+ 'checkdoc-next-error)
+ ;; This is a workaround to perform spell checking.
+ (checkdoc-interactive-ispell-loop start-here))))
;;;###autoload
(defun checkdoc-message-interactive (&optional start-here showstatus)
checkdoc status window instead of the usual behavior."
(interactive "P")
(let ((checkdoc-spellcheck-documentation-flag
- (member checkdoc-spellcheck-documentation-flag
- '(interactive t))))
- (checkdoc-interactive-loop start-here showstatus
- 'checkdoc-next-message-error)))
+ (car (memq checkdoc-spellcheck-documentation-flag
+ '(interactive t)))))
+ (prog1
+ ;; Due to a design flaw, this will never spell check messages.
+ (checkdoc-interactive-loop start-here showstatus
+ 'checkdoc-next-message-error)
+ ;; This is a workaround to perform spell checking.
+ (checkdoc-message-interactive-ispell-loop start-here))))
(defun checkdoc-interactive-loop (start-here showstatus findfunc)
- "Interactivly loop over all errors that can be found by a given method.
-Searching starts at START-HERE. SHOWSTATUS expresses the verbosity
-of the search, and wether ending the search will auto-exit this function.
+ "Interactively loop over all errors that can be found by a given method.
+
+If START-HERE is nil, searching starts at the beginning of the current
+buffer, otherwise searching starts at START-HERE. SHOWSTATUS
+expresses the verbosity of the search, and whether ending the search
+will auto-exit this function.
+
FINDFUNC is a symbol representing a function that will position the
-cursor, and return error message text to present the the user. It is
+cursor, and return error message text to present to the user. It is
assumed that the cursor will stop just before a major sexp, which will
be highlighted to present the user with feedback as to the offending
style."
(if (not start-here) (goto-char (point-min)))))
;; Assign a flag to spellcheck flag
(checkdoc-spellcheck-documentation-flag
- (member checkdoc-spellcheck-documentation-flag
- '(buffer interactive t)))
+ (car (memq checkdoc-spellcheck-documentation-flag
+ '(buffer interactive t))))
;; Fetch the error list
(err-list (list (funcall findfunc nil)))
(cdo nil)
(goto-char (checkdoc-error-start (car (car err-list))))
(if (not (pos-visible-in-window-p))
(recenter (- (window-height) 2)))
- (setq c (checkdoc-read-event)))1
+ (setq c (checkdoc-read-event)))
(if (not (integerp c)) (setq c ??))
(cond
;; Exit condition
(goto-char (cdr (car err-list)))
;; `automatic-then-never' tells the autofix function
;; to only allow one fix to be automatic. The autofix
- ;; function will than set the flag to 'never, allowing
+ ;; function will then set the flag to 'never, allowing
;; the checker to return a different error.
(let ((checkdoc-autofix-flag 'automatic-then-never)
(fixed nil))
(setq returnme err-list
err-list nil
begin (point)))
- ;; Goofy s tuff
+ ;; Goofy stuff
(t
(if (get-buffer-window "*Checkdoc Help*")
(progn
(message "Checkdoc: Done.")
returnme))
+(defun checkdoc-interactive-ispell-loop (start-here)
+ "Interactively spell check doc strings in the current buffer.
+If START-HERE is nil, searching starts at the beginning of the current
+buffer, otherwise searching starts at START-HERE."
+ (when checkdoc-spellcheck-documentation-flag
+ (save-excursion
+ ;; Move point to where we need to start.
+ (if start-here
+ ;; Include whatever function point is in for good measure.
+ (beginning-of-defun)
+ (goto-char (point-min)))
+ ;; Loop over docstrings.
+ (while (checkdoc-next-docstring)
+ (message "Searching for doc string spell error...%d%%"
+ (/ (* 100 (point)) (point-max)))
+ (if (looking-at "\"")
+ (checkdoc-ispell-docstring-engine
+ (save-excursion (forward-sexp 1) (point-marker)))))
+ (message "Checkdoc: Done."))))
+
+(defun checkdoc-message-interactive-ispell-loop (start-here)
+ "Interactively spell check messages in the current buffer.
+If START-HERE is nil, searching starts at the beginning of the current
+buffer, otherwise searching starts at START-HERE."
+ (when checkdoc-spellcheck-documentation-flag
+ (save-excursion
+ ;; Move point to where we need to start.
+ (if start-here
+ ;; Include whatever function point is in for good measure.
+ (beginning-of-defun)
+ (goto-char (point-min)))
+ ;; Loop over message strings.
+ (while (checkdoc-message-text-next-string (point-max))
+ (message "Searching for message string spell error...%d%%"
+ (/ (* 100 (point)) (point-max)))
+ (if (looking-at "\"")
+ (checkdoc-ispell-docstring-engine
+ (save-excursion (forward-sexp 1) (point-marker)))))
+ (message "Checkdoc: Done."))))
+
+
(defun checkdoc-next-error (enable-fix)
"Find and return the next checkdoc error list, or nil.
Only documentation strings are checked.
-Add error vector is of the form (WARNING . POSITION) where WARNING
-is the warning text, and POSITION is the point in the buffer where the
-error was found. We can use points and not markers because we promise
-not to edit the buffer before point without re-executing this check.
+An error list is of the form (WARNING . POSITION) where WARNING is the
+warning text, and POSITION is the point in the buffer where the error
+was found. We can use points and not markers because we promise not
+to edit the buffer before point without re-executing this check.
Argument ENABLE-FIX will enable auto-fixing while looking for the next
error. This argument assumes that the cursor is already positioned to
perform the fix."
msg)))
(defun checkdoc-next-message-error (enable-fix)
- "Find and return the next checkdoc mesasge related error list, or nil.
+ "Find and return the next checkdoc message related error list, or nil.
Only text for error and `y-or-n-p' strings are checked. See
`checkdoc-next-error' for details on the return value.
Argument ENABLE-FIX turns on the auto-fix feature. This argument
(if (interactive-p) (message "Checking buffer for style..."))
;; Assign a flag to spellcheck flag
(let ((checkdoc-spellcheck-documentation-flag
- (memq checkdoc-spellcheck-documentation-flag '(buffer t)))
+ (car (memq checkdoc-spellcheck-documentation-flag
+ '(buffer t))))
(checkdoc-autofix-flag (if take-notes 'never
checkdoc-autofix-flag))
(checkdoc-generate-compile-warnings-flag
(let ((wrong nil) (msg nil) (errors nil)
;; Assign a flag to spellcheck flag
(checkdoc-spellcheck-documentation-flag
- (member checkdoc-spellcheck-documentation-flag
- '(buffer t)))
+ (car (memq checkdoc-spellcheck-documentation-flag
+ '(buffer t))))
(checkdoc-autofix-flag (if take-notes 'never
checkdoc-autofix-flag))
(checkdoc-generate-compile-warnings-flag
(if (not buffer-file-name)
(error "Can only check comments for a file buffer"))
(let* ((checkdoc-spellcheck-documentation-flag
- (member checkdoc-spellcheck-documentation-flag
- '(buffer t)))
+ (car (memq checkdoc-spellcheck-documentation-flag
+ '(buffer t))))
(checkdoc-autofix-flag (if take-notes 'never checkdoc-autofix-flag))
(e (checkdoc-file-comments-engine))
(checkdoc-generate-compile-warnings-flag
(checkdoc-show-diagnostics)))
(goto-char p))
(if (interactive-p) (message "Checking interactive message text...done.")))
-
+
;;;###autoload
(defun checkdoc-eval-defun ()
"Evaluate the current form with `eval-defun' and check its documentation.
documentation is checked. If there is a documentation error, then the display
of what was evaluated will be overwritten by the diagnostic message."
(interactive)
- (eval-defun nil)
+ (call-interactively 'eval-defun)
(checkdoc-defun))
;;;###autoload
(forward-sexp 1)
(skip-chars-forward " \n\t")
(let* ((checkdoc-spellcheck-documentation-flag
- (member checkdoc-spellcheck-documentation-flag
- '(defun t)))
+ (car (memq checkdoc-spellcheck-documentation-flag
+ '(defun t))))
(beg (save-excursion (beginning-of-defun) (point)))
(end (save-excursion (end-of-defun) (point)))
(msg (checkdoc-this-string-valid)))
map)
"Keymap used to override evaluation key-bindings for documentation checking.")
-(defvar checkdoc-minor-keymap checkdoc-minor-mode-map
- "Obsolete! Use `checkdoc-minor-mode-map'.")
+(defvaralias 'checkdoc-minor-keymap 'checkdoc-minor-mode-map)
+(make-obsolete-variable 'checkdoc-minor-keymap
+ 'checkdoc-minor-mode-map)
;; Add in a menubar with easy-menu
(easy-menu-define
- checkdoc-minor-menu checkdoc-minor-mode-map "Checkdoc Minor Mode Menu"
+ nil checkdoc-minor-mode-map "Checkdoc Minor Mode Menu"
'("CheckDoc"
["Interactive Buffer Style Check" checkdoc t]
["Interactive Buffer Style and Spelling Check" checkdoc-ispell t]
;; What is it?
;;;###autoload
-(easy-mmode-define-minor-mode checkdoc-minor-mode
+(define-minor-mode checkdoc-minor-mode
"Toggle Checkdoc minor mode, a mode for checking Lisp doc strings.
With prefix ARG, turn Checkdoc minor mode on iff ARG is positive.
checking of documentation strings.
\\{checkdoc-minor-mode-map}"
- nil " CDoc" nil)
+ nil " CDoc" nil
+ :group 'checkdoc)
;;; Subst utils
;;
"Second line should not have indentation"
(match-beginning 1)
(match-end 1)))))
+ ;; * Check for '(' in column 0.
+ (save-excursion
+ (when (re-search-forward "^(" e t)
+ (if (checkdoc-autofix-ask-replace (match-beginning 0)
+ (match-end 0)
+ "Escape this '('? "
+ "\\(")
+ nil
+ (checkdoc-create-error
+ "Open parenthesis in column 0 should be escaped"
+ (match-beginning 0) (match-end 0)))))
;; * Do not start or end a documentation string with whitespace.
(let (start end)
(if (or (if (looking-at "\"\\([ \t\n]+\\)")
;; If the doc string starts with "Non-nil means"
(if (and (looking-at "\"\\*?Non-nil\\s-+means\\s-+")
(not (string-match "-flag$" (car fp))))
- (if (checkdoc-y-or-n-p
- (format
- "Rename to %s and Query-Replace all occurances? "
- (concat (car fp) "-flag")))
- (progn
- (beginning-of-defun)
- (query-replace-regexp
- (concat "\\<" (regexp-quote (car fp)) "\\>")
- (concat (car fp) "-flag")))
- (checkdoc-create-error
- "Flag variable names should normally end in `-flag'" s
- (marker-position e))))
+ (let ((newname
+ (if (string-match "-p$" (car fp))
+ (concat (substring (car fp) 0 -2) "-flag")
+ (concat (car fp) "-flag"))))
+ (if (checkdoc-y-or-n-p
+ (format
+ "Rename to %s and Query-Replace all occurrences? "
+ newname))
+ (progn
+ (beginning-of-defun)
+ (query-replace-regexp
+ (concat "\\<" (regexp-quote (car fp)) "\\>")
+ newname))
+ (checkdoc-create-error
+ "Flag variable names should normally end in `-flag'" s
+ (marker-position e)))))
;; Done with variables
))
(t
;; Require whitespace OR
;; ITEMth<space> OR
;; ITEMs<space>
- "\\(\\>\\|th\\>\\|s\\>\\)")
+ "\\(\\>\\|th\\>\\|s\\>\\|[.,;:]\\)")
e t)))
(if (not found)
(let ((case-fold-search t))
;; it occurs last.
(and checkdoc-verb-check-experimental-flag
(save-excursion
- ;; Maybe rebuild the monster-regex
+ ;; Maybe rebuild the monster-regexp
(checkdoc-create-common-verbs-regexp)
(let ((lim (save-excursion
(end-of-line)
(progn
(set-syntax-table checkdoc-syntax-table)
(goto-char begin)
- (while (re-search-forward "[^.0-9]\\(\\. \\)[^ \n]" end t)
+ (while (re-search-forward "[^ .0-9]\\(\\. \\)[^ \n]" end t)
(let ((b (match-beginning 1))
(e (match-end 1)))
- (if (and (not (checkdoc-in-sample-code-p begin end))
- (not (checkdoc-in-example-string-p begin end))
- (not (save-excursion
- (goto-char (match-beginning 1))
- (condition-case nil
- (progn
- (forward-sexp -1)
- ;; piece of an abbreviation
- (looking-at
- "\\([a-z]\\|[iI]\\.?e\\|[eE]\\.?g\\)\\."))
- (error t)))))
- (if (checkdoc-autofix-ask-replace
- b e
- "There should be two spaces after a period. Fix? "
- ". ")
- nil
- (if errtxt
- ;; If there is already an error, then generate
- ;; the warning output if applicable
- (if checkdoc-generate-compile-warnings-flag
- (checkdoc-create-error
- "There should be two spaces after a period"
- b e))
- (setq errtxt
- "There should be two spaces after a period"
- bb b be e)))))))
+ (unless (or (checkdoc-in-sample-code-p begin end)
+ (checkdoc-in-example-string-p begin end)
+ (save-excursion
+ (goto-char b)
+ (condition-case nil
+ (progn
+ (forward-sexp -1)
+ ;; piece of an abbreviation
+ (looking-at
+ "\\([a-z]\\|[iI]\\.?e\\|[eE]\\.?g\\)\\."))
+ (error t))))
+ (if (checkdoc-autofix-ask-replace
+ b e
+ "There should be two spaces after a period. Fix? "
+ ". ")
+ nil
+ (if errtxt
+ ;; If there is already an error, then generate
+ ;; the warning output if applicable
+ (if checkdoc-generate-compile-warnings-flag
+ (checkdoc-create-error
+ "There should be two spaces after a period"
+ b e))
+ (setq errtxt
+ "There should be two spaces after a period"
+ bb b be e)))))))
(set-syntax-table old-syntax-table))
(if errtxt (checkdoc-create-error errtxt bb be))))))
((or (re-search-forward "^;;; History" nil t)
(re-search-forward "^;;; Code" nil t)
(re-search-forward "^(require" nil t)
- (re-search-forward "^("))
+ (re-search-forward "^(" nil t))
(beginning-of-line)))
(if (checkdoc-y-or-n-p
"You should have a \";;; Commentary:\", add one? ")
(re-search-forward "^;;\\s-*\n\\|^\n" nil t))
((or (re-search-forward "^;;; Code" nil t)
(re-search-forward "^(require" nil t)
- (re-search-forward "^("))
+ (re-search-forward "^(" nil t))
(beginning-of-line)))
(if (checkdoc-y-or-n-p
"You should have a \";;; History:\", add one? ")
(while (setq type (checkdoc-message-text-next-string end))
(setq e (checkdoc-message-text-engine type)))
e))
-
+
(defun checkdoc-message-text-next-string (end)
"Move cursor to the next checkable message string after point.
Return the message classification.
(if (looking-at "\\(\\(\\w+\\|\\s_\\)+\\.el\\):\\([0-9]+\\):")
(let ((l (string-to-int (match-string 3)))
(f (match-string 1)))
- (if (not (get-buffer f))
+ (if (not (get-file-buffer f))
(error "Can't find buffer %s" f))
- (switch-to-buffer-other-window (get-buffer f))
+ (switch-to-buffer-other-window (get-file-buffer f))
(goto-line l))))
(defun checkdoc-buffer-label ()
(add-to-list 'debug-ignored-errors
"Argument `.*' should appear (as .*) in the doc string")
+(add-to-list 'debug-ignored-errors "Disambiguate .* by preceding .*")
(provide 'checkdoc)