From 6338f69102551cb8bfba36000fb73935aefa5b7b Mon Sep 17 00:00:00 2001 From: Damien Cassou 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. 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) --- lisp/emacs-lisp/checkdoc.el | 118 +++++++++++++++++++++--------------- lisp/textmodes/ispell.el | 50 +++++++++++---- 2 files changed, 106 insertions(+), 62 deletions(-) diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el index 93b9ffbe38b..cbad6f05541 100644 --- 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 53a45433085..c06f3915faa 100644 --- 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. -- 2.39.2