Allow Ispell to save corrections as abbrevs

* lisp/textmodes/ispell.el (ispell-save-corrections-as-abbrevs):
New user option.
(ispell--abbrev-saving-allowed)
(ispell--save-correction-as-abbrev): New variables.
(ispell--maybe-save-correction-abbrev): New function.
(ispell-word, ispell-process-line): Use them to save corrections
as abbrevs when appropriate (bug#79985).
(ispell-command-loop): Add C-u as command character to toggle
abbrev saving for an immediately following replacement command.
(ispell-help): Document C-u binding.

* doc/emacs/fixit.texi (Spelling): Document new feature.

doc/emacs/fixit.texi

@@ -343,6 +343,19 @@ numbered @dfn{near-misses}---words that are close to the incorrect word.
 Then you must type a single-character response.  Here are the valid
 responses:
 
+@vindex ispell-save-corrections-as-abbrevs
+  You can have Ispell remember your spelling corrections so that they
+are applied automatically when Abbrev mode is enabled (@pxref{Abbrevs}).
+The user option @code{ispell-save-corrections-as-abbrevs} determines
+whether Ispell does so by default.  With that option enabled, each time
+you correct a misspelled word, Emacs saves the correction as a global
+abbrev expansion.  Then, whenever you type the misspelling and then a
+word-separator (@key{SPC}, comma, etc.) in a buffer with Abbrev mode
+enabled, Emacs will expand the misspelling to its correction.
+Regardless of this option's value, you can toggle abbrev saving for a
+single correction by typing @kbd{C-u} immediately before selecting a
+replacement in the command loop.
+
 @table @kbd
 @item @var{digit}
 Replace the word, just this time, with one of the displayed

etc/NEWS

@@ -2077,6 +2077,14 @@ option 'doc-view-djvused-program'.
 The default value is now 30 seconds, as the old value was too short to
 allow reading the help text.
 
++++
+*** Ispell can now save spelling corrections as abbrevs.
+In the Ispell command loop, type 'C-u' immediately before selecting a
+replacement to toggle whether that correction will be saved as a global
+abbrev expansion for its misspelling.  The new user option
+'ispell-save-corrections-as-abbrevs' determines whether abbrev saving
+is enabled by default.
+
 ** Flyspell
 
 ---

lisp/textmodes/ispell.el

@@ -164,6 +164,16 @@ may produce undesired results."
 Uses `query-replace' (\\[query-replace]) for corrections."
   :type 'boolean)
 
+(defcustom ispell-save-corrections-as-abbrevs nil
+  "Whether to save spelling corrections as abbrevs by default.
+Determines the default behavior of Ispell after correcting a misspelled
+word.  Non-nil means to save a global abbrev that expands the misspelled
+word to its correction.  This behavior may be toggled on a per-word
+basis by typing \\`C-u' immediately before selecting a replacement in
+the Ispell command loop."
+  :type 'boolean
+  :version "31.1")
+
 (defcustom ispell-skip-tib nil
   "Does not spell check `tib' bibliography references when non-nil.
 Skips any text between strings matching regular expressions
@@ -1821,6 +1831,28 @@ Only works for Aspell and Enchant."
   (and (or ispell-really-aspell ispell-really-enchant)
        (ispell-send-string (concat "$$ra " misspelled "," replacement "\n"))))
 
