547 lines
21 KiB
EmacsLisp
547 lines
21 KiB
EmacsLisp
;;; flyspell-correct.el --- Correcting words with flyspell via custom interface -*- lexical-binding: t; -*-
|
|
;;
|
|
;; Copyright (c) 2016-2022 Boris Buliga
|
|
;;
|
|
;; Author: Boris Buliga <boris@d12frosted.io>
|
|
;; URL: https://github.com/d12frosted/flyspell-correct
|
|
;; Version: 0.6.1
|
|
;; Package-Requires: ((emacs "24"))
|
|
;;
|
|
;; This file is not part of GNU Emacs.
|
|
;;
|
|
;;; License: GPLv3
|
|
;;
|
|
;;; Commentary:
|
|
;;
|
|
;; This package provides functionality for correcting words via custom
|
|
;; interfaces. There are several functions for this:
|
|
;;
|
|
;; - `flyspell-correct-at-point' - to correct word at point.
|
|
;; - `flyspell-correct-previous' to correct any visible word before the point.
|
|
;; - `flyspell-correct-next' to correct any visible word after the point.
|
|
;; - `flyspell-correct-wrapper' - a beefed wrapper for
|
|
;; `flyspell-correct-previous' and `flyspell-correct-next' allowing one to
|
|
;; correct many words at once (rapid flow) and change correction direction.
|
|
;;
|
|
;; In most cases the last function is the most convenient, so don't forget to
|
|
;; bind it.
|
|
;;
|
|
;; (define-key flyspell-mode-map (kbd "C-;") 'flyspell-correct-wrapper)
|
|
;;
|
|
;; When invoked, it will show the list of corrections suggested by Flyspell.
|
|
;;
|
|
;; Most interfaces also allow you to save the new word to your dictionary,
|
|
;; accept this spelling in current buffer or for a whole session, or even skip
|
|
;; this word (useful in a rapid flow).
|
|
;;
|
|
;; Default interface is implemented using `completing-read', but it's highly
|
|
;; advised to use `flyspell-correct-ido' (which comes bundled with this package)
|
|
;; or any interface provided by following packages: `flyspell-correct-ivy',
|
|
;; `flyspell-correct-helm' and `flyspell-correct-popup'.
|
|
;;
|
|
;; In order to use `flyspell-correct-ido' interface instead of default
|
|
;; `flyspell-correct-completing-read', place following snippet in your
|
|
;; 'init.el' file.
|
|
;;
|
|
;; (require 'flyspell-correct-ido)
|
|
;;
|
|
;; It's easy to implement your own interface for `flyspell-correct'. Checkout
|
|
;; documentation for `flyspell-correct-interface' variable.
|
|
;;
|
|
;; For more information about this and related packages, please refer to
|
|
;; attached README.org file.
|
|
;;
|
|
;;; Code:
|
|
;;
|
|
|
|
;; Requires
|
|
|
|
(require 'flyspell)
|
|
|
|
;; Variables
|
|
|
|
(defcustom flyspell-correct-interface #'flyspell-correct-completing-read
|
|
"Interface for `flyspell-correct-at-point'.
|
|
|
|
`flyspell-correct-interface' is a function accepting two arguments:
|
|
|
|
- candidates for correction (list of strings)
|
|
- misspelled word (string)
|
|
|
|
Result must be either a string (replacement word) or a cons of a
|
|
command and a string (replacement word), where the command is one
|
|
of the following:
|
|
|
|
- skip - do nothing to misspelled word, in rapid mode used for
|
|
jumping to the next (or previous) misspelled word
|
|
|
|
- break - do nothing to misspelled word, break from rapid mode
|
|
|
|
- stop - do nothing to misspelled word, break from rapid
|
|
mode (if enabled) and leave the point at the misspelled word
|
|
|
|
- save - replace misspelled word with replacement word and save
|
|
it to the personal dictionary
|
|
|
|
- session - replace misspelled word with replacement word and
|
|
save it to the session dictionary (correction will be
|
|
discarded upon quitting Emacs)
|
|
|
|
- buffer - replace misspelled word with replacement word and
|
|
save it to the buffer dictionary (added to the bottom of
|
|
buffer)"
|
|
:group 'flyspell-correct
|
|
:type 'function)
|
|
|
|
(defcustom flyspell-correct-highlight t
|
|
"When non-nil highlight the word while correcting.
|
|
|
|
The face `flyspell-correct-highlight-face' is used for
|
|
highlighting."
|
|
:group 'flyspell-correct
|
|
:type 'boolean)
|
|
|
|
(defface flyspell-correct-highlight-face
|
|
'((t (:inherit isearch)))
|
|
"Face used for highlighting the word while correcting."
|
|
:group 'flyspell-correct)
|
|
|
|
(defvar flyspell-correct-overlay nil)
|
|
|
|
;;; Default interface using `completing-read'
|
|
;;
|
|
|
|
(defvar flyspell-correct--cr-key "@"
|
|
"Shortcut key used by `flyspell-correct-completing-read'.")
|
|
|
|
(defvar flyspell-correct--cr-actions
|
|
'((save ?s "[Save]")
|
|
(session ?a "[Accept (session)]")
|
|
(buffer ?b "[Accept (buffer)]")
|
|
(skip ?k "[Skip]")
|
|
(stop ?p "[Stop]"))
|
|
"Actions used by `flyspell-correct-completing-read'.")
|
|
|
|
(defun flyspell-correct--cr-index (n)
|
|
"Generate a short unique index string for N.
|
|
|
|
The index string is used to prefix suggestion candidates. The digits 12345
|
|
encode (mod n 5) and occur as suffix of the index string. If one of the keys
|
|
12345 is pressed, the selected candidate is automatically submitted. The
|
|
remaining value (/ n 5) is encoded using the digits 67890, which occur in the
|
|
prefix of the index string."
|
|
(let ((str (char-to-string (+ ?1 (mod n 5)))))
|
|
(when (>= n 5)
|
|
(setq n (/ (- n 5) 5))
|
|
(while (>= n 0)
|
|
(setq str (format "%c%s" (aref "67890" (mod n 5)) str)
|
|
n (1- (/ n 5)))))
|
|
str))
|
|
|
|
(defun flyspell-correct-completing-read (candidates word)
|
|
"Run `completing-read' for the given CANDIDATES.
|
|
|
|
List of CANDIDATES is given by flyspell for the WORD.
|
|
|
|
Return a selected word to use as a replacement or a tuple
|
|
of (command, word) to be used by `flyspell-do-correct'."
|
|
(let* ((idx 0)
|
|
(candidates-alist
|
|
(append
|
|
(mapcar (lambda (cand)
|
|
(prog1
|
|
(cons (concat
|
|
(propertize (flyspell-correct--cr-index idx) 'face 'minibuffer-prompt)
|
|
" " cand)
|
|
cand)
|
|
(setq idx (1+ idx))))
|
|
candidates)
|
|
(mapcar
|
|
(pcase-lambda (`(,name ,key ,label))
|
|
(setq key (char-to-string key))
|
|
(cons (concat (propertize (format "%s%s " flyspell-correct--cr-key key) 'invisible t)
|
|
(replace-regexp-in-string
|
|
key (propertize key 'face '(bold minibuffer-prompt))
|
|
(propertize label 'face 'minibuffer-prompt)))
|
|
(cons name word)))
|
|
flyspell-correct--cr-actions)))
|
|
(suggestions-title (format "Suggestions (Dictionary \"%s\")"
|
|
(or ispell-local-dictionary
|
|
ispell-dictionary
|
|
"default")))
|
|
(actions-title (format "Actions (Shortcut key %s)" flyspell-correct--cr-key))
|
|
(metadata `(metadata
|
|
(category . flyspell)
|
|
(display-sort-function . ,#'identity)
|
|
(cycle-sort-function . ,#'identity)
|
|
(group-function
|
|
. ,(lambda (cand transform)
|
|
(cond
|
|
(transform cand)
|
|
((string-prefix-p flyspell-correct--cr-key cand) actions-title)
|
|
(t suggestions-title))))))
|
|
(quick-result)
|
|
(result
|
|
(minibuffer-with-setup-hook
|
|
(lambda ()
|
|
(add-hook 'post-command-hook
|
|
(lambda ()
|
|
;; Exit directly if a quick key is pressed
|
|
(let ((prefix (concat (minibuffer-contents-no-properties) " ")))
|
|
(mapc (lambda (cand)
|
|
(when (string-prefix-p prefix (car cand))
|
|
(setq quick-result (car cand))
|
|
(exit-minibuffer)))
|
|
candidates-alist)))
|
|
-1 'local))
|
|
(completing-read
|
|
(format "Suggestions for \"%s\": " word)
|
|
;; Use function with metadata to disable add a group function
|
|
;; and in order to disable sorting.
|
|
(lambda (input predicate action)
|
|
(if (eq action 'metadata)
|
|
metadata
|
|
(complete-with-action action candidates-alist input predicate)))
|
|
;; Require confirmation, if the input does not match a suggestion
|
|
nil 'confirm nil nil
|
|
;; Pass the word as default value (effectively skipping)
|
|
word))))
|
|
(or (cdr (assoc (or quick-result result) candidates-alist)) result)))
|
|
|
|
(define-obsolete-function-alias
|
|
'flyspell-correct-dummy
|
|
'flyspell-correct-completing-read
|
|
"0.6.1")
|
|
|
|
;;; On point word correction
|
|
;;
|
|
|
|
;;;###autoload
|
|
(defun flyspell-correct-at-point ()
|
|
"Correct word before point using `flyspell-correct-interface'.
|
|
Adapted from `flyspell-correct-word-before-point'."
|
|
(interactive)
|
|
(unless flyspell-correct-interface
|
|
(error "Could not correct word because `flyspell-correct-interface' is not set"))
|
|
(let ((res))
|
|
;; use the correct dictionary
|
|
(flyspell-accept-buffer-local-defs)
|
|
(flyspell-correct--highlight-add)
|
|
(unwind-protect
|
|
(let ((cursor-location (point))
|
|
(word (save-excursion (flyspell-get-word)))
|
|
(opoint (point)))
|
|
(if (consp word)
|
|
(let ((start (nth 1 word))
|
|
(end (nth 2 word))
|
|
(word (car word))
|
|
poss ispell-filter)
|
|
;; now check spelling of word.
|
|
(ispell-send-string "%\n") ;put in verbose mode
|
|
(ispell-send-string (concat "^" word "\n"))
|
|
;; wait until ispell has processed word
|
|
(while (progn
|
|
(accept-process-output ispell-process)
|
|
(not (string= "" (car ispell-filter)))))
|
|
;; Remove leading empty element
|
|
(setq ispell-filter (cdr ispell-filter))
|
|
;; ispell process should return something after word is sent.
|
|
;; Tag word as valid (i.e., skip) otherwise
|
|
(or ispell-filter
|
|
(setq ispell-filter '(*)))
|
|
(if (consp ispell-filter)
|
|
(setq poss (ispell-parse-output (car ispell-filter))))
|
|
(cond
|
|
((or (eq poss t) (stringp poss))
|
|
;; don't correct word
|
|
(message "%s is correct" (funcall ispell-format-word-function word))
|
|
t)
|
|
((null poss)
|
|
;; ispell error
|
|
(error "Ispell: error in Ispell process"))
|
|
(t
|
|
;; The word is incorrect, we have to propose a replacement.
|
|
(setq res (funcall flyspell-correct-interface (nth 2 poss) word))
|
|
;; Some interfaces actually eat 'C-g' so it's impossible to
|
|
;; stop rapid mode. So when interface returns nil we treat it
|
|
;; as a stop. Fixes #60.
|
|
(unless res (setq res (cons 'break word)))
|
|
(cond
|
|
((stringp res)
|
|
(flyspell-do-correct
|
|
res poss word cursor-location start end opoint))
|
|
(t
|
|
(let ((cmd (car res))
|
|
(wrd (cdr res)))
|
|
(unless (or (eq cmd 'skip)
|
|
(eq cmd 'break)
|
|
(eq cmd 'stop))
|
|
(flyspell-do-correct
|
|
cmd poss wrd cursor-location start end opoint)
|
|
(unless (string-equal wrd word)
|
|
(flyspell-do-correct
|
|
wrd poss word cursor-location start end opoint))))))
|
|
(ispell-pdict-save t))))))
|
|
(flyspell-correct--highlight-remove))
|
|
res))
|
|
|
|
;;; Previous word correction
|
|
;;
|
|
|
|
;;;###autoload
|
|
(defun flyspell-correct-previous (position)
|
|
"Correct the first misspelled word that occurs before POSITION.
|
|
But don't look beyond what's visible on the screen.
|
|
|
|
Uses `flyspell-correct-at-point' function for correction.
|
|
|
|
With a prefix argument, automatically continues to all prior misspelled words in the buffer."
|
|
(interactive "d")
|
|
(flyspell-correct-move position nil current-prefix-arg))
|
|
|
|
;;; Next word correction
|
|
;;
|
|
|
|
;;;###autoload
|
|
(defun flyspell-correct-next (position)
|
|
"Correct the first misspelled word that occurs after POSITION.
|
|
|
|
Uses `flyspell-correct-at-point' function for correction.
|
|
|
|
With a prefix argument, automatically continues to all further
|
|
misspelled words in the buffer."
|
|
(interactive "d")
|
|
(flyspell-correct-move position t current-prefix-arg))
|
|
|
|
;;; Generic helpers
|
|
;;
|
|
|
|
;;;###autoload
|
|
(defun flyspell-correct-wrapper ()
|
|
"Correct spelling error in a dwim fashion based on universal argument.
|
|
|
|
- One \\[universal-argument] enables rapid mode.
|
|
- Two \\[universal-argument]'s changes direction of spelling
|
|
errors search.
|
|
- Three \\[universal-argument]'s changes direction of spelling
|
|
errors search and enables rapid mode."
|
|
(interactive)
|
|
(let ((forward-direction nil)
|
|
(rapid nil))
|
|
(cond
|
|
((equal current-prefix-arg '(4)) ; C-u = rapid
|
|
(setq rapid t))
|
|
((equal current-prefix-arg '(16)) ; C-u C-u = change direction
|
|
(setq forward-direction t))
|
|
((equal current-prefix-arg '(64)) ; C-u C-u C-u = do both
|
|
(setq rapid t)
|
|
(setq forward-direction t)))
|
|
|
|
(flyspell-correct-move (point) forward-direction rapid)))
|
|
|
|
;;;###autoload
|
|
(defun flyspell-correct-move (position &optional forward rapid)
|
|
"Correct the first misspelled word that occurs before POSITION.
|
|
|
|
Uses `flyspell-correct-at-point' function for correction.
|
|
|
|
With FORWARD set non-nil, check forward instead of backward.
|
|
|
|
With RAPID set non-nil, automatically continues in direction
|
|
until all errors in buffer have been addressed."
|
|
;; NOTE: The way I may be pushing the mark may possibly be more
|
|
;; idiomatically done using the opoint arg of
|
|
;; `flyspell-correct-word-before-point'.
|
|
(interactive "d")
|
|
;; push mark when starting
|
|
(when (or (not (mark t))
|
|
(/= (mark t) (point)))
|
|
(push-mark (point) t))
|
|
(let ((original-pos (point))
|
|
(target-pos (point))
|
|
(hard-move-point)
|
|
(mark-opos))
|
|
(unwind-protect
|
|
(save-excursion
|
|
(let ((incorrect-word-pos))
|
|
|
|
;; narrow the region
|
|
(overlay-recenter (point))
|
|
|
|
(let* ((unsorted-overlay-list
|
|
(if forward
|
|
(overlays-in (- position 1) (point-max))
|
|
(overlays-in (point-min) (+ position 1))))
|
|
(comp (if forward #'< #'>))
|
|
(overlay-list (sort
|
|
unsorted-overlay-list
|
|
(lambda (o1 o2)
|
|
(funcall comp
|
|
(overlay-start o1)
|
|
(overlay-start o2)))))
|
|
(overlay 'dummy-value))
|
|
(while overlay
|
|
(setq overlay (car-safe overlay-list))
|
|
(setq overlay-list (cdr-safe overlay-list))
|
|
(when (and overlay
|
|
(flyspell-overlay-p overlay))
|
|
(setq incorrect-word-pos (overlay-start overlay))
|
|
(let ((scroll (> incorrect-word-pos (window-end))))
|
|
(goto-char incorrect-word-pos)
|
|
(when scroll (ignore-errors (recenter))))
|
|
|
|
;; Point originally was on misspelled word, so we need to restore
|
|
;; it. This imitates just calling `flyspell-correct-at-point'. But
|
|
;; gives all the perks of `flyspell-correct-move'.
|
|
;;
|
|
;; But with rapid mode, `hard-move-point' will be set to nil
|
|
;; eventually. Which gives more predictable point location in
|
|
;; general.
|
|
(setq hard-move-point
|
|
(and (>= original-pos (overlay-start overlay))
|
|
(<= original-pos (overlay-end overlay))))
|
|
|
|
;; Correct a word using `flyspell-correct-at-point'.
|
|
(let ((res (flyspell-correct-at-point)))
|
|
(when res
|
|
;; stop at misspelled word
|
|
(when (eq (car-safe res) 'stop)
|
|
(setq target-pos incorrect-word-pos
|
|
hard-move-point t
|
|
mark-opos t))
|
|
|
|
;; break from rapid mode
|
|
(when (or
|
|
;; treat skip as one-time rapid mode enabler
|
|
(and (not (eq (car-safe res) 'skip))
|
|
(not rapid))
|
|
|
|
;; explicit rapid mode disablers
|
|
(eq (car-safe res) 'break)
|
|
(eq (car-safe res) 'stop))
|
|
(setq overlay nil))
|
|
|
|
(when (and
|
|
;; don't push mark if there is no change
|
|
(not (memq (car-safe res) '(stop break skip)))
|
|
(/= (mark t) (point)))
|
|
;; `flyspell-correct-at-point' may move point, use
|
|
;; original `incorrect-word-pos' instead
|
|
(push-mark incorrect-word-pos t)))))))))
|
|
|
|
(when hard-move-point
|
|
(when mark-opos
|
|
(push-mark (point) t))
|
|
(goto-char target-pos))
|
|
;; We pushed the mark when starting, but if the operation is canceled
|
|
;; without any change that mark is redundant and needs to be cleaned-up.
|
|
(when (= (mark t) (point)) (pop-mark)))))
|
|
|
|
;;; Overlays
|
|
|
|
(defun flyspell-correct--highlight-add ()
|
|
"Highlight the spelling error at point."
|
|
(when flyspell-correct-highlight
|
|
(let* ((ov (flyspell-correct--overlay-loc))
|
|
(ov-start (car-safe ov))
|
|
(ov-end (cdr-safe ov)))
|
|
(when ov
|
|
(if flyspell-correct-overlay
|
|
(move-overlay flyspell-correct-overlay ov-start ov-end (current-buffer))
|
|
(setq flyspell-correct-overlay (make-overlay ov-start ov-end))
|
|
(overlay-put flyspell-correct-overlay 'priority 1001)
|
|
(overlay-put flyspell-correct-overlay 'face 'flyspell-correct-highlight-face))))))
|
|
|
|
(defun flyspell-correct--highlight-remove ()
|
|
"Remove the highlight of the spelling error at point."
|
|
(when flyspell-correct-overlay
|
|
(delete-overlay flyspell-correct-overlay)
|
|
(setq flyspell-correct-overlay nil)))
|
|
|
|
(defun flyspell-correct--overlay-loc ()
|
|
"Return `cons' with start and end of `flyspell' overlay at point.
|
|
|
|
Returns nil if no overlay is found."
|
|
(let ((ovs (overlays-at (point)))
|
|
ov)
|
|
(while (and (not ov) ovs)
|
|
(let ((current (pop ovs)))
|
|
(when (flyspell-overlay-p current)
|
|
(setq ov current))))
|
|
(when ov
|
|
(let ((ov-start (overlay-start ov))
|
|
(ov-end (overlay-end ov)))
|
|
(cons ov-start ov-end)))))
|
|
|
|
;;; Automatically correct
|
|
;; based on `flyspell-popup-auto-correct-mode'
|
|
|
|
(defcustom flyspell-correct-auto-delay 1.6
|
|
"Delay in seconds before `flyspell-correct-previous' is called.
|
|
Use floating point numbers to express fractions of seconds."
|
|
:group 'flyspell
|
|
:type 'number
|
|
:safe #'numberp)
|
|
|
|
(defvar flyspell-correct-auto-mode-interface nil
|
|
"Interface to use in `flyspell-correct-auto-mode'.
|
|
When set to nil `flyspell-correct-interface' is used.")
|
|
|
|
(defvar flyspell-correct--auto-timer nil
|
|
"Timer to automatically call `flyspell-correct-previous'.")
|
|
(make-variable-buffer-local 'flyspell-correct--auto-timer)
|
|
|
|
(defvar flyspell-correct--auto-active-p nil)
|
|
(make-variable-buffer-local 'flyspell-correct--auto-active-p)
|
|
|
|
(defun flyspell-correct-auto-cancel-timer ()
|
|
"Cancel auto correct timer."
|
|
(when flyspell-correct--auto-timer
|
|
(cancel-timer flyspell-correct--auto-timer)
|
|
(setq flyspell-correct--auto-timer nil)))
|
|
|
|
(defun flyspell-correct-auto-soon ()
|
|
"Call `flyspell-correct-previous' delayed."
|
|
(flyspell-correct-auto-cancel-timer)
|
|
(when (and flyspell-mode
|
|
(not (bound-and-true-p flyspell-correct--auto-active-p)))
|
|
(setq
|
|
flyspell-correct--auto-timer
|
|
(run-at-time
|
|
flyspell-correct-auto-delay
|
|
nil
|
|
(lambda ()
|
|
(flyspell-correct-auto-cancel-timer)
|
|
(when (and flyspell-mode
|
|
(not (bound-and-true-p flyspell-correct--auto-active-p)))
|
|
(setq flyspell-correct--auto-active-p t)
|
|
(with-local-quit
|
|
(let ((flyspell-correct-interface
|
|
(if (bound-and-true-p flyspell-correct-auto-mode-interface)
|
|
flyspell-correct-auto-mode-interface
|
|
flyspell-correct-interface)))
|
|
(call-interactively #'flyspell-correct-previous)))
|
|
(setq flyspell-correct--auto-active-p nil)))))))
|
|
|
|
;;;###autoload
|
|
(define-minor-mode flyspell-correct-auto-mode
|
|
"Minor mode for automatically correcting word at point.
|
|
|
|
Take my advice and don't use this functionality unless you find
|
|
`flyspell-correct-previous' function useless for your purposes.
|
|
Seriously, just try named function for completion. You can find
|
|
more info in comment[1].
|
|
|
|
[1]:
|
|
https://github.com/syl20bnr/spacemacs/issues/6209#issuecomment-274320376"
|
|
:group 'flyspell
|
|
:lighter "auto-correct"
|
|
(if flyspell-correct-auto-mode
|
|
(progn
|
|
(add-hook 'post-command-hook 'flyspell-correct-auto-soon nil 'local))
|
|
(remove-hook 'post-command-hook 'flyspell-correct-auto-soon 'local)))
|
|
|
|
(provide 'flyspell-correct)
|
|
|
|
;;; flyspell-correct.el ends here
|