;;; decipher.el --- cryptanalyze monoalphabetic substitution ciphers
;;
-;; Copyright (C) 1995-1996, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1995-1996, 2001-2015 Free Software Foundation, Inc.
;;
;; Author: Christopher J. Madsen <chris_madsen@geocities.com>
;; Keywords: games
;;; Variables:
;;;===================================================================
-(eval-when-compile
- (require 'cl))
+(eval-when-compile (require 'cl-lib))
(defgroup decipher nil
"Cryptanalyze monoalphabetic substitution ciphers."
("^)\\([A-Z ]+\\)\\([a-z ]+\\)"
(1 font-lock-keyword-face)
(2 font-lock-string-face)))
- "Expressions to fontify in Decipher mode.
-
-Ciphertext uses `font-lock-keyword-face', plaintext uses
-`font-lock-string-face', comments use `font-lock-comment-face', and
-checkpoints use `font-lock-constant-face'. You can customize the
-display by changing these variables. For best results, I recommend
-that all faces use the same background color.
-
-For example, to display ciphertext in the `bold' face, use
- (add-hook 'decipher-mode-hook
- (lambda () (set (make-local-variable 'font-lock-keyword-face)
- 'bold)))
-in your `.emacs' file.")
+ "Font Lock keywords for Decipher mode.")
(defvar decipher-mode-map
(let ((map (make-keymap)))
(let ((key ?a))
(while (<= key ?z)
(define-key map (vector key) 'decipher-keypress)
- (incf key)))
+ (cl-incf key)))
map)
"Keymap for Decipher mode.")
(c ?0))
(while (<= c ?9)
(modify-syntax-entry c "_" table) ;Digits are not part of words
- (incf c))
+ (cl-incf c))
(setq decipher-mode-syntax-table table)))
(defvar decipher-alphabet nil)
(let ((char-a (following-char))
(char-b (decipher-last-command-char)))
(or (and (not (= ?w (char-syntax char-a)))
- (= char-b ?\ )) ;Spacebar just advances on non-letters
+ (= char-b ?\s)) ;Spacebar just advances on non-letters
(funcall decipher-function char-a char-b)))))
(forward-char))
(decipher-set-map a b))
((and (>= a ?a) (<= a ?z))
;; If A is lowercase, then it is in the plaintext alphabet:
- (if (= b ?\ )
+ (if (= b ?\s)
;; We are clearing the association (if any):
- (if (/= ?\ (setq b (cdr (assoc a decipher-alphabet))))
- (decipher-set-map b ?\ ))
+ (if (/= ?\s (setq b (cdr (assoc a decipher-alphabet))))
+ (decipher-set-map b ?\s))
;; Associate the plaintext char with the char pressed:
(decipher-set-map b a)))
(t
(if undo-rec
(progn
(push undo-rec decipher-undo-list)
- (incf decipher-undo-list-size)
+ (cl-incf decipher-undo-list-size)
(if (> decipher-undo-list-size decipher-undo-limit)
(let ((new-size (- decipher-undo-limit 100)))
;; Truncate undo list to NEW-SIZE elements:
;; modified using setcdr.
(let ((cipher-map (decipher-copy-cons (rassoc cipher-char decipher-alphabet)))
(plain-map (decipher-copy-cons (assoc plain-char decipher-alphabet))))
- (cond ((equal ?\ plain-char)
+ (cond ((equal ?\s plain-char)
cipher-map)
((equal cipher-char (cdr plain-map))
nil) ;We aren't changing anything
- ((equal ?\ (cdr plain-map))
- (or cipher-map (cons ?\ cipher-char)))
+ ((equal ?\s (cdr plain-map))
+ (or cipher-map (cons ?\s cipher-char)))
(cipher-map
(list plain-map cipher-map))
(t
(goto-char (point-min))
(if (setq mapping (rassoc cipher-char decipher-alphabet))
(progn
- (setcdr mapping ?\ )
+ (setcdr mapping ?\s)
(search-forward-regexp (concat "^([a-z]*"
(char-to-string (car mapping))))
- (decipher-insert ?\ )
+ (decipher-insert ?\s)
(beginning-of-line)))
(if (setq mapping (assoc plain-char decipher-alphabet))
(progn
- (if (/= ?\ (cdr mapping))
- (decipher-set-map (cdr mapping) ?\ t))
+ (if (/= ?\s (cdr mapping))
+ (decipher-set-map (cdr mapping) ?\s t))
(setcdr mapping cipher-char)
(search-forward-regexp (concat "^([a-z]*" plain-string))
(decipher-insert cipher-char)
(or (stringp desc)
(setq desc ""))
(let (alphabet
- buffer-read-only ;Make buffer writable
- mapping)
+ buffer-read-only) ;Make buffer writable
(goto-char (point-min))
(re-search-forward "^)")
(move-to-column 27 t)
buffer-read-only ;Make buffer writable
plain-map undo-rec)
(while (setq plain-map (pop ptr))
- (if (equal ?\ (cdr plain-map))
+ (if (equal ?\s (cdr plain-map))
(progn
(while (rassoc cipher-char decipher-alphabet)
;; Find the next unused letter
- (incf cipher-char))
- (push (cons ?\ cipher-char) undo-rec)
+ (cl-incf cipher-char))
+ (push (cons ?\s cipher-char) undo-rec)
(decipher-set-map cipher-char (car plain-map) t))))
(decipher-add-undo undo-rec)))
(replace-match ">" nil nil))
(decipher-read-alphabet)
(while (setq mapping (pop alphabet))
- (or (equal ?\ (cdr mapping))
+ (or (equal ?\s (cdr mapping))
(decipher-set-map (cdr mapping) (car mapping))))))
(setq decipher-undo-list nil
decipher-undo-list-size 0)
(while (>= plain-char ?a)
(backward-char)
(push (cons plain-char (following-char)) decipher-alphabet)
- (decf plain-char)))))
+ (cl-decf plain-char)))))
;;;===================================================================
;;; Analyzing ciphertext:
1 1 1 2 1 1 2 5 7
This says that X comes before D once, and after B once. X begins 5
words, and ends 3 words (`*' represents a space). X comes before 8
-different letters, after 7 differerent letters, and is next to a total
+different letters, after 7 different letters, and is next to a total
of 11 different letters. It occurs 14 times, making up 9% of the
ciphertext."
(interactive (list (upcase (following-char))))
a space.
See `decipher-loop-no-breaks' if you do not care about word divisions."
- (let ((decipher-char ?\ )
- (decipher--loop-prev-char ?\ ))
+ (let ((decipher-char ?\s)
+ (decipher--loop-prev-char ?\s))
(save-excursion
(goto-char (point-min))
(funcall func) ;Space marks beginning of first word
(while (not (eolp))
(setq decipher-char (upcase (following-char)))
(or (and (>= decipher-char ?A) (<= decipher-char ?Z))
- (setq decipher-char ?\ ))
- (or (and (equal decipher-char ?\ )
- (equal decipher--loop-prev-char ?\ ))
+ (setq decipher-char ?\s))
+ (or (and (equal decipher-char ?\s)
+ (equal decipher--loop-prev-char ?\s))
(funcall func))
(setq decipher--loop-prev-char decipher-char)
(forward-char))
- (or (equal decipher-char ?\ )
+ (or (equal decipher-char ?\s)
(progn
(setq decipher-char ?\s
- decipher--loop-prev-char ?\ )
+ decipher--loop-prev-char ?\s)
(funcall func)))))))
(defun decipher-loop-no-breaks (func)
(while temp-list
(insert (caar temp-list)
(format "%4d%3d%% "
- (cadar temp-list)
- (/ (* 100 (cadar temp-list)) total)))
+ (cl-cadar temp-list)
+ (/ (* 100 (cl-cadar temp-list)) total)))
(setq temp-list (nthcdr 4 temp-list)))
(insert ?\n)
(setq freq-list (cdr freq-list)
;; A vector of 26 integers, counting the number of occurrences
;; of the corresponding characters.
(setq decipher--digram (format "%c%c" decipher--prev-char decipher-char))
- (incf (cdr (or (assoc decipher--digram decipher--digram-list)
+ (cl-incf (cdr (or (assoc decipher--digram decipher--digram-list)
(car (push (cons decipher--digram 0)
decipher--digram-list)))))
(and (>= decipher--prev-char ?A)
- (incf (aref (aref decipher--before (- decipher--prev-char ?A))
- (if (equal decipher-char ?\ )
+ (cl-incf (aref (aref decipher--before (- decipher--prev-char ?A))
+ (if (equal decipher-char ?\s)
26
(- decipher-char ?A)))))
(and (>= decipher-char ?A)
- (incf (aref decipher--freqs (- decipher-char ?A)))
- (incf (aref (aref decipher--after (- decipher-char ?A))
- (if (equal decipher--prev-char ?\ )
+ (cl-incf (aref decipher--freqs (- decipher-char ?A)))
+ (cl-incf (aref (aref decipher--after (- decipher-char ?A))
+ (if (equal decipher--prev-char ?\s)
26
(- decipher--prev-char ?A)))))
(setq decipher--prev-char decipher-char))
(let ((total 0))
(concat
(mapconcat (lambda (x)
- (cond ((> x 99) (incf total) "XX")
- ((> x 0) (incf total) (format "%2d" x))
+ (cond ((> x 99) (cl-incf total) "XX")
+ ((> x 0) (cl-incf total) (format "%2d" x))
(t " ")))
counts
"")
;; We do not include spaces (word divisions) in this count.
(let ((total 0)
(i 26))
- (while (>= (decf i) 0)
+ (while (>= (cl-decf i) 0)
(if (or (> (aref before-count i) 0)
(> (aref after-count i) 0))
- (incf total)))
+ (cl-incf total)))
total))
(defun decipher-analyze-buffer ()
"Perform frequency analysis and store results in statistics buffer.
Creates the statistics buffer if it doesn't exist."
- (let ((decipher--prev-char (if decipher-ignore-spaces ?\ ?\*))
+ (let ((decipher--prev-char (if decipher-ignore-spaces ?\s ?\*))
(decipher--before (make-vector 26 nil))
(decipher--after (make-vector 26 nil))
(decipher--freqs (make-vector 26 0))
decipher--digram decipher--digram-list freq-list)
(message "Scanning buffer...")
(let ((i 26))
- (while (>= (decf i) 0)
+ (while (>= (cl-decf i) 0)
(aset decipher--before i (make-vector 27 0))
(aset decipher--after i (make-vector 27 0))))
(if decipher-ignore-spaces
(decipher-loop-no-breaks 'decipher--analyze)
;; The first character of ciphertext was marked as following a space:
(let ((i 26))
- (while (>= (decf i) 0)
+ (while (>= (cl-decf i) 0)
(aset (aref decipher--after i) 26 0))))
(decipher-loop-with-breaks 'decipher--analyze))
(message "Processing results...")
;; of times it occurs, and DIFFERENT is the number of different
;; letters it appears next to.
(let ((i 26))
- (while (>= (decf i) 0)
+ (while (>= (cl-decf i) 0)
(setq freq-list
(cons (list (+ i ?A)
(aref decipher--freqs i)
(insert ?\n)
;; Display frequency counts for letters in order of frequency:
(setq freq-list (sort freq-list
- (lambda (a b) (> (second a) (second b)))))
+ (lambda (a b) (> (cl-second a) (cl-second b)))))
(decipher-insert-frequency-counts freq-list total-chars)
;; Display letters in order of frequency:
(insert ?\n (mapconcat (lambda (a) (char-to-string (car a)))
;; Display adjacency list for each letter, sorted in descending
;; order of the number of adjacent letters:
(setq freq-list (sort freq-list
- (lambda (a b) (> (third a) (third b)))))
+ (lambda (a b) (> (cl-third a) (cl-third b)))))
(let ((temp-list freq-list)
entry i)
(while (setq entry (pop temp-list))
- (if (equal 0 (second entry))
+ (if (equal 0 (cl-second entry))
nil ;This letter was not used
(setq i (- (car entry) ?A))
(insert ?\n " "
(car entry)
": A B C D E F G H I J K L M N O P Q R S T U V W X Y Z *"
(format "%4d %4d %3d%%\n "
- (third entry) (second entry)
- (/ (* 100 (second entry)) total-chars))
+ (cl-third entry) (cl-second entry)
+ (/ (* 100 (cl-second entry)) total-chars))
(decipher--digram-counts (aref decipher--after i)) ?\n))))
(setq buffer-read-only t)
(set-buffer-modified-p nil)
;; (setq undo-rec (list undo-rec)))
;; (insert ?\()
;; (while (setq undo-map (pop undo-rec))
-;; (insert (cdr undo-map) (car undo-map) ?\ ))
+;; (insert (cdr undo-map) (car undo-map) ?\s))
;; (delete-char -1)
;; (insert ")\n"))))))