annotate lisp/play/decipher.el @ 16713:490b479ce48a

(perform-replace): Delete the code that checked whether the regexp could match again right after this match. It made the loop too slow.
author Richard M. Stallman <rms@gnu.org>
date Wed, 18 Dec 1996 02:22:34 +0000
parents 33e652659075
children ed909ffc3c46
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
14523
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1 ;;; decipher.el --- Cryptanalyze monoalphabetic substitution ciphers
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2 ;;
14545
bd43252760b4 Load cl only when compiling.
Richard M. Stallman <rms@gnu.org>
parents: 14523
diff changeset
3 ;; Copyright (C) 1995, 1996 Free Software Foundation, Inc.
14523
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
4 ;;
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
5 ;; Author: Christopher J. Madsen <ac608@yfn.ysu.edu>
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
6 ;; Keywords: games
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
7 ;;
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
8 ;; This file is part of GNU Emacs.
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
9 ;;
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
10 ;; GNU Emacs is free software; you can redistribute it and/or modify
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
11 ;; it under the terms of the GNU General Public License as published by
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
12 ;; the Free Software Foundation; either version 2, or (at your option)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
13 ;; any later version.
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
14 ;;
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
15 ;; GNU Emacs is distributed in the hope that it will be useful,
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
18 ;; GNU General Public License for more details.
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
19 ;;
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
20 ;; You should have received a copy of the GNU General Public License
15742
80562f089595 Fix FSF address in comment.
Karl Heuer <kwzh@gnu.org>
parents: 14653
diff changeset
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the
80562f089595 Fix FSF address in comment.
Karl Heuer <kwzh@gnu.org>
parents: 14653
diff changeset
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
80562f089595 Fix FSF address in comment.
Karl Heuer <kwzh@gnu.org>
parents: 14653
diff changeset
23 ;; Boston, MA 02111-1307, USA.
14523
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
24
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
25 ;;; Quick Start:
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
26 ;;
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
27 ;; To decipher a message, type or load it into a buffer and type
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
28 ;; `M-x decipher'. This will format the buffer and place it into
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
29 ;; Decipher mode. You can save your work to a file with the normal
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
30 ;; Emacs save commands; when you reload the file it will automatically
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
31 ;; enter Decipher mode.
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
32 ;;
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
33 ;; I'm not going to discuss how to go about breaking a cipher; try
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
34 ;; your local library for a book on cryptanalysis. One book you might
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
35 ;; find is:
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
36 ;; Cryptanalysis: A study of ciphers and their solution
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
37 ;; Helen Fouche Gaines
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
38 ;; ISBN 0-486-20097-3
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
39
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
40 ;;; Commentary:
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
41 ;;
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
42 ;; This package is designed to help you crack simple substitution
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
43 ;; ciphers where one letter stands for another. It works for ciphers
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
44 ;; with or without word divisions. (You must set the variable
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
45 ;; decipher-ignore-spaces for ciphers without word divisions.)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
46 ;;
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
47 ;; First, some quick definitions:
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
48 ;; ciphertext The encrypted message (what you start with)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
49 ;; plaintext The decrypted message (what you are trying to get)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
50 ;;
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
51 ;; Decipher mode displays ciphertext in uppercase and plaintext in
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
52 ;; lowercase. You must enter the plaintext in lowercase; uppercase
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
53 ;; letters are interpreted as commands. The ciphertext may be entered
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
54 ;; in mixed case; `M-x decipher' will convert it to uppercase.
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
55 ;;
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
56 ;; Decipher mode depends on special characters in the first column of
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
57 ;; each line. The command `M-x decipher' inserts these characters for
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
58 ;; you. The characters and their meanings are:
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
59 ;; ( The plaintext & ciphertext alphabets on the first line
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
60 ;; ) The ciphertext & plaintext alphabets on the second line
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
61 ;; : A line of ciphertext (with plaintext below)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
62 ;; > A line of plaintext (with ciphertext above)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
63 ;; % A comment
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
64 ;; Each line in the buffer MUST begin with one of these characters (or
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
65 ;; be left blank). In addition, comments beginning with `%!' are reserved
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
66 ;; for checkpoints; see decipher-make-checkpoint & decipher-restore-checkpoint
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
67 ;; for more information.
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
68 ;;
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
69 ;; While the cipher message may contain digits or punctuation, Decipher
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
70 ;; mode will ignore these characters.
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
71 ;;
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
72 ;; The buffer is made read-only so it can't be modified by normal
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
73 ;; Emacs commands.
14650
2e418434d5d5 (decipher-mode): Removed nonstandard font-lock support.
Richard M. Stallman <rms@gnu.org>
parents: 14596
diff changeset
74 ;;
2e418434d5d5 (decipher-mode): Removed nonstandard font-lock support.
Richard M. Stallman <rms@gnu.org>
parents: 14596
diff changeset
75 ;; Decipher supports Font Lock mode. To use it, you can also add
2e418434d5d5 (decipher-mode): Removed nonstandard font-lock support.
Richard M. Stallman <rms@gnu.org>
parents: 14596
diff changeset
76 ;; (add-hook 'decipher-mode-hook 'turn-on-font-lock)
2e418434d5d5 (decipher-mode): Removed nonstandard font-lock support.
Richard M. Stallman <rms@gnu.org>
parents: 14596
diff changeset
77 ;; See the variable `decipher-font-lock-keywords' if you want to customize
2e418434d5d5 (decipher-mode): Removed nonstandard font-lock support.
Richard M. Stallman <rms@gnu.org>
parents: 14596
diff changeset
78 ;; the faces used. I'd like to thank Simon Marshall for his help in making
2e418434d5d5 (decipher-mode): Removed nonstandard font-lock support.
Richard M. Stallman <rms@gnu.org>
parents: 14596
diff changeset
79 ;; Decipher work well with Font Lock.
14523
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
80
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
81 ;;; Things To Do:
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
82 ;;
14573
3ae037e10c04 Doc changes.
Karl Heuer <kwzh@gnu.org>
parents: 14545
diff changeset
83 ;; Email me if you have any suggestions or would like to help.
3ae037e10c04 Doc changes.
Karl Heuer <kwzh@gnu.org>
parents: 14545
diff changeset
84 ;; But be aware that I work on Decipher only sporadically.
3ae037e10c04 Doc changes.
Karl Heuer <kwzh@gnu.org>
parents: 14545
diff changeset
85 ;;
3ae037e10c04 Doc changes.
Karl Heuer <kwzh@gnu.org>
parents: 14545
diff changeset
86 ;; 1. The consonant-line shortcut
3ae037e10c04 Doc changes.
Karl Heuer <kwzh@gnu.org>
parents: 14545
diff changeset
87 ;; 2. More functions for analyzing ciphertext
14523
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
88
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
89 ;;;===================================================================
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
90 ;;; Variables:
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
91 ;;;===================================================================
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
92
14545
bd43252760b4 Load cl only when compiling.
Richard M. Stallman <rms@gnu.org>
parents: 14523
diff changeset
93 (eval-when-compile
bd43252760b4 Load cl only when compiling.
Richard M. Stallman <rms@gnu.org>
parents: 14523
diff changeset
94 (require 'cl))
14523
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
95
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
96 (defvar decipher-force-uppercase t
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
97 "*Non-nil means to convert ciphertext to uppercase.
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
98 Nil means the case of the ciphertext is preserved.
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
99 This variable must be set before typing `\\[decipher]'.")
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
100
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
101 (defvar decipher-ignore-spaces nil
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
102 "*Non-nil means to ignore spaces and punctuation when counting digrams.
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
103 You should set this to `nil' if the cipher message is divided into words,
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
104 or `t' if it is not.
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
105 This variable is buffer-local.")
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
106 (make-variable-buffer-local 'decipher-ignore-spaces)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
107
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
108 (defvar decipher-undo-limit 5000
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
109 "The maximum number of entries in the undo list.
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
110 When the undo list exceeds this number, 100 entries are deleted from
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
111 the tail of the list.")
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
112
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
113 ;; End of user modifiable variables
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
114 ;;--------------------------------------------------------------------
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
115
14596
afb84c1d7750 (decipher-mode, decipher-set-map, decipher-insert,
Karl Heuer <kwzh@gnu.org>
parents: 14573
diff changeset
116 (defvar decipher-font-lock-keywords
14650
2e418434d5d5 (decipher-mode): Removed nonstandard font-lock support.
Richard M. Stallman <rms@gnu.org>
parents: 14596
diff changeset
117 '(("^:.*" . font-lock-keyword-face)
2e418434d5d5 (decipher-mode): Removed nonstandard font-lock support.
Richard M. Stallman <rms@gnu.org>
parents: 14596
diff changeset
118 ("^>.*" . font-lock-string-face)
2e418434d5d5 (decipher-mode): Removed nonstandard font-lock support.
Richard M. Stallman <rms@gnu.org>
parents: 14596
diff changeset
119 ("^%!.*" . font-lock-reference-face)
2e418434d5d5 (decipher-mode): Removed nonstandard font-lock support.
Richard M. Stallman <rms@gnu.org>
parents: 14596
diff changeset
120 ("^%.*" . font-lock-comment-face)
2e418434d5d5 (decipher-mode): Removed nonstandard font-lock support.
Richard M. Stallman <rms@gnu.org>
parents: 14596
diff changeset
121 ("\\`(\\([a-z]+\\) +\\([A-Z]+\\)"
14596
afb84c1d7750 (decipher-mode, decipher-set-map, decipher-insert,
Karl Heuer <kwzh@gnu.org>
parents: 14573
diff changeset
122 (1 font-lock-string-face)
14650
2e418434d5d5 (decipher-mode): Removed nonstandard font-lock support.
Richard M. Stallman <rms@gnu.org>
parents: 14596
diff changeset
123 (2 font-lock-keyword-face))
2e418434d5d5 (decipher-mode): Removed nonstandard font-lock support.
Richard M. Stallman <rms@gnu.org>
parents: 14596
diff changeset
124 ("^)\\([A-Z ]+\\)\\([a-z ]+\\)"
2e418434d5d5 (decipher-mode): Removed nonstandard font-lock support.
Richard M. Stallman <rms@gnu.org>
parents: 14596
diff changeset
125 (1 font-lock-keyword-face)
2e418434d5d5 (decipher-mode): Removed nonstandard font-lock support.
Richard M. Stallman <rms@gnu.org>
parents: 14596
diff changeset
126 (2 font-lock-string-face)))
14596
afb84c1d7750 (decipher-mode, decipher-set-map, decipher-insert,
Karl Heuer <kwzh@gnu.org>
parents: 14573
diff changeset
127 "Expressions to fontify in Decipher mode.
15877
33e652659075 (decipher-get-undo-copy): New function.
Richard M. Stallman <rms@gnu.org>
parents: 15742
diff changeset
128
14653
79cf52c9ef93 Load cl within eval-when-compile.
Richard M. Stallman <rms@gnu.org>
parents: 14650
diff changeset
129 Ciphertext uses `font-lock-keyword-face', plaintext uses
14650
2e418434d5d5 (decipher-mode): Removed nonstandard font-lock support.
Richard M. Stallman <rms@gnu.org>
parents: 14596
diff changeset
130 `font-lock-string-face', comments use `font-lock-comment-face', and
2e418434d5d5 (decipher-mode): Removed nonstandard font-lock support.
Richard M. Stallman <rms@gnu.org>
parents: 14596
diff changeset
131 checkpoints use `font-lock-reference-face'. You can customize the
2e418434d5d5 (decipher-mode): Removed nonstandard font-lock support.
Richard M. Stallman <rms@gnu.org>
parents: 14596
diff changeset
132 display by changing these variables. For best results, I recommend
2e418434d5d5 (decipher-mode): Removed nonstandard font-lock support.
Richard M. Stallman <rms@gnu.org>
parents: 14596
diff changeset
133 that all faces use the same background color.
15877
33e652659075 (decipher-get-undo-copy): New function.
Richard M. Stallman <rms@gnu.org>
parents: 15742
diff changeset
134
14653
79cf52c9ef93 Load cl within eval-when-compile.
Richard M. Stallman <rms@gnu.org>
parents: 14650
diff changeset
135 For example, to display ciphertext in the `bold' face, use
14650
2e418434d5d5 (decipher-mode): Removed nonstandard font-lock support.
Richard M. Stallman <rms@gnu.org>
parents: 14596
diff changeset
136 (add-hook 'decipher-mode-hook
2e418434d5d5 (decipher-mode): Removed nonstandard font-lock support.
Richard M. Stallman <rms@gnu.org>
parents: 14596
diff changeset
137 (lambda () (set (make-local-variable 'font-lock-keyword-face)
2e418434d5d5 (decipher-mode): Removed nonstandard font-lock support.
Richard M. Stallman <rms@gnu.org>
parents: 14596
diff changeset
138 'bold)))
2e418434d5d5 (decipher-mode): Removed nonstandard font-lock support.
Richard M. Stallman <rms@gnu.org>
parents: 14596
diff changeset
139 in your `.emacs' file.")
2e418434d5d5 (decipher-mode): Removed nonstandard font-lock support.
Richard M. Stallman <rms@gnu.org>
parents: 14596
diff changeset
140
14523
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
141 (defvar decipher-mode-map nil
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
142 "Keymap for Decipher mode.")
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
143 (if (not decipher-mode-map)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
144 (progn
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
145 (setq decipher-mode-map (make-keymap))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
146 (suppress-keymap decipher-mode-map)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
147 (define-key decipher-mode-map "A" 'decipher-show-alphabet)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
148 (define-key decipher-mode-map "C" 'decipher-complete-alphabet)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
149 (define-key decipher-mode-map "D" 'decipher-digram-list)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
150 (define-key decipher-mode-map "F" 'decipher-frequency-count)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
151 (define-key decipher-mode-map "M" 'decipher-make-checkpoint)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
152 (define-key decipher-mode-map "N" 'decipher-adjacency-list)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
153 (define-key decipher-mode-map "R" 'decipher-restore-checkpoint)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
154 (define-key decipher-mode-map "U" 'decipher-undo)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
155 (define-key decipher-mode-map " " 'decipher-keypress)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
156 (substitute-key-definition 'undo 'decipher-undo
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
157 decipher-mode-map global-map)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
158 (substitute-key-definition 'advertised-undo 'decipher-undo
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
159 decipher-mode-map global-map)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
160 (let ((key ?a))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
161 (while (<= key ?z)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
162 (define-key decipher-mode-map (vector key) 'decipher-keypress)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
163 (incf key)))))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
164
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
165 (defvar decipher-stats-mode-map nil
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
166 "Keymap for Decipher-Stats mode.")
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
167 (if (not decipher-stats-mode-map)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
168 (progn
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
169 (setq decipher-stats-mode-map (make-keymap))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
170 (suppress-keymap decipher-stats-mode-map)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
171 (define-key decipher-stats-mode-map "D" 'decipher-digram-list)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
172 (define-key decipher-stats-mode-map "F" 'decipher-frequency-count)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
173 (define-key decipher-stats-mode-map "N" 'decipher-adjacency-list)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
174 ))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
175
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
176 (defvar decipher-mode-syntax-table nil
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
177 "Decipher mode syntax table")
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
178
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
179 (if decipher-mode-syntax-table
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
180 ()
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
181 (let ((table (make-syntax-table))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
182 (c ?0))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
183 (while (<= c ?9)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
184 (modify-syntax-entry c "_" table) ;Digits are not part of words
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
185 (incf c))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
186 (setq decipher-mode-syntax-table table)))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
187
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
188 (defvar decipher-alphabet nil)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
189 ;; This is an alist containing entries (PLAIN-CHAR . CIPHER-CHAR),
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
190 ;; where PLAIN-CHAR runs from ?a to ?z and CIPHER-CHAR is an uppercase
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
191 ;; letter or space (which means no mapping is known for that letter).
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
192 ;; This *must* contain entries for all lowercase characters.
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
193 (make-variable-buffer-local 'decipher-alphabet)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
194
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
195 (defvar decipher-stats-buffer nil
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
196 "The buffer which displays statistics for this ciphertext.
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
197 Do not access this variable directly, use the function
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
198 `decipher-stats-buffer' instead.")
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
199 (make-variable-buffer-local 'decipher-stats-buffer)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
200
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
201 (defvar decipher-undo-list-size 0
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
202 "The number of entries in the undo list.")
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
203 (make-variable-buffer-local 'decipher-undo-list-size)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
204
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
205 (defvar decipher-undo-list nil
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
206 "The undo list for this buffer.
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
207 Each element is either a cons cell (PLAIN-CHAR . CIPHER-CHAR) or a
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
208 list of such cons cells.")
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
209 (make-variable-buffer-local 'decipher-undo-list)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
210
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
211 (defvar decipher-pending-undo-list nil)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
212
14573
3ae037e10c04 Doc changes.
Karl Heuer <kwzh@gnu.org>
parents: 14545
diff changeset
213 ;; The following variables are used by the analysis functions
3ae037e10c04 Doc changes.
Karl Heuer <kwzh@gnu.org>
parents: 14545
diff changeset
214 ;; and are defined here to avoid byte-compiler warnings.
3ae037e10c04 Doc changes.
Karl Heuer <kwzh@gnu.org>
parents: 14545
diff changeset
215 ;; Don't mess with them unless you know what you're doing.
3ae037e10c04 Doc changes.
Karl Heuer <kwzh@gnu.org>
parents: 14545
diff changeset
216 (defvar decipher-char nil
3ae037e10c04 Doc changes.
Karl Heuer <kwzh@gnu.org>
parents: 14545
diff changeset
217 "See the functions decipher-loop-with-breaks and decipher-loop-no-breaks.")
3ae037e10c04 Doc changes.
Karl Heuer <kwzh@gnu.org>
parents: 14545
diff changeset
218 (defvar decipher--prev-char)
3ae037e10c04 Doc changes.
Karl Heuer <kwzh@gnu.org>
parents: 14545
diff changeset
219 (defvar decipher--digram)
3ae037e10c04 Doc changes.
Karl Heuer <kwzh@gnu.org>
parents: 14545
diff changeset
220 (defvar decipher--digram-list)
3ae037e10c04 Doc changes.
Karl Heuer <kwzh@gnu.org>
parents: 14545
diff changeset
221 (defvar decipher--before)
3ae037e10c04 Doc changes.
Karl Heuer <kwzh@gnu.org>
parents: 14545
diff changeset
222 (defvar decipher--after)
3ae037e10c04 Doc changes.
Karl Heuer <kwzh@gnu.org>
parents: 14545
diff changeset
223 (defvar decipher--freqs)
3ae037e10c04 Doc changes.
Karl Heuer <kwzh@gnu.org>
parents: 14545
diff changeset
224
14523
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
225 ;;;===================================================================
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
226 ;;; Code:
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
227 ;;;===================================================================
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
228 ;; Main entry points:
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
229 ;;--------------------------------------------------------------------
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
230
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
231 ;;;###autoload
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
232 (defun decipher ()
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
233 "Format a buffer of ciphertext for cryptanalysis and enter Decipher mode."
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
234 (interactive)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
235 ;; Make sure the buffer ends in a newline:
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
236 (goto-char (point-max))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
237 (or (bolp)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
238 (insert "\n"))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
239 ;; See if it's already in decipher format:
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
240 (goto-char (point-min))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
241 (if (looking-at "^(abcdefghijklmnopqrstuvwxyz \
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
242 ABCDEFGHIJKLMNOPQRSTUVWXYZ -\\*-decipher-\\*-\n)")
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
243 (message "Buffer is already formatted, entering Decipher mode...")
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
244 ;; Add the alphabet at the beginning of the file
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
245 (insert "(abcdefghijklmnopqrstuvwxyz \
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
246 ABCDEFGHIJKLMNOPQRSTUVWXYZ -*-decipher-*-\n)\n\n")
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
247 ;; Add lines for the solution:
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
248 (let (begin)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
249 (while (not (eobp))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
250 (if (looking-at "^%")
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
251 (forward-line) ;Leave comments alone
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
252 (delete-horizontal-space)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
253 (if (eolp)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
254 (forward-line) ;Just leave blank lines alone
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
255 (insert ":") ;Mark ciphertext line
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
256 (setq begin (point))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
257 (forward-line)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
258 (if decipher-force-uppercase
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
259 (upcase-region begin (point))) ;Convert ciphertext to uppercase
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
260 (insert ">\n"))))) ;Mark plaintext line
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
261 (delete-blank-lines) ;Remove any blank lines
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
262 (delete-blank-lines)) ; at end of buffer
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
263 (goto-line 4)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
264 (decipher-mode))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
265
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
266 ;;;###autoload
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
267 (defun decipher-mode ()
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
268 "Major mode for decrypting monoalphabetic substitution ciphers.
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
269 Lower-case letters enter plaintext.
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
270 Upper-case letters are commands.
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
271
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
272 The buffer is made read-only so that normal Emacs commands cannot
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
273 modify it.
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
274
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
275 The most useful commands are:
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
276 \\<decipher-mode-map>
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
277 \\[decipher-digram-list] Display a list of all digrams & their frequency
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
278 \\[decipher-frequency-count] Display the frequency of each ciphertext letter
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
279 \\[decipher-adjacency-list]\
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
280 Show adjacency list for current letter (lists letters appearing next to it)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
281 \\[decipher-make-checkpoint] Save the current cipher alphabet (checkpoint)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
282 \\[decipher-restore-checkpoint] Restore a saved cipher alphabet (checkpoint)"
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
283 (interactive)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
284 (kill-all-local-variables)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
285 (setq buffer-undo-list t ;Disable undo
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
286 indent-tabs-mode nil ;Do not use tab characters
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
287 major-mode 'decipher-mode
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
288 mode-name "Decipher")
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
289 (if decipher-force-uppercase
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
290 (setq case-fold-search nil)) ;Case is significant when searching
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
291 (use-local-map decipher-mode-map)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
292 (set-syntax-table decipher-mode-syntax-table)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
293 (decipher-read-alphabet)
14596
afb84c1d7750 (decipher-mode, decipher-set-map, decipher-insert,
Karl Heuer <kwzh@gnu.org>
parents: 14573
diff changeset
294 (set (make-local-variable 'font-lock-defaults)
afb84c1d7750 (decipher-mode, decipher-set-map, decipher-insert,
Karl Heuer <kwzh@gnu.org>
parents: 14573
diff changeset
295 '(decipher-font-lock-keywords t))
14523
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
296 ;; Make the buffer writable when we exit Decipher mode:
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
297 (make-local-hook 'change-major-mode-hook)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
298 (add-hook 'change-major-mode-hook
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
299 (lambda () (setq buffer-read-only nil
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
300 buffer-undo-list nil))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
301 nil t)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
302 (run-hooks 'decipher-mode-hook)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
303 (setq buffer-read-only t))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
304 (put 'decipher-mode 'mode-class 'special)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
305
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
306 ;;--------------------------------------------------------------------
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
307 ;; Normal key handling:
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
308 ;;--------------------------------------------------------------------
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
309
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
310 (defmacro decipher-last-command-char ()
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
311 ;; Return the char which ran this command (for compatibility with XEmacs)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
312 (if (fboundp 'event-to-character)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
313 '(event-to-character last-command-event)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
314 'last-command-event))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
315
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
316 (defun decipher-keypress ()
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
317 "Enter a plaintext or ciphertext character."
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
318 (interactive)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
319 (let ((decipher-function 'decipher-set-map)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
320 buffer-read-only) ;Make buffer writable
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
321 (save-excursion
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
322 (or (save-excursion
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
323 (beginning-of-line)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
324 (let ((first-char (following-char)))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
325 (cond
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
326 ((= ?: first-char)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
327 t)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
328 ((= ?> first-char)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
329 nil)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
330 ((= ?\( first-char)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
331 (setq decipher-function 'decipher-alphabet-keypress)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
332 t)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
333 ((= ?\) first-char)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
334 (setq decipher-function 'decipher-alphabet-keypress)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
335 nil)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
336 (t
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
337 (error "Bad location")))))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
338 (let (goal-column)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
339 (previous-line 1)))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
340 (let ((char-a (following-char))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
341 (char-b (decipher-last-command-char)))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
342 (or (and (not (= ?w (char-syntax char-a)))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
343 (= char-b ?\ )) ;Spacebar just advances on non-letters
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
344 (funcall decipher-function char-a char-b)))))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
345 (forward-char))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
346
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
347 (defun decipher-alphabet-keypress (a b)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
348 ;; Handle keypresses in the alphabet lines.
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
349 ;; A is the character in the alphabet row (which starts with '(')
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
350 ;; B is the character pressed
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
351 (cond ((and (>= a ?A) (<= a ?Z))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
352 ;; If A is uppercase, then it is in the ciphertext alphabet:
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
353 (decipher-set-map a b))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
354 ((and (>= a ?a) (<= a ?z))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
355 ;; If A is lowercase, then it is in the plaintext alphabet:
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
356 (if (= b ?\ )
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
357 ;; We are clearing the association (if any):
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
358 (if (/= ?\ (setq b (cdr (assoc a decipher-alphabet))))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
359 (decipher-set-map b ?\ ))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
360 ;; Associate the plaintext char with the char pressed:
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
361 (decipher-set-map b a)))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
362 (t
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
363 ;; If A is not a letter, that's a problem:
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
364 (error "Bad character"))))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
365
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
366 ;;--------------------------------------------------------------------
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
367 ;; Undo:
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
368 ;;--------------------------------------------------------------------
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
369
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
370 (defun decipher-undo ()
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
371 "Undo a change in Decipher mode."
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
372 (interactive)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
373 ;; If we don't get all the way thru, make last-command indicate that
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
374 ;; for the following command.
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
375 (setq this-command t)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
376 (or (eq major-mode 'decipher-mode)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
377 (error "This buffer is not in Decipher mode"))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
378 (or (eq last-command 'decipher-undo)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
379 (setq decipher-pending-undo-list decipher-undo-list))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
380 (or decipher-pending-undo-list
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
381 (error "No further undo information"))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
382 (let ((undo-rec (pop decipher-pending-undo-list))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
383 buffer-read-only ;Make buffer writable
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
384 redo-map redo-rec undo-map)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
385 (or (consp (car undo-rec))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
386 (setq undo-rec (list undo-rec)))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
387 (while (setq undo-map (pop undo-rec))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
388 (setq redo-map (decipher-get-undo (cdr undo-map) (car undo-map)))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
389 (if redo-map
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
390 (setq redo-rec
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
391 (if (consp (car redo-map))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
392 (append redo-map redo-rec)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
393 (cons redo-map redo-rec))))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
394 (decipher-set-map (cdr undo-map) (car undo-map) t))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
395 (decipher-add-undo redo-rec))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
396 (setq this-command 'decipher-undo)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
397 (message "Undo!"))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
398
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
399 (defun decipher-add-undo (undo-rec)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
400 "Add UNDO-REC to the undo list."
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
401 (if undo-rec
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
402 (progn
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
403 (push undo-rec decipher-undo-list)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
404 (incf decipher-undo-list-size)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
405 (if (> decipher-undo-list-size decipher-undo-limit)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
406 (let ((new-size (- decipher-undo-limit 100)))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
407 ;; Truncate undo list to NEW-SIZE elements:
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
408 (setcdr (nthcdr (1- new-size) decipher-undo-list) nil)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
409 (setq decipher-undo-list-size new-size))))))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
410
15877
33e652659075 (decipher-get-undo-copy): New function.
Richard M. Stallman <rms@gnu.org>
parents: 15742
diff changeset
411 (defun decipher-get-undo-copy (cons)
33e652659075 (decipher-get-undo-copy): New function.
Richard M. Stallman <rms@gnu.org>
parents: 15742
diff changeset
412 (if cons
33e652659075 (decipher-get-undo-copy): New function.
Richard M. Stallman <rms@gnu.org>
parents: 15742
diff changeset
413 (cons (car cons) (cdr cons))))
33e652659075 (decipher-get-undo-copy): New function.
Richard M. Stallman <rms@gnu.org>
parents: 15742
diff changeset
414
14523
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
415 (defun decipher-get-undo (cipher-char plain-char)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
416 ;; Return an undo record that will undo the result of
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
417 ;; (decipher-set-map CIPHER-CHAR PLAIN-CHAR)
15877
33e652659075 (decipher-get-undo-copy): New function.
Richard M. Stallman <rms@gnu.org>
parents: 15742
diff changeset
418 ;; We must copy the cons cell because the original cons cells will be
14523
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
419 ;; modified using setcdr.
15877
33e652659075 (decipher-get-undo-copy): New function.
Richard M. Stallman <rms@gnu.org>
parents: 15742
diff changeset
420 (let ((cipher-map (decipher-get-undo-copy (rassoc cipher-char decipher-alphabet)))
33e652659075 (decipher-get-undo-copy): New function.
Richard M. Stallman <rms@gnu.org>
parents: 15742
diff changeset
421 (plain-map (decipher-get-undo-copy (assoc plain-char decipher-alphabet))))
14523
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
422 (cond ((equal ?\ plain-char)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
423 cipher-map)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
424 ((equal cipher-char (cdr plain-map))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
425 nil) ;We aren't changing anything
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
426 ((equal ?\ (cdr plain-map))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
427 (or cipher-map (cons ?\ cipher-char)))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
428 (cipher-map
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
429 (list plain-map cipher-map))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
430 (t
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
431 plain-map))))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
432
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
433 ;;--------------------------------------------------------------------
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
434 ;; Mapping ciphertext and plaintext:
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
435 ;;--------------------------------------------------------------------
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
436
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
437 (defun decipher-set-map (cipher-char plain-char &optional no-undo)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
438 ;; Associate a ciphertext letter with a plaintext letter
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
439 ;; CIPHER-CHAR must be an uppercase or lowercase letter
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
440 ;; PLAIN-CHAR must be a lowercase letter (or a space)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
441 ;; NO-UNDO if non-nil means do not record undo information
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
442 ;; Any existing associations for CIPHER-CHAR or PLAIN-CHAR will be erased.
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
443 (setq cipher-char (upcase cipher-char))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
444 (or (and (>= cipher-char ?A) (<= cipher-char ?Z))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
445 (error "Bad character")) ;Cipher char must be uppercase letter
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
446 (or no-undo
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
447 (decipher-add-undo (decipher-get-undo cipher-char plain-char)))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
448 (let ((cipher-string (char-to-string cipher-char))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
449 (plain-string (char-to-string plain-char))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
450 case-fold-search ;Case is significant
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
451 mapping bound)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
452 (save-excursion
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
453 (goto-char (point-min))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
454 (if (setq mapping (rassoc cipher-char decipher-alphabet))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
455 (progn
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
456 (setcdr mapping ?\ )
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
457 (search-forward-regexp (concat "^([a-z]*"
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
458 (char-to-string (car mapping))))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
459 (decipher-insert ?\ )
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
460 (beginning-of-line)))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
461 (if (setq mapping (assoc plain-char decipher-alphabet))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
462 (progn
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
463 (if (/= ?\ (cdr mapping))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
464 (decipher-set-map (cdr mapping) ?\ t))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
465 (setcdr mapping cipher-char)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
466 (search-forward-regexp (concat "^([a-z]*" plain-string))
14650
2e418434d5d5 (decipher-mode): Removed nonstandard font-lock support.
Richard M. Stallman <rms@gnu.org>
parents: 14596
diff changeset
467 (decipher-insert cipher-char)
14523
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
468 (beginning-of-line)))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
469 (search-forward-regexp (concat "^([a-z]+ [A-Z]*" cipher-string))
14650
2e418434d5d5 (decipher-mode): Removed nonstandard font-lock support.
Richard M. Stallman <rms@gnu.org>
parents: 14596
diff changeset
470 (decipher-insert plain-char)
14523
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
471 (setq case-fold-search t ;Case is not significant
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
472 cipher-string (downcase cipher-string))
14650
2e418434d5d5 (decipher-mode): Removed nonstandard font-lock support.
Richard M. Stallman <rms@gnu.org>
parents: 14596
diff changeset
473 (let ((font-lock-fontify-region-function 'ignore))
2e418434d5d5 (decipher-mode): Removed nonstandard font-lock support.
Richard M. Stallman <rms@gnu.org>
parents: 14596
diff changeset
474 ;; insert-and-inherit will pick the right face automatically
2e418434d5d5 (decipher-mode): Removed nonstandard font-lock support.
Richard M. Stallman <rms@gnu.org>
parents: 14596
diff changeset
475 (while (search-forward-regexp "^:" nil t)
2e418434d5d5 (decipher-mode): Removed nonstandard font-lock support.
Richard M. Stallman <rms@gnu.org>
parents: 14596
diff changeset
476 (setq bound (save-excursion (end-of-line) (point)))
2e418434d5d5 (decipher-mode): Removed nonstandard font-lock support.
Richard M. Stallman <rms@gnu.org>
parents: 14596
diff changeset
477 (while (search-forward cipher-string bound 'end)
2e418434d5d5 (decipher-mode): Removed nonstandard font-lock support.
Richard M. Stallman <rms@gnu.org>
parents: 14596
diff changeset
478 (decipher-insert plain-char)))))))
14523
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
479
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
480 (defun decipher-insert (char)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
481 ;; Insert CHAR in the row below point. It replaces any existing
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
482 ;; character in that position.
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
483 (let ((col (1- (current-column))))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
484 (save-excursion
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
485 (forward-line)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
486 (or (= ?\> (following-char))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
487 (= ?\) (following-char))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
488 (error "Bad location"))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
489 (move-to-column col t)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
490 (or (eolp)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
491 (delete-char 1))
14596
afb84c1d7750 (decipher-mode, decipher-set-map, decipher-insert,
Karl Heuer <kwzh@gnu.org>
parents: 14573
diff changeset
492 (insert-and-inherit char))))
14523
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
493
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
494 ;;--------------------------------------------------------------------
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
495 ;; Checkpoints:
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
496 ;;--------------------------------------------------------------------
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
497 ;; A checkpoint is a comment of the form:
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
498 ;; %!ABCDEFGHIJKLMNOPQRSTUVWXYZ! Description
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
499 ;; Such comments are usually placed at the end of the buffer following
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
500 ;; this header (which is inserted by decipher-make-checkpoint):
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
501 ;; %---------------------------
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
502 ;; % Checkpoints:
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
503 ;; % abcdefghijklmnopqrstuvwxyz
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
504 ;; but this is not required; checkpoints can be placed anywhere.
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
505 ;;
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
506 ;; The description is optional; all that is required is the alphabet.
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
507
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
508 (defun decipher-make-checkpoint (desc)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
509 "Checkpoint the current cipher alphabet.
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
510 This records the current alphabet so you can return to it later.
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
511 You may have any number of checkpoints.
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
512 Type `\\[decipher-restore-checkpoint]' to restore a checkpoint."
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
513 (interactive "sCheckpoint description: ")
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
514 (or (stringp desc)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
515 (setq desc ""))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
516 (let (alphabet
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
517 buffer-read-only ;Make buffer writable
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
518 mapping)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
519 (goto-char (point-min))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
520 (re-search-forward "^)")
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
521 (move-to-column 27 t)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
522 (setq alphabet (buffer-substring-no-properties (- (point) 26) (point)))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
523 (if (re-search-forward "^%![A-Z ]+!" nil 'end)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
524 nil ; Add new checkpoint with others
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
525 (if (re-search-backward "^% *Local Variables:" nil t)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
526 ;; Add checkpoints before local variables list:
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
527 (progn (forward-line -1)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
528 (or (looking-at "^ *$")
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
529 (progn (forward-line) (insert ?\n) (forward-line -1)))))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
530 (insert "\n%" (make-string 69 ?\-)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
531 "\n% Checkpoints:\n% abcdefghijklmnopqrstuvwxyz\n"))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
532 (beginning-of-line)
14650
2e418434d5d5 (decipher-mode): Removed nonstandard font-lock support.
Richard M. Stallman <rms@gnu.org>
parents: 14596
diff changeset
533 (insert "%!" alphabet "! " desc ?\n)))
14523
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
534
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
535 (defun decipher-restore-checkpoint ()
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
536 "Restore the cipher alphabet from a checkpoint.
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
537 If point is not on a checkpoint line, moves to the first checkpoint line.
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
538 If point is on a checkpoint, restores that checkpoint.
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
539
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
540 Type `\\[decipher-make-checkpoint]' to make a checkpoint."
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
541 (interactive)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
542 (beginning-of-line)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
543 (if (looking-at "%!\\([A-Z ]+\\)!")
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
544 ;; Restore this checkpoint:
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
545 (let ((alphabet (match-string 1))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
546 buffer-read-only) ;Make buffer writable
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
547 (goto-char (point-min))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
548 (re-search-forward "^)")
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
549 (or (eolp)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
550 (delete-region (point) (progn (end-of-line) (point))))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
551 (insert alphabet)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
552 (decipher-resync))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
553 ;; Move to the first checkpoint:
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
554 (goto-char (point-min))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
555 (if (re-search-forward "^%![A-Z ]+!" nil t)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
556 (message "Select the checkpoint to restore and type `%s'"
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
557 (substitute-command-keys "\\[decipher-restore-checkpoint]"))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
558 (error "No checkpoints in this buffer"))))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
559
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
560 ;;--------------------------------------------------------------------
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
561 ;; Miscellaneous commands:
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
562 ;;--------------------------------------------------------------------
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
563
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
564 (defun decipher-complete-alphabet ()
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
565 "Complete the cipher alphabet.
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
566 This fills any blanks in the cipher alphabet with the unused letters
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
567 in alphabetical order. Use this when you have a keyword cipher and
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
568 you have determined the keyword."
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
569 (interactive)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
570 (let ((cipher-char ?A)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
571 (ptr decipher-alphabet)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
572 buffer-read-only ;Make buffer writable
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
573 plain-map undo-rec)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
574 (while (setq plain-map (pop ptr))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
575 (if (equal ?\ (cdr plain-map))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
576 (progn
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
577 (while (rassoc cipher-char decipher-alphabet)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
578 ;; Find the next unused letter
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
579 (incf cipher-char))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
580 (push (cons ?\ cipher-char) undo-rec)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
581 (decipher-set-map cipher-char (car plain-map) t))))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
582 (decipher-add-undo undo-rec)))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
583
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
584 (defun decipher-show-alphabet ()
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
585 "Display the current cipher alphabet in the message line."
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
586 (interactive)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
587 (message
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
588 (mapconcat (lambda (a)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
589 (concat
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
590 (char-to-string (car a))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
591 (char-to-string (cdr a))))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
592 decipher-alphabet
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
593 "")))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
594
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
595 (defun decipher-resync ()
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
596 "Reprocess the buffer using the alphabet from the top.
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
597 This regenerates all deciphered plaintext and clears the undo list.
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
598 You should use this if you edit the ciphertext."
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
599 (interactive)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
600 (message "Reprocessing buffer...")
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
601 (let (alphabet
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
602 buffer-read-only ;Make buffer writable
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
603 mapping)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
604 (save-excursion
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
605 (decipher-read-alphabet)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
606 (setq alphabet decipher-alphabet)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
607 (goto-char (point-min))
14650
2e418434d5d5 (decipher-mode): Removed nonstandard font-lock support.
Richard M. Stallman <rms@gnu.org>
parents: 14596
diff changeset
608 (and (re-search-forward "^).+" nil t)
14523
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
609 (replace-match ")" nil nil))
14650
2e418434d5d5 (decipher-mode): Removed nonstandard font-lock support.
Richard M. Stallman <rms@gnu.org>
parents: 14596
diff changeset
610 (while (re-search-forward "^>.+" nil t)
14523
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
611 (replace-match ">" nil nil))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
612 (decipher-read-alphabet)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
613 (while (setq mapping (pop alphabet))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
614 (or (equal ?\ (cdr mapping))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
615 (decipher-set-map (cdr mapping) (car mapping))))))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
616 (setq decipher-undo-list nil
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
617 decipher-undo-list-size 0)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
618 (message "Reprocessing buffer...done"))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
619
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
620 ;;--------------------------------------------------------------------
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
621 ;; Miscellaneous functions:
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
622 ;;--------------------------------------------------------------------
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
623
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
624 (defun decipher-read-alphabet ()
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
625 "Build the decipher-alphabet from the alphabet line in the buffer."
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
626 (save-excursion
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
627 (goto-char (point-min))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
628 (search-forward-regexp "^)")
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
629 (move-to-column 27 t)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
630 (setq decipher-alphabet nil)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
631 (let ((plain-char ?z))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
632 (while (>= plain-char ?a)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
633 (backward-char)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
634 (push (cons plain-char (following-char)) decipher-alphabet)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
635 (decf plain-char)))))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
636
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
637 ;;;===================================================================
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
638 ;;; Analyzing ciphertext:
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
639 ;;;===================================================================
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
640
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
641 (defun decipher-frequency-count ()
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
642 "Display the frequency count in the statistics buffer."
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
643 (interactive)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
644 (decipher-analyze)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
645 (decipher-display-regexp "^A" "^[A-Z][A-Z]"))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
646
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
647 (defun decipher-digram-list ()
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
648 "Display the list of digrams in the statistics buffer."
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
649 (interactive)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
650 (decipher-analyze)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
651 (decipher-display-regexp "[A-Z][A-Z] +[0-9]" "^$"))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
652
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
653 (defun decipher-adjacency-list (cipher-char)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
654 "Display the adjacency list for the letter at point.
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
655 The adjacency list shows all letters which come next to CIPHER-CHAR.
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
656
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
657 An adjacency list (for the letter X) looks like this:
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
658 1 1 1 1 1 3 2 1 3 8
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
659 X: 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 * 11 14 9%
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
660 1 1 1 2 1 1 2 5 7
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
661 This says that X comes before D once, and after B once. X begins 5
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
662 words, and ends 3 words (`*' represents a space). X comes before 8
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
663 different letters, after 7 differerent letters, and is next to a total
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
664 of 11 different letters. It occurs 14 times, making up 9% of the
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
665 ciphertext."
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
666 (interactive (list (upcase (following-char))))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
667 (decipher-analyze)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
668 (let (start end)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
669 (save-excursion
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
670 (set-buffer (decipher-stats-buffer))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
671 (goto-char (point-min))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
672 (or (re-search-forward (format "^%c: " cipher-char) nil t)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
673 (error "Character `%c' is not used in ciphertext." cipher-char))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
674 (forward-line -1)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
675 (setq start (point))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
676 (forward-line 3)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
677 (setq end (point)))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
678 (decipher-display-range start end)))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
679
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
680 ;;--------------------------------------------------------------------
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
681 (defun decipher-analyze ()
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
682 "Perform frequency analysis on the current buffer if necessary."
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
683 (cond
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
684 ;; If this is the statistics buffer, do nothing:
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
685 ((eq major-mode 'decipher-stats-mode))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
686 ;; If this is the Decipher buffer, see if the stats buffer exists:
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
687 ((eq major-mode 'decipher-mode)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
688 (or (and (bufferp decipher-stats-buffer)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
689 (buffer-name decipher-stats-buffer))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
690 (decipher-analyze-buffer)))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
691 ;; Otherwise:
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
692 (t (error "This buffer is not in Decipher mode"))))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
693
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
694 ;;--------------------------------------------------------------------
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
695 (defun decipher-display-range (start end)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
696 "Display text between START and END in the statistics buffer.
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
697 START and END are positions in the statistics buffer. Makes the
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
698 statistics buffer visible and sizes the window to just fit the
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
699 displayed text, but leaves the current window selected."
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
700 (let ((stats-buffer (decipher-stats-buffer))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
701 (current-window (selected-window))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
702 (pop-up-windows t))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
703 (or (eq (current-buffer) stats-buffer)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
704 (pop-to-buffer stats-buffer))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
705 (goto-char start)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
706 (or (one-window-p t)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
707 (enlarge-window (- (1+ (count-lines start end)) (window-height))))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
708 (recenter 0)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
709 (select-window current-window)))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
710
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
711 (defun decipher-display-regexp (start-regexp end-regexp)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
712 "Display text between two regexps in the statistics buffer.
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
713
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
714 START-REGEXP matches the first line to display.
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
715 END-REGEXP matches the line after that which ends the display.
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
716 The ending line is included in the display unless it is blank."
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
717 (let (start end)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
718 (save-excursion
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
719 (set-buffer (decipher-stats-buffer))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
720 (goto-char (point-min))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
721 (re-search-forward start-regexp)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
722 (beginning-of-line)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
723 (setq start (point))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
724 (re-search-forward end-regexp)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
725 (beginning-of-line)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
726 (or (looking-at "^ *$")
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
727 (forward-line 1))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
728 (setq end (point)))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
729 (decipher-display-range start end)))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
730
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
731 ;;--------------------------------------------------------------------
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
732 (defun decipher-loop-with-breaks (func)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
733 "Loop through ciphertext, calling FUNC once for each letter & word division.
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
734
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
735 FUNC is called with no arguments, and its return value is unimportant.
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
736 It may examine `decipher-char' to see the current ciphertext
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
737 character. `decipher-char' contains either an uppercase letter or a space.
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
738
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
739 FUNC is called exactly once between words, with `decipher-char' set to
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
740 a space.
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
741
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
742 See `decipher-loop-no-breaks' if you do not care about word divisions."
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
743 (let ((decipher-char ?\ )
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
744 (decipher--loop-prev-char ?\ ))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
745 (save-excursion
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
746 (goto-char (point-min))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
747 (funcall func) ;Space marks beginning of first word
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
748 (while (search-forward-regexp "^:" nil t)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
749 (while (not (eolp))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
750 (setq decipher-char (upcase (following-char)))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
751 (or (and (>= decipher-char ?A) (<= decipher-char ?Z))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
752 (setq decipher-char ?\ ))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
753 (or (and (equal decipher-char ?\ )
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
754 (equal decipher--loop-prev-char ?\ ))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
755 (funcall func))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
756 (setq decipher--loop-prev-char decipher-char)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
757 (forward-char))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
758 (or (equal decipher-char ?\ )
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
759 (progn
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
760 (setq decipher-char ?\ ;
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
761 decipher--loop-prev-char ?\ )
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
762 (funcall func)))))))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
763
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
764 (defun decipher-loop-no-breaks (func)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
765 "Loop through ciphertext, calling FUNC once for each letter.
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
766
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
767 FUNC is called with no arguments, and its return value is unimportant.
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
768 It may examine `decipher-char' to see the current ciphertext letter.
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
769 `decipher-char' contains an uppercase letter.
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
770
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
771 Punctuation and spacing in the ciphertext are ignored.
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
772 See `decipher-loop-with-breaks' if you care about word divisions."
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
773 (let (decipher-char)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
774 (save-excursion
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
775 (goto-char (point-min))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
776 (while (search-forward-regexp "^:" nil t)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
777 (while (not (eolp))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
778 (setq decipher-char (upcase (following-char)))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
779 (and (>= decipher-char ?A)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
780 (<= decipher-char ?Z)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
781 (funcall func))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
782 (forward-char))))))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
783
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
784 ;;--------------------------------------------------------------------
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
785 ;; Perform the analysis:
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
786 ;;--------------------------------------------------------------------
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
787
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
788 (defun decipher-insert-frequency-counts (freq-list total)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
789 "Insert frequency counts in current buffer.
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
790 Each element of FREQ-LIST is a list (LETTER FREQ ...).
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
791 TOTAL is the total number of letters in the ciphertext."
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
792 (let ((i 4) temp-list)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
793 (while (> i 0)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
794 (setq temp-list freq-list)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
795 (while temp-list
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
796 (insert (caar temp-list)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
797 (format "%4d%3d%% "
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
798 (cadar temp-list)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
799 (/ (* 100 (cadar temp-list)) total)))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
800 (setq temp-list (nthcdr 4 temp-list)))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
801 (insert ?\n)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
802 (setq freq-list (cdr freq-list)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
803 i (1- i)))))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
804
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
805 (defun decipher--analyze ()
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
806 ;; Perform frequency analysis on ciphertext.
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
807 ;;
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
808 ;; This function is called repeatedly with decipher-char set to each
14573
3ae037e10c04 Doc changes.
Karl Heuer <kwzh@gnu.org>
parents: 14545
diff changeset
809 ;; character of ciphertext. It uses decipher--prev-char to remember
14523
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
810 ;; the previous ciphertext character.
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
811 ;;
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
812 ;; It builds several data structures, which must be initialized
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
813 ;; before the first call to decipher--analyze. The arrays are
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
814 ;; indexed with A = 0, B = 1, ..., Z = 25, SPC = 26 (if used).
14573
3ae037e10c04 Doc changes.
Karl Heuer <kwzh@gnu.org>
parents: 14545
diff changeset
815 ;; decipher--after: (initialize to zeros)
14523
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
816 ;; A vector of 26 vectors of 27 integers. The first vector
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
817 ;; represents the number of times A follows each character, the
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
818 ;; second vector represents B, and so on.
14573
3ae037e10c04 Doc changes.
Karl Heuer <kwzh@gnu.org>
parents: 14545
diff changeset
819 ;; decipher--before: (initialize to zeros)
3ae037e10c04 Doc changes.
Karl Heuer <kwzh@gnu.org>
parents: 14545
diff changeset
820 ;; The same as decipher--after, but representing the number of
3ae037e10c04 Doc changes.
Karl Heuer <kwzh@gnu.org>
parents: 14545
diff changeset
821 ;; times the character precedes each other character.
3ae037e10c04 Doc changes.
Karl Heuer <kwzh@gnu.org>
parents: 14545
diff changeset
822 ;; decipher--digram-list: (initialize to nil)
14523
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
823 ;; An alist with an entry for each digram (2-character sequence)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
824 ;; encountered. Each element is a cons cell (DIGRAM . FREQ),
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
825 ;; where DIGRAM is a 2 character string and FREQ is the number
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
826 ;; of times it occurs.
14573
3ae037e10c04 Doc changes.
Karl Heuer <kwzh@gnu.org>
parents: 14545
diff changeset
827 ;; decipher--freqs: (initialize to zeros)
14523
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
828 ;; A vector of 26 integers, counting the number of occurrences
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
829 ;; of the corresponding characters.
14573
3ae037e10c04 Doc changes.
Karl Heuer <kwzh@gnu.org>
parents: 14545
diff changeset
830 (setq decipher--digram (format "%c%c" decipher--prev-char decipher-char))
3ae037e10c04 Doc changes.
Karl Heuer <kwzh@gnu.org>
parents: 14545
diff changeset
831 (incf (cdr (or (assoc decipher--digram decipher--digram-list)
3ae037e10c04 Doc changes.
Karl Heuer <kwzh@gnu.org>
parents: 14545
diff changeset
832 (car (push (cons decipher--digram 0)
3ae037e10c04 Doc changes.
Karl Heuer <kwzh@gnu.org>
parents: 14545
diff changeset
833 decipher--digram-list)))))
3ae037e10c04 Doc changes.
Karl Heuer <kwzh@gnu.org>
parents: 14545
diff changeset
834 (and (>= decipher--prev-char ?A)
3ae037e10c04 Doc changes.
Karl Heuer <kwzh@gnu.org>
parents: 14545
diff changeset
835 (incf (aref (aref decipher--before (- decipher--prev-char ?A))
14523
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
836 (if (equal decipher-char ?\ )
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
837 26
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
838 (- decipher-char ?A)))))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
839 (and (>= decipher-char ?A)
14573
3ae037e10c04 Doc changes.
Karl Heuer <kwzh@gnu.org>
parents: 14545
diff changeset
840 (incf (aref decipher--freqs (- decipher-char ?A)))
3ae037e10c04 Doc changes.
Karl Heuer <kwzh@gnu.org>
parents: 14545
diff changeset
841 (incf (aref (aref decipher--after (- decipher-char ?A))
3ae037e10c04 Doc changes.
Karl Heuer <kwzh@gnu.org>
parents: 14545
diff changeset
842 (if (equal decipher--prev-char ?\ )
14523
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
843 26
14573
3ae037e10c04 Doc changes.
Karl Heuer <kwzh@gnu.org>
parents: 14545
diff changeset
844 (- decipher--prev-char ?A)))))
3ae037e10c04 Doc changes.
Karl Heuer <kwzh@gnu.org>
parents: 14545
diff changeset
845 (setq decipher--prev-char decipher-char))
14523
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
846
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
847 (defun decipher--digram-counts (counts)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
848 "Generate the counts for an adjacency list."
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
849 (let ((total 0))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
850 (concat
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
851 (mapconcat (lambda (x)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
852 (cond ((> x 99) (incf total) "XX")
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
853 ((> x 0) (incf total) (format "%2d" x))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
854 (t " ")))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
855 counts
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
856 "")
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
857 (format "%4d" (if (> (aref counts 26) 0)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
858 (1- total) ;Don't count space
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
859 total)))))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
860
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
861 (defun decipher--digram-total (before-count after-count)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
862 "Count the number of different letters a letter appears next to."
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
863 ;; We do not include spaces (word divisions) in this count.
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
864 (let ((total 0)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
865 (i 26))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
866 (while (>= (decf i) 0)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
867 (if (or (> (aref before-count i) 0)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
868 (> (aref after-count i) 0))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
869 (incf total)))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
870 total))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
871
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
872 (defun decipher-analyze-buffer ()
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
873 "Perform frequency analysis and store results in statistics buffer.
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
874 Creates the statistics buffer if it doesn't exist."
14573
3ae037e10c04 Doc changes.
Karl Heuer <kwzh@gnu.org>
parents: 14545
diff changeset
875 (let ((decipher--prev-char (if decipher-ignore-spaces ?\ ?\*))
3ae037e10c04 Doc changes.
Karl Heuer <kwzh@gnu.org>
parents: 14545
diff changeset
876 (decipher--before (make-vector 26 nil))
3ae037e10c04 Doc changes.
Karl Heuer <kwzh@gnu.org>
parents: 14545
diff changeset
877 (decipher--after (make-vector 26 nil))
3ae037e10c04 Doc changes.
Karl Heuer <kwzh@gnu.org>
parents: 14545
diff changeset
878 (decipher--freqs (make-vector 26 0))
14523
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
879 (total-chars 0)
14573
3ae037e10c04 Doc changes.
Karl Heuer <kwzh@gnu.org>
parents: 14545
diff changeset
880 decipher--digram decipher--digram-list freq-list)
14523
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
881 (message "Scanning buffer...")
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
882 (let ((i 26))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
883 (while (>= (decf i) 0)
14573
3ae037e10c04 Doc changes.
Karl Heuer <kwzh@gnu.org>
parents: 14545
diff changeset
884 (aset decipher--before i (make-vector 27 0))
3ae037e10c04 Doc changes.
Karl Heuer <kwzh@gnu.org>
parents: 14545
diff changeset
885 (aset decipher--after i (make-vector 27 0))))
14523
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
886 (if decipher-ignore-spaces
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
887 (progn
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
888 (decipher-loop-no-breaks 'decipher--analyze)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
889 ;; The first character of ciphertext was marked as following a space:
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
890 (let ((i 26))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
891 (while (>= (decf i) 0)
14573
3ae037e10c04 Doc changes.
Karl Heuer <kwzh@gnu.org>
parents: 14545
diff changeset
892 (aset (aref decipher--after i) 26 0))))
14523
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
893 (decipher-loop-with-breaks 'decipher--analyze))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
894 (message "Processing results...")
14573
3ae037e10c04 Doc changes.
Karl Heuer <kwzh@gnu.org>
parents: 14545
diff changeset
895 (setcdr (last decipher--digram-list 2) nil) ;Delete the phony "* " digram
14523
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
896 ;; Sort the digram list by frequency and alphabetical order:
14573
3ae037e10c04 Doc changes.
Karl Heuer <kwzh@gnu.org>
parents: 14545
diff changeset
897 (setq decipher--digram-list (sort (sort decipher--digram-list
14523
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
898 (lambda (a b) (string< (car a) (car b))))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
899 (lambda (a b) (> (cdr a) (cdr b)))))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
900 ;; Generate the frequency list:
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
901 ;; Each element is a list of 3 elements (LETTER FREQ DIFFERENT),
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
902 ;; where LETTER is the ciphertext character, FREQ is the number
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
903 ;; of times it occurs, and DIFFERENT is the number of different
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
904 ;; letters it appears next to.
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
905 (let ((i 26))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
906 (while (>= (decf i) 0)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
907 (setq freq-list
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
908 (cons (list (+ i ?A)
14573
3ae037e10c04 Doc changes.
Karl Heuer <kwzh@gnu.org>
parents: 14545
diff changeset
909 (aref decipher--freqs i)
3ae037e10c04 Doc changes.
Karl Heuer <kwzh@gnu.org>
parents: 14545
diff changeset
910 (decipher--digram-total (aref decipher--before i)
3ae037e10c04 Doc changes.
Karl Heuer <kwzh@gnu.org>
parents: 14545
diff changeset
911 (aref decipher--after i)))
14523
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
912 freq-list)
14573
3ae037e10c04 Doc changes.
Karl Heuer <kwzh@gnu.org>
parents: 14545
diff changeset
913 total-chars (+ total-chars (aref decipher--freqs i)))))
14523
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
914 (save-excursion
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
915 ;; Switch to statistics buffer, creating it if necessary:
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
916 (set-buffer (decipher-stats-buffer t))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
917 ;; This can't happen, but it never hurts to double-check:
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
918 (or (eq major-mode 'decipher-stats-mode)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
919 (error "Buffer %s is not in Decipher-Stats mode" (buffer-name)))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
920 (setq buffer-read-only nil)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
921 (erase-buffer)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
922 ;; Display frequency counts for letters A-Z:
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
923 (decipher-insert-frequency-counts freq-list total-chars)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
924 (insert ?\n)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
925 ;; Display frequency counts for letters in order of frequency:
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
926 (setq freq-list (sort freq-list
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
927 (lambda (a b) (> (second a) (second b)))))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
928 (decipher-insert-frequency-counts freq-list total-chars)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
929 ;; Display letters in order of frequency:
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
930 (insert ?\n (mapconcat (lambda (a) (char-to-string (car a)))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
931 freq-list nil)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
932 "\n\n")
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
933 ;; Display list of digrams in order of frequency:
14573
3ae037e10c04 Doc changes.
Karl Heuer <kwzh@gnu.org>
parents: 14545
diff changeset
934 (let* ((rows (floor (+ (length decipher--digram-list) 9) 10))
14523
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
935 (i rows)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
936 temp-list)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
937 (while (> i 0)
14573
3ae037e10c04 Doc changes.
Karl Heuer <kwzh@gnu.org>
parents: 14545
diff changeset
938 (setq temp-list decipher--digram-list)
14523
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
939 (while temp-list
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
940 (insert (caar temp-list)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
941 (format "%3d "
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
942 (cdar temp-list)))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
943 (setq temp-list (nthcdr rows temp-list)))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
944 (delete-horizontal-space)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
945 (insert ?\n)
14573
3ae037e10c04 Doc changes.
Karl Heuer <kwzh@gnu.org>
parents: 14545
diff changeset
946 (setq decipher--digram-list (cdr decipher--digram-list)
14523
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
947 i (1- i))))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
948 ;; Display adjacency list for each letter, sorted in descending
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
949 ;; order of the number of adjacent letters:
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
950 (setq freq-list (sort freq-list
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
951 (lambda (a b) (> (third a) (third b)))))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
952 (let ((temp-list freq-list)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
953 entry i)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
954 (while (setq entry (pop temp-list))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
955 (if (equal 0 (second entry))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
956 nil ;This letter was not used
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
957 (setq i (- (car entry) ?A))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
958 (insert ?\n " "
14573
3ae037e10c04 Doc changes.
Karl Heuer <kwzh@gnu.org>
parents: 14545
diff changeset
959 (decipher--digram-counts (aref decipher--before i)) ?\n
14523
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
960 (car entry)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
961 ": 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 *"
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
962 (format "%4d %4d %3d%%\n "
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
963 (third entry) (second entry)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
964 (/ (* 100 (second entry)) total-chars))
14573
3ae037e10c04 Doc changes.
Karl Heuer <kwzh@gnu.org>
parents: 14545
diff changeset
965 (decipher--digram-counts (aref decipher--after i)) ?\n))))
14523
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
966 (setq buffer-read-only t)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
967 (set-buffer-modified-p nil)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
968 ))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
969 (message nil))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
970
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
971 ;;====================================================================
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
972 ;; Statistics Buffer:
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
973 ;;====================================================================
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
974
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
975 (defun decipher-stats-mode ()
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
976 "Major mode for displaying ciphertext statistics."
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
977 (interactive)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
978 (kill-all-local-variables)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
979 (setq buffer-read-only t
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
980 buffer-undo-list t ;Disable undo
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
981 case-fold-search nil ;Case is significant when searching
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
982 indent-tabs-mode nil ;Do not use tab characters
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
983 major-mode 'decipher-stats-mode
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
984 mode-name "Decipher-Stats")
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
985 (use-local-map decipher-stats-mode-map)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
986 (run-hooks 'decipher-stats-mode-hook))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
987 (put 'decipher-stats-mode 'mode-class 'special)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
988
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
989 ;;--------------------------------------------------------------------
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
990
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
991 (defun decipher-display-stats-buffer ()
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
992 "Make the statistics buffer visible, but do not select it."
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
993 (let ((stats-buffer (decipher-stats-buffer))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
994 (current-window (selected-window)))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
995 (or (eq (current-buffer) stats-buffer)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
996 (progn
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
997 (pop-to-buffer stats-buffer)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
998 (select-window current-window)))))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
999
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1000 (defun decipher-stats-buffer (&optional create)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1001 "Return the buffer used for decipher statistics.
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1002 If CREATE is non-nil, create the buffer if it doesn't exist.
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1003 This is guaranteed to return a buffer in Decipher-Stats mode;
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1004 if it can't, it signals an error."
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1005 (cond
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1006 ;; We may already be in the statistics buffer:
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1007 ((eq major-mode 'decipher-stats-mode)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1008 (current-buffer))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1009 ;; See if decipher-stats-buffer exists:
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1010 ((and (bufferp decipher-stats-buffer)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1011 (buffer-name decipher-stats-buffer))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1012 (or (save-excursion
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1013 (set-buffer decipher-stats-buffer)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1014 (eq major-mode 'decipher-stats-mode))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1015 (error "Buffer %s is not in Decipher-Stats mode"
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1016 (buffer-name decipher-stats-buffer)))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1017 decipher-stats-buffer)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1018 ;; Create a new buffer if requested:
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1019 (create
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1020 (let ((stats-name (concat "*" (buffer-name) "*")))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1021 (setq decipher-stats-buffer
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1022 (if (eq 'decipher-stats-mode
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1023 (cdr-safe (assoc 'major-mode
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1024 (buffer-local-variables
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1025 (get-buffer stats-name)))))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1026 ;; We just lost track of the statistics buffer:
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1027 (get-buffer stats-name)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1028 (generate-new-buffer stats-name))))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1029 (save-excursion
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1030 (set-buffer decipher-stats-buffer)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1031 (decipher-stats-mode))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1032 decipher-stats-buffer)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1033 ;; Give up:
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1034 (t (error "No statistics buffer"))))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1035
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1036 ;;====================================================================
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1037
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1038 (provide 'decipher)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1039
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1040 ;;;(defun decipher-show-undo-list ()
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1041 ;;; "Display the undo list (for debugging purposes)."
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1042 ;;; (interactive)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1043 ;;; (with-output-to-temp-buffer "*Decipher Undo*"
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1044 ;;; (let ((undo-list decipher-undo-list)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1045 ;;; undo-rec undo-map)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1046 ;;; (save-excursion
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1047 ;;; (set-buffer "*Decipher Undo*")
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1048 ;;; (while (setq undo-rec (pop undo-list))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1049 ;;; (or (consp (car undo-rec))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1050 ;;; (setq undo-rec (list undo-rec)))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1051 ;;; (insert ?\()
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1052 ;;; (while (setq undo-map (pop undo-rec))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1053 ;;; (insert (cdr undo-map) (car undo-map) ?\ ))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1054 ;;; (delete-backward-char 1)
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1055 ;;; (insert ")\n"))))))
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1056
e260aa3684a5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1057 ;;; decipher.el ends here