Create a gist now

Instantly share code, notes, and snippets.

What would you like to do?
Emacs: Replace all words in buffer with random words of the same length
;; This function replaces all words in a buffer with words of the same length,
;; chosen at random from /usr/share/dict/words. Words are replaced consistently,
;; so e.g. "A" is always replaced with "Z". The mapping changes when Emacs is
;; restarted or when the cache buffer is killed. If all unique words of a certain
;; length are exhausted, random strings are used.
(defun ap/replace-words-randomly (&optional buffer)
"Replace all words in BUFFER or current buffer with randomly selected words from the dictionary.
Every time a new word is found, it is mapped to a replacement
word, so every instance of word A will be replaced with word Z."
(require 'ht)
(with-current-buffer (or buffer (current-buffer))
(let ((replacements (ht-create))
(used-words (ht-create))
(regexp (rx (or bow symbol-start) (1+ word) (or eow symbol-end)))
(case-fold-search t)
(orig-mode major-mode)
;; (window (get-buffer-window (current-buffer)))
(buffer-size (buffer-size))
current-word replacement-word)
(goto-char (point-min))
(while (re-search-forward regexp nil 'noerror)
(setq current-word (s-downcase (match-string 0)))
(save-match-data ; `ap/get-random-word-of-same-length' changes match data
(unless (setq replacement-word (ht-get replacements current-word))
;; Find unique replacement word and add to hash-tables.
;; We use a second ht to store words that we've already
;; used, because looking them up as keys is much faster
;; than getting all the values in the replacements table.
(while (ht-get used-words
(setq replacement-word (ap/get-random-word-of-same-length current-word used-words)))
(unless replacement-word
;; No word found; make random string (which may not be
;; unique, but we can't really guarantee uniqueness in the
;; case of very short words unless we go into non-word
;; characters, Unicode, etc)
(setq replacement-word (ap/get-random-string (length current-word))))
;; TODO: Filter profanity?
;; Add to hash-tables
(ht-set replacements current-word replacement-word)
(ht-set used-words replacement-word t)))
;; Replace match
(replace-match replacement-word nil 'literal)
;; Allow Emacs to be interrupted gracefully. Also potentially
;; displays progress if you have the buffer visible, but I can't get
;; recentering to work.
(sit-for 0)
;; Display progress (this takes a while on large buffers)
(message "%s/%s" (point) buffer-size)
;; No idea why this doesn't work. I have to save and restore
;; point manually or it doesn't move past the matches and runs
;; in an infinite loop, but then recenter does nothing at all
;; (when window
;; (setq save-point (point))
;; (with-selected-window window
;; (recenter t))
;; (goto-char save-point))
(funcall orig-mode))))
(cl-defmacro ap/with-random-word-cache (&rest body)
(declare (indent defun)
(debug (&rest form)))
(let ((result (cl-gensym)))
(unless (and (boundp 'ap/random-word-buffer)
(buffer-live-p ap/random-word-buffer))
(with-current-buffer (setq ap/random-word-buffer (get-buffer-create " *RANDOM WORDS*"))
(call-process-shell-command "cat /usr/share/dict/words | shuf" nil t))
(setq ap/random-word-buffer-point 1))
(with-current-buffer ap/random-word-buffer
(let (,result)
(goto-char ap/random-word-buffer-point)
(setq ,result (progn ,@body))
;; This point-saving and restoring should NOT be necessary, I have no idea why this is.
(setq ap/random-word-buffer-point (point))
(defun ap/get-random-word-of-same-length (word &optional exclude-ht)
(let* ((length (length word))
(regexp (rx-to-string `(seq bol (repeat ,length word) eow))))
;; Search from last point, wrap once
(when (= (point) (point-max))
(goto-char (point-min)))
(cl-loop with starting-point = (point)
with match
with wrapped
until (or match
(and wrapped
(>= (point) starting-point)))
do (progn
(when (= (point) (point-max))
(goto-char (point-min))
(setq wrapped t))
(when (re-search-forward regexp nil 'goto-end)
(setq match (match-string 0))
(unless (and (not (string= match word))
(or (not exclude-ht)
(not (ht-get exclude-ht match))))
;; Invalid match, clear var
(setq match nil))))
finally return match))))
(defun ap/get-random-string (length)
"Return random string of LENGTH."
(unless (and (bound-and-true-p ap/random-chars)
(bound-and-true-p ap/random-chars-length))
(setq ap/random-chars (split-string "abcdefghijklmnopqrstuvwxyz" "" t))
(setq ap/random-chars-length (length ap/random-chars)))
(let* (s)
(while (< (length s) length)
(setq s (concat s (nth (random ap/random-chars-length) ap/random-chars))))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment