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

Karl Fogel kfogel at red-bean.com
Tue Apr 24 00:06:27 CDT 2012


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