Function: ispell-command-loop
ispell-command-loop is a byte-compiled function defined in
ispell.el.gz.
Signature
(ispell-command-loop MISS GUESS WORD START END)
Documentation
Display possible corrections from MISS using GUESS for WORD in START..END.
MISS lists possible corrections.
GUESS lists possibly valid affix construction of WORD.
Return nil to keep the word unchanged.
Return 0 to insert locally into buffer-local dictionary.
Return a string for the chosen replacement word.
Return a list for new replacement word (will be rechecked).
Use query-replace when list length is 2.
Automatic query-replace when second element is query-replace.
Highlight the word, which is assumed to run from START to END.
Global ispell-pdict-modified-p becomes a list where the only value
indicates whether the dictionary has been modified when option a
or i is used.
Global ispell-quit is set to start location to continue spell session.
Source Code
;; Defined in /usr/src/emacs/lisp/textmodes/ispell.el.gz
(defun ispell-command-loop (miss guess word start end)
"Display possible corrections from MISS using GUESS for WORD in START..END.
MISS lists possible corrections.
GUESS lists possibly valid affix construction of WORD.
Return nil to keep the word unchanged.
Return 0 to insert locally into buffer-local dictionary.
Return a string for the chosen replacement word.
Return a list for new replacement word (will be rechecked).
Use `query-replace' when list length is 2.
Automatic `query-replace' when second element is `query-replace'.
Highlight the word, which is assumed to run from START to END.
Global `ispell-pdict-modified-p' becomes a list where the only value
indicates whether the dictionary has been modified when option `a'
or `i' is used.
Global `ispell-quit' is set to start location to continue spell session."
(let ((count ?0)
(choices miss)
(window-min-height (min window-min-height
ispell-choices-win-default-height))
(command-characters '( ? ?i ?a ?A ?r ?R ?? ?x ?X ?q ?l ?u ?m ))
(skipped 0)
char num result textwin)
;; setup the *Choices* buffer with valid data.
(with-current-buffer (get-buffer-create ispell-choices-buffer)
(setq mode-line-format
(concat
"-- %b -- word: " word
" -- dict: " (or ispell-current-dictionary "default")
" -- prog: " (file-name-nondirectory ispell-program-name)))
;; No need for horizontal scrollbar in choices window
(with-no-warnings
(setq horizontal-scroll-bar nil))
(erase-buffer)
(if guess
(progn
(insert "Affix rules generate and capitalize "
"this word as shown below:\n\t")
(while guess
(when (> (+ 4 (current-column) (length (car guess)))
(window-width))
(insert "\n\t"))
(insert (car guess) " ")
(setq guess (cdr guess)))
(insert (substitute-command-keys
"\nUse option `i' to accept this spelling and put it in your personal dictionary.\n"))))
(while choices
(when (> (+ 7 (current-column)
(length (car choices))
(if (> count ?~) 3 0))
(window-width))
(insert "\n"))
;; not so good if there are over 20 or 30 options, but then, if
;; there are that many you don't want to scan them all anyway...
(while (memq count command-characters) ; skip command characters.
(setq count (1+ count)
skipped (1+ skipped)))
(insert "(" count ") " (car choices) " ")
(setq choices (cdr choices)
count (1+ count)))
(setq count (- count ?0 skipped)))
(run-hooks 'ispell-update-post-hook)
;; ensure word is visible
(if (not (pos-visible-in-window-group-p end))
(sit-for 0))
;; Display choices for misspelled word.
(setq textwin (selected-window))
(ispell-show-choices)
(select-window textwin)
;; highlight word, protecting current buffer status
(unwind-protect
(progn
(and ispell-highlight-p
(ispell-highlight-spelling-error start end t))
;; Loop until a valid choice is made.
(while
(eq
t
(setq
result
(progn
(undo-boundary)
(let (message-log-max)
(message (concat "C-h or ? for more options; SPC to leave "
"unchanged, Character to replace word")))
(let ((inhibit-quit t)
(input-valid t))
(setq char nil skipped 0)
;; If the user types C-g, or generates some other
;; non-character event (such as a frame switch
;; event), stop ispell. As a special exception,
;; ignore mouse events occurring in the same frame.
(while (and input-valid (not (characterp char)))
(setq char (read-key))
(setq input-valid
(or (characterp char)
(and (mouse-event-p char)
(eq (selected-frame)
(window-frame
(posn-window (event-start char))))))))
(when (or quit-flag (not input-valid) (= char ?\C-g))
(setq char ?X quit-flag nil)))
;; Adjust num to array offset skipping command characters.
(let ((com-chars command-characters))
(while com-chars
(if (and (> (car com-chars) ?0) (< (car com-chars) char))
(setq skipped (1+ skipped)))
(setq com-chars (cdr com-chars)))
(setq num (- char ?0 skipped)))
(cond
((= char ? ) nil) ; accept word this time only
((= char ?i) ; accept and insert word into pers dict
(ispell-send-string (concat "*" word "\n"))
(setq ispell-pdict-modified-p '(t)) ; dictionary modified!
(when flyspell-mode
(flyspell-unhighlight-at start))
nil)
((or (= char ?a) (= char ?A)) ; accept word without insert
(ispell-send-string (concat "@" word "\n"))
(cl-pushnew word ispell-buffer-session-localwords
:test #'equal)
(when flyspell-mode
(flyspell-unhighlight-at start))
(or ispell-buffer-local-name ; session localwords might conflict
(setq ispell-buffer-local-name (buffer-name)))
(if (null ispell-pdict-modified-p)
(setq ispell-pdict-modified-p
(list ispell-pdict-modified-p)))
(if (= char ?A) 0)) ; return 0 for ispell-add buffer-local
((or (= char ?r) (= char ?R)) ; type in replacement
(and (eq 'block ispell-highlight-p) ; refresh tty's
(ispell-highlight-spelling-error start end nil t))
(let ((result
(if (or (= char ?R) ispell-query-replace-choices)
(list (read-string
(format "Query-replacement for %s: "word)
word)
t)
(cons (read-string "Replacement for: " word)
nil))))
(and (eq 'block ispell-highlight-p)
(ispell-highlight-spelling-error start end nil
'block))
result))
((or (= char ??) (= char help-char) (= char ?\C-h))
(and (eq 'block ispell-highlight-p)
(ispell-highlight-spelling-error start end nil t))
(ispell-help)
(and (eq 'block ispell-highlight-p)
(ispell-highlight-spelling-error start end nil
'block))
t)
;; Quit and move point back.
((= char ?x)
(ispell-pdict-save ispell-silently-savep)
(message "Exited spell-checking")
(setq ispell-quit t)
nil)
;; Quit and preserve point.
((= char ?X)
(ispell-pdict-save ispell-silently-savep)
(message "%s"
(substitute-command-keys
(concat
"Spell-checking suspended; use "
"\\[universal-argument] \\[ispell-word] to resume")))
(setq ispell-quit start)
nil)
((= char ?q)
(if (y-or-n-p "Really kill Ispell process? ")
(progn
(ispell-kill-ispell t) ; terminate process.
(setq ispell-quit (or (not ispell-checking-message)
(point))
ispell-pdict-modified-p nil))
t)) ; continue if they don't quit.
((= char ?l)
(and (eq 'block ispell-highlight-p) ; refresh tty displays
(ispell-highlight-spelling-error start end nil t))
(let ((new-word (read-string
"Lookup string (`*' is wildcard): "
word)))
(if new-word
(progn
(with-current-buffer (get-buffer-create
ispell-choices-buffer)
(erase-buffer)
(setq count ?0
skipped 0
mode-line-format ;; setup the *Choices* buffer with valid data.
(concat "-- %b -- word: " new-word
" -- word-list: "
(or ispell-complete-word-dict
ispell-alternate-dictionary))
miss (ispell-lookup-words new-word)
choices miss)
(while choices
(when (> (+ 7 (current-column)
(length (car choices))
(if (> count ?~) 3 0))
(window-width))
(insert "\n"))
(while (memq count command-characters)
(setq count (1+ count)
skipped (1+ skipped)))
(insert "(" count ") " (car choices) " ")
(setq choices (cdr choices)
count (1+ count)))
(setq count (- count ?0 skipped)))
(setq textwin (selected-window))
(ispell-show-choices)
(select-window textwin))))
(and (eq 'block ispell-highlight-p)
(ispell-highlight-spelling-error start end nil
'block))
t) ; reselect from new choices
((= char ?u) ; insert lowercase into dictionary
(ispell-send-string (concat "*" (downcase word) "\n"))
(setq ispell-pdict-modified-p '(t)) ; dictionary modified!
nil)
((= char ?m) ; type in what to insert
(ispell-send-string
(concat "*" (read-string "Insert: " word) "\n"))
(setq ispell-pdict-modified-p '(t))
(cons word nil))
((and (>= num 0) (< num count))
(if ispell-query-replace-choices ; Query replace flag
(list (nth num miss) 'query-replace)
(nth num miss)))
((= char ?\C-l)
(redraw-display) t)
((= char ?\C-r)
;; This may have alignment errors if current line is edited
(if (marker-position ispell-recursive-edit-marker)
(progn
(message "Only one recursive edit session supported")
(beep)
(sit-for 2))
(set-marker ispell-recursive-edit-marker start)
;;(set-marker ispell-region-end reg-end)
(and ispell-highlight-p ; unhighlight
(ispell-highlight-spelling-error start end))
(unwind-protect
(progn
(message
"%s"
(substitute-command-keys
(concat "Exit recursive edit with"
" \\[exit-recursive-edit]")))
(save-window-excursion (save-excursion
(recursive-edit))))
;; protected
(goto-char ispell-recursive-edit-marker)
(if (not (equal (marker-buffer
ispell-recursive-edit-marker)
(current-buffer)))
(progn
(set-marker ispell-recursive-edit-marker nil)
(error
"Cannot continue ispell from this buffer")))
(set-marker ispell-recursive-edit-marker nil)))
(list word nil)) ; recheck starting at this word.
((= char ?\C-z)
(funcall (key-binding "\C-z"))
t)
(t (ding) t))))))
result)
;; protected
(and ispell-highlight-p ; unhighlight
(save-window-excursion
(select-window textwin)
(ispell-highlight-spelling-error start end))))))