+(defvar ispell--abbrev-saving-allowed nil
+  "Non-nil means the current `ispell-command-loop' supports abbrev saving.
+Dynamically bound around calls to `ispell-command-loop' for which it
+makes sense to allow abbrev saving.  This includes calls from functions
+like `ispell-word' and `ispell-region', but excludes calls from
+functions like `ispell-complete-word'.")
+
+(defvar ispell--save-correction-as-abbrev nil
+  "Non-nil means save the current correction as an abbrev.
+Dynamically bound to the value of `ispell-save-corrections-as-abbrevs'
+around calls to `ispell-command-loop'.  The command loop can toggle
+this, via `C-u', to control abbrev saving for the immediately following
+replacement command (a selection from the suggestion list, or
+\\`r'/\\`R').")
+
+(defun ispell--maybe-save-correction-abbrev (misspelled replacement)
+  "Save MISSPELLED -> REPLACEMENT as an abbrev, if enabled.
+This is controlled by the variable `ispell--save-correction-as-abbrev'."
+  (require 'abbrev)
+  (when ispell--save-correction-as-abbrev
+    (define-abbrev global-abbrev-table misspelled replacement)
+    (message "\"%s\" now expands to \"%s\" globally" misspelled replacement)))
 
 (defun ispell-send-string (string)
   "Send the string STRING to the Ispell process."
@@ -1971,38 +2003,42 @@ quit          spell session exited."
 	       (message "%s is incorrect"
                         (funcall ispell-format-word-function word))))
 	    (t				; prompt for correct word.
-	     (save-window-excursion
-	       (setq replace (ispell-command-loop
-			      (car (cdr (cdr poss)))
-			      (car (cdr (cdr (cdr poss))))
-			      (car poss) start end)))
-	     (cond ((equal 0 replace)
-		    (ispell-add-per-file-word-list (car poss)))
-		   (replace
-		    (setq new-word (if (atom replace) replace (car replace))
-			  cursor-location (+ (- (length word) (- end start))
-					     cursor-location))
-		    (if (not (equal new-word (car poss)))
-			(progn
-			  (goto-char start)
-			  ;; Insert first and then delete,
-			  ;; to avoid collapsing markers before and after
-			  ;; into a single place.
-			  (insert new-word)
-			  (delete-region (point) end)
-			  ;; It is meaningless to preserve the cursor position
-			  ;; inside a word that has changed.
-			  (setq cursor-location (point))
-			  (setq end (point))))
-		    (if (not (atom replace)) ;recheck spelling of replacement
-			(progn
-			  (if (car (cdr replace)) ; query replace requested
-			      (save-window-excursion
-				(query-replace word new-word t)))
-			  (goto-char start)
-			  ;; single word could be split into multiple words
-			  (setq ispell-quit (not (ispell-region start end)))
-			  ))))
+	     (let ((ispell--abbrev-saving-allowed t)
+	           (ispell--save-correction-as-abbrev
+	            ispell-save-corrections-as-abbrevs))
+	       (save-window-excursion
+		 (setq replace (ispell-command-loop
+				(car (cdr (cdr poss)))
+				(car (cdr (cdr (cdr poss))))
+				(car poss) start end)))
+	       (cond ((equal 0 replace)
+		      (ispell-add-per-file-word-list (car poss)))
+		     (replace
+		      (setq new-word (if (atom replace) replace (car replace))
+			    cursor-location (+ (- (length word) (- end start))
+					       cursor-location))
+		      (ispell--maybe-save-correction-abbrev (car poss) new-word)
+		      (if (not (equal new-word (car poss)))
+			  (progn
+			    (goto-char start)
+			    ;; Insert first and then delete,
+			    ;; to avoid collapsing markers before and after
+			    ;; into a single place.
+			    (insert new-word)
+			    (delete-region (point) end)
+			    ;; It is meaningless to preserve the cursor position
+			    ;; inside a word that has changed.
+			    (setq cursor-location (point))
+			    (setq end (point))))
+		      (if (not (atom replace)) ;recheck spelling of replacement
+			  (progn
+			    (if (car (cdr replace)) ; query replace requested
+				(save-window-excursion
+				  (query-replace word new-word t)))
+			    (goto-char start)
+			    ;; single word could be split into multiple words
+			    (setq ispell-quit (not (ispell-region start end)))
+			    )))))
 	     ;; keep if rechecking word and we keep choices win.
 	     (if (get-buffer ispell-choices-buffer)
 		 (kill-buffer ispell-choices-buffer))))
@@ -2167,9 +2203,12 @@ Global `ispell-quit' is set to start location to continue spell session."
 	(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 ))
+	(command-characters
+	 (append '( ?  ?i ?a ?A ?r ?R ?? ?x ?X ?q ?l ?u ?m )
+		 (and ispell--abbrev-saving-allowed
+		      '(?\C-u))))
 	(skipped 0)
-	char num result textwin)
+	char num result textwin abbrev-prefix)
 
     ;; setup the *Choices* buffer with valid data.
     (with-current-buffer (get-buffer-create ispell-choices-buffer)
@@ -2235,8 +2274,14 @@ Global `ispell-quit' is set to start location to continue spell session."
 		(progn
 		  (undo-boundary)
 		  (let (message-log-max)
-		    (message (concat "C-h or ? for more options; SPC to leave "
-				     "unchanged, Character to replace word")))
+		    (message
+		     (concat
+		      "C-h or ? for more options; SPC to leave "
+		      "unchanged, Character to replace word"
+		      (and ispell--abbrev-saving-allowed abbrev-prefix
+			   (if ispell--save-correction-as-abbrev
+			       " [won't save as abbrev]"
+			     " [will save as abbrev]")))))
 		  (let ((inhibit-quit t)
 			(input-valid t))
 		    (setq char nil skipped 0)
@@ -2262,6 +2307,22 @@ Global `ispell-quit' is set to start location to continue spell session."
 		      (setq com-chars (cdr com-chars)))
 		    (setq num (- char ?0 skipped)))
 
+		  (if (and abbrev-prefix
+			   (or (memq char '(?r ?R))
+			       (and (>= num 0) (< num count))))
+		      ;; If the user typed `C-u' before this replacement
+		      ;; command, then toggle abbrev saving for this
+		      ;; correction.
+		      (setq ispell--save-correction-as-abbrev
+			    (not ispell--save-correction-as-abbrev)
+			    abbrev-prefix nil)
+		    ;; If the user typed `C-u' but not before a
+		    ;; replacement command, then nullify the effect of
+		    ;; `C-u' for subsequent commands.
+		    (when (and abbrev-prefix
+			       (not (= char ?\C-u)))
+		      (setq abbrev-prefix nil)))
+
 		  (cond
 		   ((= char ? ) nil)	; accept word this time only
 		   ((= char ?i)		; accept and insert word into pers dict
@@ -2419,6 +2480,9 @@ Global `ispell-quit' is set to start location to continue spell session."
 		   ((= char ?\C-z)
 		    (funcall (key-binding "\C-z"))
 		    t)
+		   ((and (= char ?\C-u) ispell--abbrev-saving-allowed)
+		    (setq abbrev-prefix (not abbrev-prefix))
+		    t)
 		   (t (ding) t))))))
 	  result)
       ;; protected
