1
0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-11-26 07:33:47 +00:00

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.
This commit is contained in:
Damien Cassou 2019-12-27 15:35:52 +01:00 committed by Eli Zaretskii
parent 1b1aaf37dc
commit 25adbc4a5e
2 changed files with 106 additions and 62 deletions

View File

@ -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
;;

View File

@ -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.