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 list MISS.

GUESS lists possibly valid affix construction of WORD. Returns nil to keep word. Returns 0 to insert locally into buffer-local dictionary. Returns string for new chosen word. Returns list for new replacement word (will be rechecked).
  Query-replace when list length is 2.
  Automatic query-replace when second element is query-replace.
Highlights 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 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 list MISS.
GUESS lists possibly valid affix construction of WORD.
Returns nil to keep word.
Returns 0 to insert locally into buffer-local dictionary.
Returns string for new chosen word.
Returns list for new replacement word (will be rechecked).
  Query-replace when list length is 2.
  Automatic query-replace when second element is `query-replace'.
Highlights 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' 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 private 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))))))