]> code.delx.au - gnu-emacs/blobdiff - lisp/play/decipher.el
Revision: miles@gnu.org--gnu-2005/emacs--unicode--0--patch-57
[gnu-emacs] / lisp / play / decipher.el
index fc78e83a966ddca5ed56a6817fd77dcaab0bc5b8..9ef8d0fd01f949caf35805778a8e31c2157fb9ae 100644 (file)
@@ -1,8 +1,8 @@
-;;; decipher.el --- Cryptanalyze monoalphabetic substitution ciphers
+;;; decipher.el --- cryptanalyze monoalphabetic substitution ciphers
 ;;
-;; Copyright (C) 1995, 1996 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1996, 2003, 2005 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.
 
+;;; Commentary:
+;;
 ;;; Quick Start:
 ;;
 ;; To decipher a message, type or load it into a buffer and type
@@ -36,8 +39,6 @@
 ;;   Helen Fouche Gaines
 ;;   ISBN 0-486-20097-3
 
-;;; Commentary:
-;;
 ;; This package is designed to help you crack simple substitution
 ;; ciphers where one letter stands for another.  It works for ciphers
 ;; with or without word divisions.  (You must set the variable
 ;;
 ;; 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:
 ;;
 (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]'.")
+nil means the case of the ciphertext is preserved.
+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.")
+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."
+  :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)
@@ -121,10 +170,8 @@ the tail of the list.")
       (define-key decipher-mode-map "R" 'decipher-restore-checkpoint)
       (define-key decipher-mode-map "U" 'decipher-undo)
       (define-key decipher-mode-map " " 'decipher-keypress)
-      (substitute-key-definition 'undo  'decipher-undo
-                                 decipher-mode-map global-map)
-      (substitute-key-definition 'advertised-undo  'decipher-undo
-                                 decipher-mode-map global-map)
+      (define-key decipher-mode-map [remap undo] 'decipher-undo)
+      (define-key decipher-mode-map [remap advertised-undo] 'decipher-undo)
       (let ((key ?a))
         (while (<= key ?z)
           (define-key decipher-mode-map (vector key) 'decipher-keypress)
@@ -258,14 +305,16 @@ The most useful commands are:
       (setq case-fold-search nil))      ;Case is significant when searching
   (use-local-map decipher-mode-map)
   (set-syntax-table decipher-mode-syntax-table)
-  (decipher-read-alphabet)
+  (unless (= (point-min) (point-max))
+    (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
             (lambda () (setq buffer-read-only nil
                              buffer-undo-list nil))
             nil t)
-  (run-hooks 'decipher-mode-hook)
+  (run-mode-hooks 'decipher-mode-hook)
   (setq buffer-read-only t))
 (put 'decipher-mode 'mode-class 'special)
 
@@ -374,13 +423,17 @@ The most useful commands are:
               (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))
@@ -432,10 +485,12 @@ The most useful commands are:
       (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
@@ -449,7 +504,7 @@ The most useful commands are:
       (move-to-column col t)
       (or (eolp)
           (delete-char 1))
-      (insert char))))
+      (insert-and-inherit char))))
 
 ;;--------------------------------------------------------------------
 ;; Checkpoints:
@@ -565,9 +620,9 @@ You should use this if you edit the ciphertext."
       (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))
@@ -630,7 +685,7 @@ ciphertext."
       (set-buffer (decipher-stats-buffer))
       (goto-char (point-min))
       (or (re-search-forward (format "^%c: " cipher-char) nil t)
-          (error "Character `%c' is not used in ciphertext." cipher-char))
+          (error "Character `%c' is not used in ciphertext" cipher-char))
       (forward-line -1)
       (setq start (point))
       (forward-line 3)
@@ -943,7 +998,7 @@ Creates the statistics buffer if it doesn't exist."
         major-mode       'decipher-stats-mode
         mode-name        "Decipher-Stats")
   (use-local-map decipher-stats-mode-map)
-  (run-hooks 'decipher-stats-mode-hook))
+  (run-mode-hooks 'decipher-stats-mode-hook))
 (put 'decipher-stats-mode 'mode-class 'special)
 
 ;;--------------------------------------------------------------------
@@ -1014,4 +1069,5 @@ if it can't, it signals an error."
 ;;;          (delete-backward-char 1)
 ;;;          (insert ")\n"))))))
 
+;;; arch-tag: 8f094d88-ffe1-4f99-afe3-a5e81dd939d9
 ;;; decipher.el ends here