;;
;; Copyright (C) 1995, 1996 Free Software Foundation, Inc.
;;
-;; Author: Christopher J. Madsen <ac608@yfn.ysu.edu>
+;; Author: Christopher J. Madsen <chris_madsen@geocities.com>
;; Keywords: games
;;
;; This file is part of GNU Emacs.
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to
-;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
;;; Quick Start:
;;
;;
;; The buffer is made read-only so it can't be modified by normal
;; Emacs commands.
+;;
+;; Decipher supports Font Lock mode. To use it, you can also add
+;; (add-hook 'decipher-mode-hook 'turn-on-font-lock)
+;; See the variable `decipher-font-lock-keywords' if you want to customize
+;; the faces used. I'd like to thank Simon Marshall for his help in making
+;; Decipher work well with Font Lock.
;;; Things To Do:
;;
-;; 1. More functions for analyzing ciphertext
+;; Email me if you have any suggestions or would like to help.
+;; But be aware that I work on Decipher only sporadically.
+;;
+;; 1. The consonant-line shortcut
+;; 2. More functions for analyzing ciphertext
;;;===================================================================
;;; Variables:
(eval-when-compile
(require 'cl))
-(defvar decipher-force-uppercase t
+(defgroup decipher nil
+ "Cryptanalyze monoalphabetic substitution ciphers."
+ :prefix "decipher-"
+ :group 'games)
+
+(defcustom decipher-force-uppercase t
"*Non-nil means to convert ciphertext to uppercase.
Nil means the case of the ciphertext is preserved.
-This variable must be set before typing `\\[decipher]'.")
+This variable must be set before typing `\\[decipher]'."
+ :type 'boolean
+ :group 'decipher)
-(defvar decipher-ignore-spaces nil
+
+(defcustom decipher-ignore-spaces nil
"*Non-nil means to ignore spaces and punctuation when counting digrams.
You should set this to `nil' if the cipher message is divided into words,
or `t' if it is not.
-This variable is buffer-local.")
+This variable is buffer-local."
+ :type 'boolean
+ :group 'decipher)
(make-variable-buffer-local 'decipher-ignore-spaces)
-(defvar decipher-undo-limit 5000
+(defcustom decipher-undo-limit 5000
"The maximum number of entries in the undo list.
When the undo list exceeds this number, 100 entries are deleted from
-the tail of the list.")
+the tail of the list."
+ :type 'integer
+ :group 'decipher)
+
+(defcustom decipher-mode-hook nil
+ "Hook to run upon entry to decipher."
+ :type 'hook
+ :group 'decipher)
;; End of user modifiable variables
;;--------------------------------------------------------------------
+(defvar decipher-font-lock-keywords
+ '(("^:.*" . font-lock-keyword-face)
+ ("^>.*" . font-lock-string-face)
+ ("^%!.*" . font-lock-constant-face)
+ ("^%.*" . font-lock-comment-face)
+ ("\\`(\\([a-z]+\\) +\\([A-Z]+\\)"
+ (1 font-lock-string-face)
+ (2 font-lock-keyword-face))
+ ("^)\\([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.")
+
(defvar decipher-mode-map nil
"Keymap for Decipher mode.")
(if (not decipher-mode-map)
(defvar decipher-pending-undo-list nil)
+;; The following variables are used by the analysis functions
+;; and are defined here to avoid byte-compiler warnings.
+;; Don't mess with them unless you know what you're doing.
+(defvar decipher-char nil
+ "See the functions decipher-loop-with-breaks and decipher-loop-no-breaks.")
+(defvar decipher--prev-char)
+(defvar decipher--digram)
+(defvar decipher--digram-list)
+(defvar decipher--before)
+(defvar decipher--after)
+(defvar decipher--freqs)
+
;;;===================================================================
;;; Code:
;;;===================================================================
(use-local-map decipher-mode-map)
(set-syntax-table decipher-mode-syntax-table)
(decipher-read-alphabet)
+ (set (make-local-variable 'font-lock-defaults)
+ '(decipher-font-lock-keywords t))
;; Make the buffer writable when we exit Decipher mode:
(make-local-hook 'change-major-mode-hook)
(add-hook 'change-major-mode-hook
(setcdr (nthcdr (1- new-size) decipher-undo-list) nil)
(setq decipher-undo-list-size new-size))))))
+(defun decipher-copy-cons (cons)
+ (if cons
+ (cons (car cons) (cdr cons))))
+
(defun decipher-get-undo (cipher-char plain-char)
;; Return an undo record that will undo the result of
;; (decipher-set-map CIPHER-CHAR PLAIN-CHAR)
- ;; We must use copy-list because the original cons cells will be
+ ;; We must copy the cons cell because the original cons cells will be
;; modified using setcdr.
- (let ((cipher-map (copy-list (rassoc cipher-char decipher-alphabet)))
- (plain-map (copy-list (assoc plain-char decipher-alphabet))))
+ (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)
cipher-map)
((equal cipher-char (cdr plain-map))
(decipher-insert plain-char)
(setq case-fold-search t ;Case is not significant
cipher-string (downcase cipher-string))
- (while (search-forward-regexp "^:" nil t)
- (setq bound (save-excursion (end-of-line) (point)))
- (while (search-forward cipher-string bound 'end)
- (decipher-insert plain-char))))))
+ (let ((font-lock-fontify-region-function 'ignore))
+ ;; insert-and-inherit will pick the right face automatically
+ (while (search-forward-regexp "^:" nil t)
+ (setq bound (save-excursion (end-of-line) (point)))
+ (while (search-forward cipher-string bound 'end)
+ (decipher-insert plain-char)))))))
(defun decipher-insert (char)
;; Insert CHAR in the row below point. It replaces any existing
(move-to-column col t)
(or (eolp)
(delete-char 1))
- (insert char))))
+ (insert-and-inherit char))))
;;--------------------------------------------------------------------
;; Checkpoints:
(decipher-read-alphabet)
(setq alphabet decipher-alphabet)
(goto-char (point-min))
- (and (re-search-forward "^).+$" nil t)
+ (and (re-search-forward "^).+" nil t)
(replace-match ")" nil nil))
- (while (re-search-forward "^>.+$" nil t)
+ (while (re-search-forward "^>.+" nil t)
(replace-match ">" nil nil))
(decipher-read-alphabet)
(while (setq mapping (pop alphabet))
;; Perform frequency analysis on ciphertext.
;;
;; This function is called repeatedly with decipher-char set to each
- ;; character of ciphertext. It uses decipher-prev-char to remember
+ ;; character of ciphertext. It uses decipher--prev-char to remember
;; the previous ciphertext character.
;;
;; It builds several data structures, which must be initialized
;; before the first call to decipher--analyze. The arrays are
;; indexed with A = 0, B = 1, ..., Z = 25, SPC = 26 (if used).
- ;; after-array: (initialize to zeros)
+ ;; decipher--after: (initialize to zeros)
;; A vector of 26 vectors of 27 integers. The first vector
;; represents the number of times A follows each character, the
;; second vector represents B, and so on.
- ;; before-array: (initialize to zeros)
- ;; The same as after-array, but representing the number of times
- ;; the character precedes each other character.
- ;; digram-list: (initialize to nil)
+ ;; decipher--before: (initialize to zeros)
+ ;; The same as decipher--after, but representing the number of
+ ;; times the character precedes each other character.
+ ;; decipher--digram-list: (initialize to nil)
;; An alist with an entry for each digram (2-character sequence)
;; encountered. Each element is a cons cell (DIGRAM . FREQ),
;; where DIGRAM is a 2 character string and FREQ is the number
;; of times it occurs.
- ;; freq-array: (initialize to zeros)
+ ;; decipher--freqs: (initialize to zeros)
;; A vector of 26 integers, counting the number of occurrences
;; of the corresponding characters.
- (setq digram (format "%c%c" decipher-prev-char decipher-char))
- (incf (cdr (or (assoc digram digram-list)
- (car (push (cons digram 0) digram-list)))))
- (and (>= decipher-prev-char ?A)
- (incf (aref (aref before-array (- decipher-prev-char ?A))
+ (setq decipher--digram (format "%c%c" decipher--prev-char decipher-char))
+ (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 ?\ )
26
(- decipher-char ?A)))))
(and (>= decipher-char ?A)
- (incf (aref freq-array (- decipher-char ?A)))
- (incf (aref (aref after-array (- decipher-char ?A))
- (if (equal decipher-prev-char ?\ )
+ (incf (aref decipher--freqs (- decipher-char ?A)))
+ (incf (aref (aref decipher--after (- decipher-char ?A))
+ (if (equal decipher--prev-char ?\ )
26
- (- decipher-prev-char ?A)))))
- (setq decipher-prev-char decipher-char))
+ (- decipher--prev-char ?A)))))
+ (setq decipher--prev-char decipher-char))
(defun decipher--digram-counts (counts)
"Generate the counts for an adjacency list."
(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 ?\ ?\*))
- (before-array (make-vector 26 nil))
- (after-array (make-vector 26 nil))
- (freq-array (make-vector 26 0))
+ (let ((decipher--prev-char (if decipher-ignore-spaces ?\ ?\*))
+ (decipher--before (make-vector 26 nil))
+ (decipher--after (make-vector 26 nil))
+ (decipher--freqs (make-vector 26 0))
(total-chars 0)
- digram digram-list freq-list)
+ decipher--digram decipher--digram-list freq-list)
(message "Scanning buffer...")
(let ((i 26))
(while (>= (decf i) 0)
- (aset before-array i (make-vector 27 0))
- (aset after-array i (make-vector 27 0))))
+ (aset decipher--before i (make-vector 27 0))
+ (aset decipher--after i (make-vector 27 0))))
(if decipher-ignore-spaces
(progn
(decipher-loop-no-breaks 'decipher--analyze)
;; The first character of ciphertext was marked as following a space:
(let ((i 26))
(while (>= (decf i) 0)
- (aset (aref after-array i) 26 0))))
+ (aset (aref decipher--after i) 26 0))))
(decipher-loop-with-breaks 'decipher--analyze))
(message "Processing results...")
- (setcdr (last digram-list 2) nil) ;Delete the phony "* " digram
+ (setcdr (last decipher--digram-list 2) nil) ;Delete the phony "* " digram
;; Sort the digram list by frequency and alphabetical order:
- (setq digram-list (sort (sort digram-list
+ (setq decipher--digram-list (sort (sort decipher--digram-list
(lambda (a b) (string< (car a) (car b))))
(lambda (a b) (> (cdr a) (cdr b)))))
;; Generate the frequency list:
(while (>= (decf i) 0)
(setq freq-list
(cons (list (+ i ?A)
- (aref freq-array i)
- (decipher--digram-total (aref before-array i)
- (aref after-array i)))
+ (aref decipher--freqs i)
+ (decipher--digram-total (aref decipher--before i)
+ (aref decipher--after i)))
freq-list)
- total-chars (+ total-chars (aref freq-array i)))))
+ total-chars (+ total-chars (aref decipher--freqs i)))))
(save-excursion
;; Switch to statistics buffer, creating it if necessary:
(set-buffer (decipher-stats-buffer t))
freq-list nil)
"\n\n")
;; Display list of digrams in order of frequency:
- (let* ((rows (floor (+ (length digram-list) 9) 10))
+ (let* ((rows (floor (+ (length decipher--digram-list) 9) 10))
(i rows)
temp-list)
(while (> i 0)
- (setq temp-list digram-list)
+ (setq temp-list decipher--digram-list)
(while temp-list
(insert (caar temp-list)
(format "%3d "
(setq temp-list (nthcdr rows temp-list)))
(delete-horizontal-space)
(insert ?\n)
- (setq digram-list (cdr digram-list)
+ (setq decipher--digram-list (cdr decipher--digram-list)
i (1- i))))
;; Display adjacency list for each letter, sorted in descending
;; order of the number of adjacent letters:
nil ;This letter was not used
(setq i (- (car entry) ?A))
(insert ?\n " "
- (decipher--digram-counts (aref before-array i)) ?\n
+ (decipher--digram-counts (aref decipher--before i)) ?\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))
- (decipher--digram-counts (aref after-array i)) ?\n))))
+ (decipher--digram-counts (aref decipher--after i)) ?\n))))
(setq buffer-read-only t)
(set-buffer-modified-p nil)
))