[Arcana] A new elisp function I'm pretty happy with.

Karl Fogel 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)
>       (save-excursion
>         (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)))
>         (kill-buffer)))
>     dict)
>   "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."
>   (interactive)
>   (kf-instrument)
>   (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 mailing list