-;;; checkdoc --- Check documentation strings for style requirements
+;;; checkdoc.el --- check documentation strings for style requirements
-;;; Copyright (C) 1997, 1998 Free Software Foundation
+;;; Copyright (C) 1997, 1998, 2001, 2004 Free Software Foundation
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Version: 0.6.2
;; 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.
:group 'checkdoc
:type 'boolean)
-(defcustom checkdoc-triple-semi-comment-check-flag t
- "*Non-nil means to check for multiple adjacent occurrences of ;;; comments.
-According to the style of Emacs code in the Lisp libraries, a block
-comment can look like this:
-;;; Title
-;; text
-;; text
-But when inside a function, code can be commented out using the ;;;
-construct for all lines. When this variable is nil, the ;;; construct
-is ignored regardless of its location in the code."
- :group 'checkdoc
- :type 'boolean)
-
(defcustom checkdoc-spellcheck-documentation-flag nil
"*Non-nil means run Ispell on text based on value.
This is automatically set to nil if Ispell does not exist on your
: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.")
("changes" . "change")
("checks" . "check")
("contains" . "contain")
+ ("converts" . "convert")
("creates" . "create")
("destroys" . "destroy")
("disables" . "disable")
("makes" . "make")
("marks" . "mark")
("matches" . "match")
+ ("moves" . "move")
("notifies" . "notify")
("offers" . "offer")
("parses" . "parse")
;; 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)
(checkdoc-overlay-put cdo 'face 'highlight)
;; Make sure the whole doc string is visible if possible.
(sit-for 0)
- (if (not (pos-visible-in-window-p
- (save-excursion (forward-sexp 1) (point))
- (selected-window)))
- (if (looking-at "\"")
- (let ((l (count-lines (point)
- (save-excursion
- (forward-sexp 1) (point)))))
- (if (> l (window-height))
- (recenter 1)
- (recenter (/ (- (window-height) l) 2))))
- (recenter)))
+ (if (and (looking-at "\"")
+ (not (pos-visible-in-window-p
+ (save-excursion (forward-sexp 1) (point))
+ (selected-window))))
+ (let ((l (count-lines (point)
+ (save-excursion
+ (forward-sexp 1) (point)))))
+ (if (> l (window-height))
+ (recenter 1)
+ (recenter (/ (- (window-height) l) 2))))
+ (recenter))
(message "%s (C-h,%se,n,p,q)" (checkdoc-error-text
(car (car err-list)))
(if (checkdoc-error-unfixable (car (car err-list)))
(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))
(sit-for 2))
(setq err-list (cdr err-list))))
(beginning-of-defun)
- (let ((pe (car err-list))
- (ne (funcall findfunc nil)))
+ (let ((ne (funcall findfunc nil)))
(if ne
(setq err-list (cons ne err-list))
(cond ((not err-list)
(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
save warnings in a separate buffer. Second optional argument START-POINT
is the starting location. If this is nil, `point-min' is used instead."
(interactive "P")
- (let ((wrong nil) (msg nil) (errors nil)
+ (let ((wrong nil) (msg 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
(skip-chars-forward " \n\t")
t))
-;;; ###autoload
+;;;###autoload
(defun checkdoc-comments (&optional take-notes)
"Find missing comment sections in the current Emacs Lisp file.
Prefix argument TAKE-NOTES non-nil means to save warnings in a
(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))
- ;; This is just irritating when taking notes.
- (checkdoc-triple-semi-comment-check-flag
- (if take-notes nil checkdoc-triple-semi-comment-check-flag))
(e (checkdoc-file-comments-engine))
(checkdoc-generate-compile-warnings-flag
(or take-notes 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)))
;;; Minor Mode specification
;;
-(defvar checkdoc-minor-mode nil
- "Non-nil in `emacs-lisp-mode' for automatic documentation checking.")
-(make-variable-buffer-local 'checkdoc-minor-mode)
-
-(checkdoc-add-to-list 'minor-mode-alist '(checkdoc-minor-mode " CDoc"))
-(defvar checkdoc-minor-keymap
+(defvar checkdoc-minor-mode-map
(let ((map (make-sparse-keymap))
(pmap (make-sparse-keymap)))
;; Override some bindings
map)
"Keymap used to override evaluation key-bindings for documentation checking.")
+(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
-(if checkdoc-minor-keymap
- (easy-menu-define
- checkdoc-minor-menu checkdoc-minor-keymap "Checkdoc Minor Mode Menu"
- '("CheckDoc"
- ["Interactive Buffer Style Check" checkdoc t]
- ["Interactive Buffer Style and Spelling Check" checkdoc-ispell t]
- ["Check Buffer" checkdoc-current-buffer t]
- ["Check and Spell Buffer" checkdoc-ispell-current-buffer t]
- "---"
- ["Interactive Style Check" checkdoc-interactive t]
- ["Interactive Style and Spelling Check" checkdoc-ispell-interactive t]
- ["Find First Style Error" checkdoc-start t]
- ["Find First Style or Spelling Error" checkdoc-ispell-start t]
- ["Next Style Error" checkdoc-continue t]
- ["Next Style or Spelling Error" checkdoc-ispell-continue t]
- ["Interactive Message Text Style Check" checkdoc-message-interactive t]
- ["Interactive Message Text Style and Spelling Check"
- checkdoc-ispell-message-interactive t]
- ["Check Message Text" checkdoc-message-text t]
- ["Check and Spell Message Text" checkdoc-ispell-message-text t]
- ["Check Comment Style" checkdoc-comments buffer-file-name]
- ["Check Comment Style and Spelling" checkdoc-ispell-comments
- buffer-file-name]
- ["Check for Rogue Spaces" checkdoc-rogue-spaces t]
- "---"
- ["Check Defun" checkdoc-defun t]
- ["Check and Spell Defun" checkdoc-ispell-defun t]
- ["Check and Evaluate Defun" checkdoc-eval-defun t]
- ["Check and Evaluate Buffer" checkdoc-eval-current-buffer t]
- )))
+(easy-menu-define
+ 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]
+ ["Check Buffer" checkdoc-current-buffer t]
+ ["Check and Spell Buffer" checkdoc-ispell-current-buffer t]
+ "---"
+ ["Interactive Style Check" checkdoc-interactive t]
+ ["Interactive Style and Spelling Check" checkdoc-ispell-interactive t]
+ ["Find First Style Error" checkdoc-start t]
+ ["Find First Style or Spelling Error" checkdoc-ispell-start t]
+ ["Next Style Error" checkdoc-continue t]
+ ["Next Style or Spelling Error" checkdoc-ispell-continue t]
+ ["Interactive Message Text Style Check" checkdoc-message-interactive t]
+ ["Interactive Message Text Style and Spelling Check"
+ checkdoc-ispell-message-interactive t]
+ ["Check Message Text" checkdoc-message-text t]
+ ["Check and Spell Message Text" checkdoc-ispell-message-text t]
+ ["Check Comment Style" checkdoc-comments buffer-file-name]
+ ["Check Comment Style and Spelling" checkdoc-ispell-comments
+ buffer-file-name]
+ ["Check for Rogue Spaces" checkdoc-rogue-spaces t]
+ "---"
+ ["Check Defun" checkdoc-defun t]
+ ["Check and Spell Defun" checkdoc-ispell-defun t]
+ ["Check and Evaluate Defun" checkdoc-eval-defun t]
+ ["Check and Evaluate Buffer" checkdoc-eval-current-buffer t]
+ ))
;; XEmacs requires some weird stuff to add this menu in a minor mode.
;; What is it?
-;; Allow re-insertion of a new keymap
-(let ((a (assoc 'checkdoc-minor-mode minor-mode-map-alist)))
- (if a
- (setcdr a checkdoc-minor-keymap)
- (checkdoc-add-to-list 'minor-mode-map-alist (cons 'checkdoc-minor-mode
- checkdoc-minor-keymap))))
-
;;;###autoload
-(defun checkdoc-minor-mode (&optional arg)
+(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.
In Checkdoc minor mode, the usual bindings for `eval-defun' which is
-bound to \\<checkdoc-minor-keymap> \\[checkdoc-eval-defun] and `checkdoc-eval-current-buffer' are overridden to include
+bound to \\<checkdoc-minor-mode-map>\\[checkdoc-eval-defun] and `checkdoc-eval-current-buffer' are overridden to include
checking of documentation strings.
-\\{checkdoc-minor-keymap}"
- (interactive "P")
- (setq checkdoc-minor-mode
- (not (or (and (null arg) checkdoc-minor-mode)
- (<= (prefix-numeric-value arg) 0))))
- (checkdoc-mode-line-update))
+\\{checkdoc-minor-mode-map}"
+ 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 (and (string-match "-flag$" (car fp))
(not (looking-at "\"\\*?Non-nil\\s-+means\\s-+")))
(checkdoc-create-error
- "Flag variable doc strings should start: Non-nil means"
+ "Flag variable doc strings should usually start: Non-nil means"
s (marker-position e) t))
;; 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 variables should 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))
(if (checkdoc-autofix-ask-replace
(match-beginning 1) (match-end 1)
(format
- "Argument `%s' should appear as `%s'. Fix? "
+ "If this is the argument `%s', it should appear as %s. Fix? "
(car args) (upcase (car args)))
(upcase (car args)) t)
(setq found (match-beginning 1))))))
nil)
(checkdoc-create-error
(format
- "Argument `%s' should appear (as `%s') in the doc string"
+ "Argument `%s' should appear (as %s) in the doc string"
(car args) (upcase (car args)))
s (marker-position e)))
(if (or (and order (eq order 'yes))
"Arguments occur in the doc string out of order"
s (marker-position e) t)))))
;; * For consistency, phrase the verb in the first sentence of a
- ;; documentation string for functions as an infinitive with
- ;; "to" omitted. For instance, use `Return the cons of A and
+ ;; documentation string for functions as an imperative.
+ ;; For instance, use `Return the cons of A and
;; B.' in preference to `Returns the cons of A and B.'
;; Usually it looks good to do likewise for the rest of the
;; first paragraph. Subsequent paragraphs usually look better
;; 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)
(cdr rs)))))
(if (checkdoc-autofix-ask-replace
(match-beginning 1) (match-end 1)
- (format "Use the infinitive for `%s'. \
-Replace with `%s'? " original replace)
+ (format "Use the imperative for \"%s\". \
+Replace with \"%s\"? " original replace)
replace t)
(setq rs nil)))
(if rs
;; there was a match, but no replace
(checkdoc-create-error
(format
- "Infinitive `%s' should be replaced with `%s'"
+ "Probably \"%s\" should be imperative \"%s\""
original replace)
(match-beginning 1) (match-end 1))))))
;; Done with functions
(let ((found nil) (start (point)) (msg nil) (ms nil))
(while (and (not msg)
(re-search-forward
- "[^([`':a-zA-Z]\\(\\w+[:-]\\(\\w\\|\\s_\\)+\\)[^]']"
+ "[^-([`':a-zA-Z]\\(\\w+[:-]\\(\\w\\|\\s_\\)+\\)[^]']"
e t))
(setq ms (match-string 1))
(save-match-data
(match-string 2) t)
nil
(checkdoc-create-error
- "Symbols t and nil should not appear in `quotes'"
+ "Symbols t and nil should not appear in `...' quotes"
(match-beginning 1) (match-end 1)))))
;; Here is some basic sentence formatting
(checkdoc-sentencespace-region-engine (point) e)
;; Interactive
(save-excursion
(setq ret (cons
- (re-search-forward "(interactive"
+ (re-search-forward "^\\s-*(interactive"
(save-excursion (end-of-defun) (point))
t)
ret)))
(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? ")
(1- (point-max)) (point-max)))))
err))
;; The below checks will not return errors if the user says NO
-
- ;; Ok, now let's look for multiple occurrences of ;;;, and offer
- ;; to remove the extra ";" if applicable. This pre-supposes
- ;; that the user has semiautomatic fixing on to be useful.
-
- ;; In the info node (elisp)Library Headers a header is three ;
- ;; (the header) followed by text of only two ;
- ;; In (elisp)Comment Tips, however it says this:
- ;; * Another use for triple-semicolon comments is for commenting out
- ;; lines within a function. We use triple-semicolons for this
- ;; precisely so that they remain at the left margin.
- (let ((msg nil))
- (goto-char (point-min))
- (while (and checkdoc-triple-semi-comment-check-flag
- (not msg) (re-search-forward "^;;;[^;]" nil t))
- ;; We found a triple, let's check all following lines.
- (if (not (bolp)) (progn (beginning-of-line) (forward-line 1)))
- (let ((complex-replace t)
- (dont-replace nil))
- (while (looking-at ";;\\(;\\)[^;#]")
- (if (and (not dont-replace)
- (checkdoc-outside-major-sexp) ;in code is ok.
- (checkdoc-autofix-ask-replace
- (match-beginning 1) (match-end 1)
- "Multiple occurrences of ;;; found. Use ;; instead? "
- "" complex-replace))
- ;; Learn that, yea, the user did want to do this a
- ;; whole bunch of times.
- (setq complex-replace nil)
- ;; In this case, skip all this crap
- (setq dont-replace t))
- (beginning-of-line)
- (forward-line 1)))))
;; Let's spellcheck the commentary section. This is the only
;; section that is easy to pick out, and it is also the most
;; visible section (with the finder).
(let ((cm (lm-commentary-mark)))
- (if cm
- (save-excursion
- (goto-char (lm-commentary-mark))
- ;; Spellcheck between the commentary, and the first
- ;; non-comment line. We could use lm-commentary, but that
- ;; returns a string, and Ispell wants to talk to a buffer.
- ;; Since the comments talk about Lisp, use the specialized
- ;; spell-checker we also used for doc strings.
- (let ((e (save-excursion (re-search-forward "^[^;]" nil t)
- (point))))
- (checkdoc-sentencespace-region-engine (point) e)
- (checkdoc-proper-noun-region-engine (point) e)
- (checkdoc-ispell-docstring-engine e)))))
-;;; test comment out code
-;;; (foo 1 3)
-;;; (bar 5 7)
+ (when cm
+ (save-excursion
+ (goto-char cm)
+ (let ((e (copy-marker (lm-commentary-end))))
+ ;; Since the comments talk about Lisp, use the
+ ;; specialized spell-checker we also used for doc
+ ;; strings.
+ (checkdoc-sentencespace-region-engine (point) e)
+ (checkdoc-proper-noun-region-engine (point) e)
+ (checkdoc-ispell-docstring-engine e)))))
(setq
err
(or
(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 we see a ?, then replace with "? ".
(if (checkdoc-autofix-ask-replace
(match-beginning 0) (match-end 0)
- "y-or-n-p text should end with \"? \". Fix? "
+ "`y-or-n-p' argument should end with \"? \". Fix? "
"? " t)
nil
(checkdoc-create-error
- "y-or-n-p text should end with \"? \""
+ "`y-or-n-p' argument should end with \"? \""
(match-beginning 0) (match-end 0)))
(if (save-excursion (forward-sexp 1)
(forward-char -2)
(looking-at " "))
(if (checkdoc-autofix-ask-replace
(match-beginning 0) (match-end 0)
- "y-or-n-p text should end with \"? \". Fix? "
+ "`y-or-n-p' argument should end with \"? \". Fix? "
"? " t)
nil
(checkdoc-create-error
- "y-or-n-p text should end with \"? \""
+ "`y-or-n-p' argument should end with \"? \""
(match-beginning 0) (match-end 0)))
(if (and ;; if this isn't true, we have a problem.
(save-excursion (forward-sexp 1)
(looking-at "\""))
(checkdoc-autofix-ask-replace
(match-beginning 0) (match-end 0)
- "y-or-n-p text should end with \"? \". Fix? "
+ "`y-or-n-p' argument should end with \"? \". Fix? "
"? \"" t))
nil
(checkdoc-create-error
- "y-or-n-p text should end with \"? \""
+ "`y-or-n-p' argument should end with \"? \""
(match-beginning 0) (match-end 0)))))))
;; Now, let's just run the spell checker on this guy.
(checkdoc-ispell-docstring-engine (save-excursion (forward-sexp 1)
;;; Warning management
;;
(defvar checkdoc-output-font-lock-keywords
- '(("\\(\\w+\\.el\\): \\(\\w+\\)"
+ '(("^\\*\\*\\* \\(.+\\.el\\): \\([^ \n]+\\)"
(1 font-lock-function-name-face)
- (2 font-lock-comment-face))
- ("^\\(\\w+\\.el\\):" 1 font-lock-function-name-face)
- (":\\([0-9]+\\):" 1 font-lock-constant-face))
+ (2 font-lock-comment-face)))
"Keywords used to highlight a checkdoc diagnostic buffer.")
-(defvar checkdoc-output-mode-map nil
- "Keymap used in `checkdoc-output-mode'.")
+(defvar checkdoc-output-error-regex-alist
+ '(("^\\(.+\\.el\\):\\([0-9]+\\): " 1 2)))
(defvar checkdoc-pending-errors nil
"Non-nil when there are errors that have not been displayed yet.")
-(if checkdoc-output-mode-map
- nil
- (setq checkdoc-output-mode-map (make-sparse-keymap))
- (if (not (string-match "XEmacs" emacs-version))
- (define-key checkdoc-output-mode-map [mouse-2]
- 'checkdoc-find-error-mouse))
- (define-key checkdoc-output-mode-map "\C-c\C-c" 'checkdoc-find-error)
- (define-key checkdoc-output-mode-map "\C-m" 'checkdoc-find-error))
-
-(defun checkdoc-output-mode ()
- "Create and setup the buffer used to maintain checkdoc warnings.
-\\<checkdoc-output-mode-map>\\[checkdoc-find-error] - Go to this error location
-\\[checkdoc-find-error-mouse] - Goto the error clicked on."
- (if (get-buffer checkdoc-diagnostic-buffer)
- (get-buffer checkdoc-diagnostic-buffer)
- (save-excursion
- (set-buffer (get-buffer-create checkdoc-diagnostic-buffer))
- (kill-all-local-variables)
- (setq mode-name "Checkdoc"
- major-mode 'checkdoc-output-mode)
- (set (make-local-variable 'font-lock-defaults)
- '((checkdoc-output-font-lock-keywords) t t ((?- . "w") (?_ . "w"))))
- (use-local-map checkdoc-output-mode-map)
- (run-hooks 'checkdoc-output-mode-hook)
- (current-buffer))))
-
-(defun checkdoc-find-error-mouse (e)
- ;; checkdoc-params: (e)
- "Call `checkdoc-find-error' where the user clicks the mouse."
- (interactive "e")
- (mouse-set-point e)
- (checkdoc-find-error))
-
-(defun checkdoc-find-error ()
- "In a checkdoc diagnostic buffer, find the error under point."
- (interactive)
- (beginning-of-line)
- (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))
- (error "Can't find buffer %s" f))
- (switch-to-buffer-other-window (get-buffer f))
- (goto-line l))))
+(define-derived-mode checkdoc-output-mode compilation-mode "Checkdoc"
+ "Set up the major mode for the buffer containing the list of errors."
+ (set (make-local-variable 'compilation-error-regexp-alist)
+ checkdoc-output-error-regex-alist)
+ (set (make-local-variable 'compilation-mode-font-lock-keywords)
+ checkdoc-output-font-lock-keywords))
(defun checkdoc-buffer-label ()
"The name to use for a checkdoc buffer in the error list."
(if (buffer-file-name)
- (file-name-nondirectory (buffer-file-name))
+ (file-relative-name (buffer-file-name))
(concat "#<buffer "(buffer-name) ">")))
(defun checkdoc-start-section (check-type)
"Initialize the checkdoc diagnostic buffer for a pass.
Create the header so that the string CHECK-TYPE is displayed as the
function called to create the messages."
- (checkdoc-output-to-error-buffer
- "\n\n\C-l\n*** "
- (checkdoc-buffer-label) ": " check-type " V " checkdoc-version))
+ (let ((dir default-directory)
+ (label (checkdoc-buffer-label)))
+ (with-current-buffer (get-buffer-create checkdoc-diagnostic-buffer)
+ (checkdoc-output-mode)
+ (setq default-directory dir)
+ (goto-char (point-max))
+ (insert "\n\n\C-l\n*** " label ": " check-type " V " checkdoc-version))))
(defun checkdoc-error (point msg)
"Store POINT and MSG as errors in the checkdoc diagnostic buffer."
(setq checkdoc-pending-errors t)
- (checkdoc-output-to-error-buffer
- "\n" (checkdoc-buffer-label) ":"
- (int-to-string (count-lines (point-min) (or point 1))) ": "
- msg))
-
-(defun checkdoc-output-to-error-buffer (&rest text)
- "Place TEXT into the checkdoc diagnostic buffer."
- (save-excursion
- (set-buffer (checkdoc-output-mode))
- (goto-char (point-max))
- (apply 'insert text)))
+ (let ((text (list "\n" (checkdoc-buffer-label) ":"
+ (int-to-string
+ (count-lines (point-min) (or point (point-min))))
+ ": " msg)))
+ (with-current-buffer (get-buffer checkdoc-diagnostic-buffer)
+ (goto-char (point-max))
+ (apply 'insert text))))
(defun checkdoc-show-diagnostics ()
"Display the checkdoc diagnostic buffer in a temporary window."
(custom-add-option 'emacs-lisp-mode-hook
(lambda () (checkdoc-minor-mode 1)))
+(add-to-list 'debug-ignored-errors
+ "Argument `.*' should appear (as .*) in the doc string")
+(add-to-list 'debug-ignored-errors
+ "Lisp symbol `.*' should appear in quotes")
+(add-to-list 'debug-ignored-errors "Disambiguate .* by preceding .*")
+
(provide 'checkdoc)
+;;; arch-tag: c49a7ec8-3bb7-46f2-bfbc-d5f26e033b26
;;; checkdoc.el ends here