consult-jinx.el (5739B)
1 ;;; consult-jinx.el --- Consult commands for Jinx misspellings -*- lexical-binding: t -*- 2 3 ;;; Commentary: 4 5 ;; This package provides `consult-jinx' for navigating Jinx misspellings 6 ;; via Consult. Correction is provided through Embark integration: 7 ;; run `consult-jinx', select a misspelling, then use `embark-act' and 8 ;; press 'c' to correct it. 9 10 ;;; Code: 11 12 (require 'jinx) 13 (require 'consult) 14 15 (defgroup consult-jinx nil 16 "Consult commands for Jinx misspellings." 17 :group 'consult 18 :group 'jinx 19 :prefix "consult-jinx-") 20 21 (defcustom consult-jinx-candidate-style 'full-line 22 "Style of candidate display in `consult-jinx'. 23 `compact' shows only the misspelled word in a compact format. 24 `full-line' shows the full line content with the misspelled word highlighted." 25 :type '(choice (const :tag "Compact" compact) 26 (const :tag "Full line" full-line))) 27 28 (defvar consult-jinx--narrow 29 '((?m . "Misspelled")) 30 "Narrow keys for consult-jinx.") 31 32 (defface consult-jinx-line-number-prefix 33 '((t :inherit consult-line-number)) 34 "Face used for line numbers of misspellings from current line onwards.") 35 36 (defface consult-jinx-line-number-wrapped 37 '((t :inherit consult-line-number-wrapped :weight normal)) 38 "Face used for line numbers of misspellings before current line.") 39 40 (defun consult-jinx--candidates () 41 "Return jinx misspellings as candidates list for consult." 42 (consult--forbid-minibuffer) 43 (unless jinx-mode 44 (user-error "Jinx mode not enabled in current buffer")) 45 (let* ((curr-line (line-number-at-pos (point))) 46 (overlays (jinx--force-overlays (point-min) (point-max) :check t)) 47 default-cand candidates) 48 (unless overlays 49 (user-error "No misspellings")) 50 (let* ((line-width (length (number-to-string (line-number-at-pos (point-max))))) 51 (word-width (when (eq consult-jinx-candidate-style 'compact) 52 (apply #'max (mapcar 53 (lambda (ov) 54 (- (overlay-end ov) (overlay-start ov))) 55 overlays))))) 56 (dolist (ov overlays) 57 (let* ((start (overlay-start ov)) 58 (end (overlay-end ov)) 59 (line (line-number-at-pos start)) 60 (word (buffer-substring-no-properties start end))) 61 (save-excursion 62 (goto-char start) 63 (let* ((bol (pos-bol)) 64 (eol (pos-eol)) 65 (line-str (propertize (format (format "%%%dd" line-width) line) 66 'face (if (< line curr-line) 67 'consult-jinx-line-number-wrapped 68 'consult-jinx-line-number-prefix))) 69 (line-content (buffer-substring bol eol)) 70 (word-offset (- start bol)) 71 (word-len (- end start)) 72 cand-str) 73 ;; Highlight the misspelled word in the line content 74 (when (and (>= word-offset 0) 75 (<= (+ word-offset word-len) (length line-content))) 76 (put-text-property word-offset (+ word-offset word-len) 77 'face 'jinx-highlight line-content)) 78 ;; Build candidate string based on style 79 (setq cand-str 80 (if (eq consult-jinx-candidate-style 'compact) 81 (format (format "%%s %%-%ds" word-width) 82 line-str 83 (propertize word 'face 'error)) 84 (format "%s %s%s" line-str line-content 85 (propertize (format " @%d" word-offset) 'invisible t)))) 86 (push (propertize 87 cand-str 88 'consult--candidate (list (set-marker (make-marker) start) (cons 0 word-len)) 89 'consult--type ?m) 90 candidates) 91 (when (and (not default-cand) (>= line curr-line)) 92 (setq default-cand candidates)))))) 93 (nreverse 94 (if default-cand 95 (let ((before (cdr default-cand))) 96 (setcdr default-cand nil) 97 (nconc before candidates)) 98 candidates))))) 99 100 ;;;###autoload 101 (defun consult-jinx () 102 "Jump to a jinx misspelled word." 103 (interactive) 104 (consult--forbid-minibuffer) 105 (unless jinx-mode 106 (user-error "Jinx mode not enabled in current buffer")) 107 (consult--read 108 (consult--with-increased-gc (consult-jinx--candidates)) 109 :prompt "Jinx misspelling: " 110 :category 'consult-jinx-misspelling 111 :history t 112 :require-match t 113 :sort nil 114 :narrow (consult--type-narrow consult-jinx--narrow) 115 :group (consult--type-group consult-jinx--narrow) 116 :lookup #'consult--lookup-candidate 117 :state (consult--jump-state))) 118 119 ;;;; Embark integration 120 121 (defun consult-jinx--correct (target) 122 "Correct the misspelled word at TARGET. 123 TARGET is a consult-jinx candidate string." 124 (let* ((result (get-text-property 0 'consult--candidate target)) 125 (marker (car result)) 126 (start (if (markerp marker) (marker-position marker) marker)) 127 (word-len (cdadr result)) 128 (end (+ start word-len))) 129 (jinx-correct-word start end))) 130 131 (with-eval-after-load 'embark 132 (defvar-keymap embark-jinx-map 133 :doc "Embark action map for Jinx misspellings." 134 :parent embark-general-map 135 "c" #'consult-jinx--correct) 136 (add-to-list 'embark-keymap-alist '(consult-jinx-misspelling . embark-jinx-map)) 137 (setf (alist-get 'consult-jinx-misspelling embark-default-action-overrides) 138 #'consult-jinx--correct)) 139 140 (provide 'consult-jinx) 141 ;;; consult-jinx.el ends here