Add unattended spell-checking to checkdoc

This commit makes checkdoc capable of spell-checking even when the
user isn't using it interactively.  When TAKE-NOTES is non-nil,
checkdoc will run spell-checking (with ispell) and report spelling
mistakes.

Fixes: (bug#38583).
* lisp/textmodes/ispell.el (ispell-word): Extract part of it to
`ispell--run-on-word`.
(ispell--run-on-word): New function, extracted from `ispell-word`.
(ispell-error-checking-word): New function.
(ispell-correct-p): New function.  Use `ispell--run-on-word` and
`ispell-error-checking-word`.
* lisp/emacs-lisp/checkdoc.el (checkdoc-current-buffer): Pass
TAKE-NOTES to `checkdoc-start`.
(checkdoc-continue): Pass TAKE-NOTES to `checkdoc-this-string-valid`.
(checkdoc-this-string-valid): Add optional argument TAKE-NOTES and
pass it to `checkdoc-this-string-valid-engine`.
(checkdoc-this-string-valid-engine): Add optional argument TAKE-NOTES
and pass it to `checkdoc-ispell-docstring-engine`.
(checkdoc-ispell-init): Call `ispell-set-spellchecker-params` and
`ispell-accept-buffer-local-defs`.  These calls are required to
properly use ispell.  The problem went unnoticed until now because
checkdoc was only using ispell through the high-level command
`ispell-word` which takes care of all the initialization for the user.
(checkdoc-ispell-docstring-engine): Add optional argument TAKE-NOTES
to force reporting of spell-checking errors.  Throw error
when (checkdoc-ispell-init) fails configuring ispell.  Replace a
few (if cond nil body) with (unless cond body). Replace (let ((var
nil))) with (let (var)).  Replace (if (not (eq checkdoc-autofix-flag
'never)) body) with just body because `checkdoc-autofix-flag` is
checked at the beginning of the function.

(cherry picked from commit 25adbc4a5ecc3e16625c0171607e3153bbdf7ab1)

diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el
index 93b9ffbe38b3edf1ff89e37a1c276724ae61997c..cbad6f05541901db13f6bf018c0b0621524d2464 100644 (file)
--- a/lisp/emacs-lisp/checkdoc.el
+++ b/lisp/emacs-lisp/checkdoc.el
@@ -849,7 +849,7 @@ otherwise stop after the first error."
     ;; every test is responsible for returning the cursor.
     (or (and buffer-file-name ;; only check comments in a file
             (checkdoc-comments))
-       (checkdoc-start)
+       (checkdoc-start take-notes)
        (checkdoc-message-text)
        (checkdoc-rogue-spaces)
         (when checkdoc-package-keywords-flag
@@ -902,7 +902,7 @@ buffer and save warnings in a separate buffer."
       ;; the user is navigating down through the buffer.
       (while (and (not wrong) (checkdoc-next-docstring))
        ;; OK, let's look at the doc string.
-       (setq msg (checkdoc-this-string-valid))
+       (setq msg (checkdoc-this-string-valid take-notes))
        (if msg (setq wrong (point)))))
     (if wrong
        (progn
@@ -1284,12 +1284,15 @@ checking of documentation strings.
 
 ;;; Checking engines
 ;;
-(defun checkdoc-this-string-valid ()
+(defun checkdoc-this-string-valid (&optional take-notes)
   "Return a message string if the current doc string is invalid.
 Check for style only, such as the first line always being a complete
 sentence, whitespace restrictions, and making sure there are no
 hard-coded key-codes such as C-[char] or mouse-[number] in the comment.
-See the style guide in the Emacs Lisp manual for more details."
+See the style guide in the Emacs Lisp manual for more details.
+
+With a non-nil TAKE-NOTES, store all errors found in a warnings
+buffer, otherwise stop after the first error."
 
   ;; Jump over comments between the last object and the doc string
   (while (looking-at "[ \t\n]*;")
@@ -1366,13 +1369,16 @@ documentation string")
              (point) (+ (point) 1) t)))))
     (if (and (not err) (= (following-char) ?\"))
         (with-syntax-table checkdoc-syntax-table
-          (checkdoc-this-string-valid-engine fp))
+          (checkdoc-this-string-valid-engine fp take-notes))
       err)))
 
-(defun checkdoc-this-string-valid-engine (fp)
+(defun checkdoc-this-string-valid-engine (fp &optional take-notes)
   "Return an error list or string if the current doc string is invalid.
 Depends on `checkdoc-this-string-valid' to reset the syntax table so that
-regexp short cuts work.  FP is the function defun information."
+regexp short cuts work.  FP is the function defun information.
+
+With a non-nil TAKE-NOTES, store all errors found in a warnings
+buffer, otherwise stop after the first error."
   (let ((case-fold-search nil)
        ;; Use a marker so if an early check modifies the text,
        ;; we won't accidentally lose our place.  This could cause
@@ -1864,7 +1870,7 @@ Replace with \"%s\"? " original replace)
      ;; Make sure the doc string has correctly spelled English words
      ;; in it.  This function is extracted due to its complexity,
      ;; and reliance on the Ispell program.
-     (checkdoc-ispell-docstring-engine e)
+     (checkdoc-ispell-docstring-engine e take-notes)
      ;; User supplied checks
      (save-excursion (checkdoc-run-hooks 'checkdoc-style-functions fp e))
      ;; Done!
@@ -2090,6 +2096,10 @@ If the offending word is in a piece of quoted text, then it is skipped."
 ;;
 (defvar ispell-process)
 (declare-function ispell-buffer-local-words "ispell" ())
+(declare-function ispell-correct-p "ispell" ())
+(declare-function ispell-set-spellchecker-params "ispell" ())
+(declare-function ispell-accept-buffer-local-defs "ispell" ())
+(declare-function ispell-error-checking-word "ispell" (word))
 
 (defun checkdoc-ispell-init ()
   "Initialize Ispell process (default version) with Lisp words.
@@ -2100,58 +2110,66 @@ nil."
   (unless ispell-process
     (condition-case nil
        (progn
-         (ispell-buffer-local-words)
+          (ispell-set-spellchecker-params)    ; Initialize variables and dicts alists
+          (ispell-accept-buffer-local-defs)   ; use the correct dictionary
          ;; This code copied in part from ispell.el Emacs 19.34
          (dolist (w checkdoc-ispell-lisp-words)
            (process-send-string ispell-process (concat "@" w "\n"))))
       (error (setq checkdoc-spellcheck-documentation-flag nil)))))
 
-(defun checkdoc-ispell-docstring-engine (end)
+(defun checkdoc-ispell-docstring-engine (end &optional take-notes)
   "Run the Ispell tools on the doc string between point and END.
 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
+before using the Ispell engine on it.
+
+With a non-nil TAKE-NOTES, store all errors found in a warnings
+buffer, otherwise stop after the first error."
+  (when (and checkdoc-spellcheck-documentation-flag
+             ;; If the user wants no questions or fixing, then we must
+             ;; disable spell checking as not useful.
+             (or take-notes
+                 (and checkdoc-autofix-flag
+                      (not (eq checkdoc-autofix-flag 'never)))))
     (checkdoc-ispell-init)
+    (unless checkdoc-spellcheck-documentation-flag
+      ;; this happens when (checkdoc-ispell-init) can't start `ispell-program-name'
+      (user-error "No spellchecker installed: check the variable `ispell-program-name'."))
     (save-excursion
       (skip-chars-forward "^a-zA-Z")
-      (let ((word nil) (sym nil) (case-fold-search nil) (err nil))
-       (while (and (not err) (< (point) end))
-         (if (save-excursion (forward-char -1) (looking-at "[('`]"))
-             ;; Skip lists describing meta-syntax, or bound variables
-             (forward-sexp 1)
-           (setq word (buffer-substring-no-properties
-                       (point) (progn
-                                 (skip-chars-forward "a-zA-Z-")
-                                 (point)))
-                 sym (intern-soft word))
-           (if (and sym (or (boundp sym) (fboundp sym)))
-               ;; This is probably repetitive in most cases, but not always.
-               nil
-             ;; Find out how we spell-check this word.
-             (if (or
-                  ;; All caps w/ option th, or s tacked on the end
-                  ;; for pluralization or number.
-                  (string-match "^[A-Z][A-Z]+\\(s\\|th\\)?$" word)
-                  (looking-at "}") ; a keymap expression
-                  )
-                 nil
-               (save-excursion
-                 (if (not (eq checkdoc-autofix-flag 'never))
-                     (let ((lk last-input-event))
-                       (ispell-word nil t)
-                       (if (not (equal last-input-event lk))
-                           (progn
-                             (sit-for 0)
-                             (message "Continuing..."))))
-                   ;; Nothing here.
-                   )))))
-         (skip-chars-forward "^a-zA-Z"))
-       err))))
+      (let (word sym case-fold-search err word-beginning word-end)
+        (while (and (not err) (< (point) end))
+          (if (save-excursion (forward-char -1) (looking-at "[('`]"))
+              ;; Skip lists describing meta-syntax, or bound variables
+              (forward-sexp 1)
+            (setq word-beginning (point)
+                  word-end (progn
+                             (skip-chars-forward "a-zA-Z-")
+                             (point))
+                  word (buffer-substring-no-properties word-beginning word-end)
+                  sym (intern-soft word))
+            (unless (and sym (or (boundp sym) (fboundp sym)))
+              ;; Find out how we spell-check this word.
+              (unless (or
+                       ;; All caps w/ option th, or s tacked on the end
+                       ;; for pluralization or number.
+                       (string-match "^[A-Z][A-Z]+\\(s\\|th\\)?$" word)
+                       (looking-at "}") ; a keymap expression
+                       )
+                (save-excursion
+                  (let ((lk last-input-event))
+                    (if take-notes
+                        (progn
+                          (unless (ispell-correct-p)
+                            (checkdoc-create-error
+                             (ispell-error-checking-word word)
+                             word-beginning word-end)))
+                      (ispell-word nil t))
+                    (if (not (equal last-input-event lk))
+                        (progn
+                          (sit-for 0)
+                          (message "Continuing..."))))))))
+          (skip-chars-forward "^a-zA-Z"))
+        err))))
 
 ;;; Rogue space checking engine
 ;;

diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el
index 53a454330856b58e6040dee6ad3bbf276647db20..c06f3915faa462db4db3059cb6e45c18e1de8ff3 100644 (file)
--- a/lisp/textmodes/ispell.el
+++ b/lisp/textmodes/ispell.el
@@ -1951,18 +1951,7 @@ quit          spell session exited."
       (or quietly
          (message "Checking spelling of %s..."
                   (funcall ispell-format-word-function word)))
-      (ispell-send-string "%\n")       ; put in verbose mode
-      (ispell-send-string (concat "^" word "\n"))
-      ;; wait until ispell has processed word
-      (while (progn
-              (ispell-accept-output)
-              (not (string= "" (car ispell-filter)))))
-      ;;(ispell-send-string "!\n") ;back to terse mode.
-      (setq ispell-filter (cdr ispell-filter)) ; remove extra \n
-      (if (and ispell-filter (listp ispell-filter))
-         (if (> (length ispell-filter) 1)
-             (error "Ispell and its process have different character maps")
-           (setq poss (ispell-parse-output (car ispell-filter)))))
+      (setq poss (ispell--run-on-word word))
       (cond ((eq poss t)
             (or quietly
                 (message "%s is correct"
@@ -2024,6 +2013,43 @@ quit          spell session exited."
       (goto-char cursor-location)      ; return to original location
       replace))))
 
+(defun ispell--run-on-word (word)
+  "Run ispell on WORD."
+  (ispell-send-string "%\n")   ; put in verbose mode
+  (ispell-send-string (concat "^" word "\n"))
+  ;; wait until ispell has processed word
+  (while (progn
+           (ispell-accept-output)
+           (not (string= "" (car ispell-filter)))))
+  (setq ispell-filter (cdr ispell-filter))
+  (when (and ispell-filter (listp ispell-filter))
+    (if (> (length ispell-filter) 1)
+        (error "Ispell and its processs have different character maps: %s" ispell-filter)
+      (ispell-parse-output (car ispell-filter)))))
+
+(defun ispell-error-checking-word (word)
+  "Return a string describing that checking for WORD failed."
+  (format "Error checking word %s using %s with %s dictionary"
+          (funcall ispell-format-word-function word)
+          (file-name-nondirectory ispell-program-name)
+          (or ispell-current-dictionary "default")))
+
+(defun ispell-correct-p (&optional following)
+  "Return t if the word at point is correct. Nil otherwise.
+
+If optional argument FOLLOWING is non-nil then the following
+word (rather than preceding) is checked when the cursor is not
+over a word."
+  (save-excursion
+    ;; reset ispell-filter so it only contains the result of
+    ;; spell-checking the current-word:
+    (setq ispell-filter nil)
+    (let* ((word-and-boundaries (ispell-get-word following))
+           (word (car word-and-boundaries))
+           (poss (ispell--run-on-word word)))
+      (unless poss (error (ispell-error-checking-word word)))
+      (or (eq poss t)
+          (stringp poss)))))
 
 (defun ispell-get-word (following &optional extra-otherchars)
   "Return the word for spell-checking according to ispell syntax.