[Arcana] A new elisp function I'm pretty happy with.
kfogel at red-bean.com
Tue Apr 24 00:07:35 CDT 2012
Oh, I forgot: remove the "(kf-instrument)" call, sorry -- it's
irrelevant here and will probably not be defined for you.
> I have to admit, I'm pretty pleased with this :-). To try it, type
> "Whups, I made a tranpsosition" [sic], but immediately after typing
> "tranpsosition", invoke the function.
> (defconst kf-words
> (let ((dict (make-hash-table :test 'equal :size 100000))
> (word-source "/usr/share/dict/words"))
> (when (file-exists-p word-source)
> (set-buffer (find-file-noselect word-source))
> (goto-char (point-min))
> (while (< (point) (point-max))
> (let ((this-line-word (buffer-substring-no-properties
> (point) (progn (end-of-line) (point)))))
> (puthash this-line-word 0 dict)
> (forward-line 1)))
> "Hash table whose keys are English words and whose values are ignored.")
> (defun kf-fix-previous-transposition ()
> "Fix a single transposition in the previous word.
> Or if unable to find a single transposition to fix, then leave point
> in the middle of the previous word so the user can fix it by hand.
> The return value is currently undefined; do not depend on it."
> (let* ((orig-pos (point))
> (word-first (progn (forward-word -1) (point)))
> (word-last (progn (forward-word 1) (forward-char -1) (point)))
> (current-pos word-last)
> (fixed-something nil))
> (setq fixed-something
> (catch 'fixed
> (while (> current-pos word-first)
> (goto-char current-pos)
> (transpose-chars 1)
> (let* ((word-bounds (bounds-of-thing-at-point 'word))
> (word-now (buffer-substring-no-properties
> (car word-bounds) (cdr word-bounds))))
> (if (gethash word-now kf-words)
> (throw 'fixed t)
> ;; else undo the transpose chars
> (forward-char -1)
> (transpose-chars 1)
> (setq current-pos (1- current-pos)))))))
> (if fixed-something
> (goto-char orig-pos)
> ;; If didn't manage to fix it, at least put point in the middle
> ;; of the word, closer to where the user might manually fix it.
> (goto-char (/ (+ word-first word-last) 2)))))
> ;; Serving suggestion:
> ;; (global-set-key "\C-ct" 'kf-fix-previous-transposition)
More information about the Arcana