Subject: bug#38583: [PATCH] 27.0.50; Add unattended spell-checking to checkdoc

From: Damien Cassou <[email-masked]>
Date: Fri, 27 Dec 2019 15:43:19 +0100

Eli Zaretskii <[email-masked]> writes:
> You mean, this is in addition to the previous patches?  If so, I'd
> prefer a single patch.

you want all the changes merged into a single patch? This seems much
harder to review but here it is.

-- 
Damien Cassou

"Success is the ability to go from one failure to another without
losing enthusiasm." --Winston Churchill
>From 71bf337ce06411f4951ec3a6e3b2a7c7f5dca55b Mon Sep 17 00:00:00 2001
From: Damien Cassou <[email-masked]>
Date: Fri, 27 Dec 2019 15:35:52 +0100
Subject: [PATCH] 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.

* 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-correct-p): New function.  Use `ispell--run-on-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.
---
 lisp/emacs-lisp/checkdoc.el | 117 +++++++++++++++++++++---------------
 lisp/textmodes/ispell.el    |  46 ++++++++++----
 2 files changed, 101 insertions(+), 62 deletions(-)

diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el
index 6c40bdf632..0269b89790 100644
--- a/lisp/emacs-lisp/checkdoc.el
+++ b/lisp/emacs-lisp/checkdoc.el
@@ -849,7 +849,7 @@ checkdoc-current-buffer
     ;; 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 @@ checkdoc-continue
       ;; 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 @@ checkdoc-create-common-verbs-regexp
 
 ;;; 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 @@ checkdoc-this-string-valid
 	      (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 @@ checkdoc-this-string-valid-engine
      ;; 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!
@@ -2100,58 +2106,69 @@ checkdoc-ispell-init
   (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
+                             (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"))
+                             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 dd1eeb4530..7ec445211d 100644
--- a/lisp/textmodes/ispell.el
+++ b/lisp/textmodes/ispell.el
@@ -1951,18 +1951,7 @@ ispell-word
       (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))
       (cond ((eq poss t)
 	     (or quietly
 		 (message "%s is correct"
@@ -2024,6 +2013,39 @@ ispell-word
       (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-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))
+           (poss (ispell--run-on-word (car word-and-boundaries))))
+      (unless poss
+        (error "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")))
+      (or (eq poss t)
+          (stringp poss)))))
 
 (defun ispell-get-word (following &optional extra-otherchars)
   "Return the word for spell-checking according to ispell syntax.
-- 
2.24.1