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