@@ -2463,6 +2527,7 @@ Selections are:
 \\`m'   Place typed-in value in personal dictionary, then recheck current word.
 \\`C-l' Redraw screen.
 \\`C-r' Recursive edit.
+\\`C-u' Toggle abbrev saving for the immediately following replacement command.
 \\`C-z' Suspend Emacs or iconify frame."
 
   (if (equal ispell-help-in-bufferp 'electric)
@@ -2497,6 +2562,7 @@ Selections are:
 \\`m'     Place typed-in value in personal dictionary, then recheck current word.
 \\`C-l'   Redraw screen.
 \\`C-r'   Recursive edit.
+\\`C-u'   Toggle abbrev saving for the immediately following replacement command.
 \\`C-z'   Suspend Emacs or iconify frame."))
            nil)))
 
@@ -2506,12 +2572,14 @@ Selections are:
 	  (help-2 (concat "[l]ook a word up in alternate dictionary;  "
 			  "e[x/X]it;  [q]uit session"))
 	  (help-3 (concat "[u]ncapitalized insert into dict.  "
-			  "Type `x C-h f ispell-help' for more help")))
+			  (and ispell--abbrev-saving-allowed
+			       "C-u toggles abbrev saving (next replacement).")))
+	  (help-4 (concat "Type `x C-h f ispell-help' for more help")))
       (save-window-excursion
 	(if ispell-help-in-bufferp
 	    (let ((buffer (get-buffer-create "*Ispell Help*")))
 	      (with-current-buffer buffer
-		(insert (concat help-1 "\n" help-2 "\n" help-3)))
+		(insert (concat help-1 "\n" help-2 "\n" help-3 "\n" help-4)))
 	      (ispell-display-buffer buffer)
 	      (sit-for (max 0.5 ispell-help-timeout))
 	      (kill-buffer "*Ispell Help*"))
@@ -2522,7 +2590,7 @@ Selections are:
 		(message nil)
 		;;(set-minibuffer-window (selected-window))
 		(enlarge-window 2)
-		(insert (concat help-1 "\n" help-2 "\n" help-3))
+		(insert (concat help-1 "\n" help-2 "\n" help-3 "\n" help-4))
 		(sit-for (max 0.5 ispell-help-timeout)))
 	    (erase-buffer)))))))
 
@@ -3505,7 +3573,9 @@ word that was queried about."
 		(word-len (length (car poss)))
 		(line-end (copy-marker ispell-end))
 		(line-start (copy-marker ispell-start))
-		recheck-region replace)
+		recheck-region replace
+		(ispell--abbrev-saving-allowed t)
+		(ispell--save-correction-as-abbrev ispell-save-corrections-as-abbrevs))
 	    (goto-char word-start)
 	    ;; Adjust the horizontal scroll & point
 	    (ispell-horiz-scroll)
@@ -3573,11 +3643,13 @@ word that was queried about."
                   (progn
                     (insert replace)    ; Insert dictionary word.
                     (ispell-send-replacement (car poss) replace)
+                    (ispell--maybe-save-correction-abbrev (car poss) replace)
                     (setq accept-list (cons replace accept-list)))
                 (let ((replace-word (car replace)))
                   ;; Recheck hand entered replacement word.
                   (insert replace-word)
                   (ispell-send-replacement (car poss) replace-word)
+                  (ispell--maybe-save-correction-abbrev (car poss) replace-word)
                   (if (car (cdr replace))
                       (save-window-excursion
                         (delete-other-windows) ; to correctly show help.