comparison lisp/emacs-lisp/checkdoc.el @ 50330:e3d87b72b575

(checkdoc-display-status-buffer): Fix docstring. (checkdoc-interactive, checkdoc-message-interactive): Make them perform spell checking when appropriate. (checkdoc-interactive-loop): Fix docstring and a few typos. (checkdoc-interactive-ispell-loop) (checkdoc-message-interactive-ispell-loop): New functions. (checkdoc-next-error): Fix docstring. (checkdoc-this-string-valid-engine): Fix typo. (checkdoc-ispell-docstring-engine): Do test for checkdoc-autofix-flag = nil.

50329:e5ff1f539de2

      (setcar (cdr (cdr (cdr status))) "Ok"))
    (checkdoc-display-status-buffer status)))

(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 test."
  (let (temp-buffer-setup-hook)
    (with-output-to-temp-buffer " *Checkdoc Status*"
      (princ-list
       "Buffer comments and tags:  " (nth 0 check) "\n"
       "Documentation style:       " (nth 1 check) "\n"

checkdoc status window instead of the usual behavior."
  (interactive "P")
  (let ((checkdoc-spellcheck-documentation-flag
	 (car (memq checkdoc-spellcheck-documentation-flag
                    '(interactive t)))))
    (checkdoc-interactive-loop start-here showstatus 'checkdoc-next-error)))

;;;###autoload
(defun checkdoc-message-interactive (&optional start-here showstatus)
  "Interactively check the current buffer for message string errors.
Prefix argument START-HERE will start the checking from the current

checkdoc status window instead of the usual behavior."
  (interactive "P")
  (let ((checkdoc-spellcheck-documentation-flag
	 (car (memq checkdoc-spellcheck-documentation-flag
                    '(interactive t)))))
    (checkdoc-interactive-loop start-here showstatus
			       'checkdoc-next-message-error)))

(defun checkdoc-interactive-loop (start-here showstatus findfunc)
  "Interactively 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 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 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."

			   "" "f,"))
	      (save-excursion
		(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
	      (if (not (integerp c)) (setq c ??))
	      (cond
	       ;; Exit condition
	       ((checkdoc-char= c ?\C-g) (signal 'quit nil))
	       ;; Request an auto-fix

		(checkdoc-delete-overlay cdo)
		(setq cdo nil)
		(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
		;; the checker to return a different error.
		(let ((checkdoc-autofix-flag 'automatic-then-never)
		      (fixed nil))
		  (funcall findfunc t)
		  (setq fixed (not (eq checkdoc-autofix-flag

	       ;; Quit checkdoc
	       ((checkdoc-char= c ?q)
		(setq returnme err-list
		      err-list nil
		      begin (point)))
	       ;; Goofy s tuff
	       (t
		(if (get-buffer-window "*Checkdoc Help*")
		    (progn
		      (delete-window (get-buffer-window "*Checkdoc Help*"))
		      (kill-buffer "*Checkdoc Help*"))

    (goto-char begin)
    (if (get-buffer "*Checkdoc Help*") (kill-buffer "*Checkdoc Help*"))
    (message "Checkdoc: Done.")
    returnme))

(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.
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."
  (if enable-fix
      (checkdoc-this-string-valid)

	     ;;
	     ;; This is the least important of the above tests.  Make sure
	     ;; it occurs last.
	     (and checkdoc-verb-check-experimental-flag
		  (save-excursion
		    ;; Maybe rebuild the monster-regex
		    (checkdoc-create-common-verbs-regexp)
		    (let ((lim (save-excursion
				 (end-of-line)
				 ;; check string-continuation
				 (if (checkdoc-char= (preceding-char) ?\\)

Since Ispell isn't Lisp-smart, we must pre-process the doc string
before using the Ispell engine on it."
  (if (or (not checkdoc-spellcheck-documentation-flag)
	  ;; If the user wants no questions or fixing, then we must
	  ;; disable spell checking as not useful.
          ;; FIXME: Somehow, `checkdoc-autofix-flag' is always nil
          ;; when `checkdoc-ispell-docstring-engine' is called to be
          ;; used on a docstring.  As a workround, I commented out the
          ;; next line.
	  ;; (not checkdoc-autofix-flag)
	  (eq checkdoc-autofix-flag 'never))
      nil
    (checkdoc-ispell-init)
    (save-excursion
      (skip-chars-forward "^a-zA-Z")

50330:e3d87b72b575

      (setcar (cdr (cdr (cdr status))) "Ok"))
    (checkdoc-display-status-buffer status)))

(defun checkdoc-display-status-buffer (check)
  "Display and update the status buffer for the current checkdoc mode.
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
       "Buffer comments and tags:  " (nth 0 check) "\n"
       "Documentation style:       " (nth 1 check) "\n"

checkdoc status window instead of the usual behavior."
  (interactive "P")
  (let ((checkdoc-spellcheck-documentation-flag
	 (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)
  "Interactively check the current buffer for message string errors.
Prefix argument START-HERE will start the checking from the current

checkdoc status window instead of the usual behavior."
  (interactive "P")
  (let ((checkdoc-spellcheck-documentation-flag
	 (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)
  "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 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."

			   "" "f,"))
	      (save-excursion
		(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)))
	      (if (not (integerp c)) (setq c ??))
	      (cond
	       ;; Exit condition
	       ((checkdoc-char= c ?\C-g) (signal 'quit nil))
	       ;; Request an auto-fix

		(checkdoc-delete-overlay cdo)
		(setq cdo nil)
		(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 then set the flag to 'never, allowing
		;; the checker to return a different error.
		(let ((checkdoc-autofix-flag 'automatic-then-never)
		      (fixed nil))
		  (funcall findfunc t)
		  (setq fixed (not (eq checkdoc-autofix-flag

	       ;; Quit checkdoc
	       ((checkdoc-char= c ?q)
		(setq returnme err-list
		      err-list nil
		      begin (point)))
	       ;; Goofy stuff
	       (t
		(if (get-buffer-window "*Checkdoc Help*")
		    (progn
		      (delete-window (get-buffer-window "*Checkdoc Help*"))
		      (kill-buffer "*Checkdoc Help*"))

    (goto-char begin)
    (if (get-buffer "*Checkdoc Help*") (kill-buffer "*Checkdoc Help*"))
    (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.
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."
  (if enable-fix
      (checkdoc-this-string-valid)

	     ;;
	     ;; This is the least important of the above tests.  Make sure
	     ;; it occurs last.
	     (and checkdoc-verb-check-experimental-flag
		  (save-excursion
		    ;; Maybe rebuild the monster-regexp
		    (checkdoc-create-common-verbs-regexp)
		    (let ((lim (save-excursion
				 (end-of-line)
				 ;; check string-continuation
				 (if (checkdoc-char= (preceding-char) ?\\)

Since Ispell isn't Lisp-smart, we must pre-process the doc string
before using the Ispell engine on it."
  (if (or (not checkdoc-spellcheck-documentation-flag)
	  ;; If the user wants no questions or fixing, then we must
	  ;; disable spell checking as not useful.
	  (not checkdoc-autofix-flag)
	  (eq checkdoc-autofix-flag 'never))
      nil
    (checkdoc-ispell-init)
    (save-excursion
      (skip-chars-forward "^a-zA-Z")