annotate lisp/play/decipher.el @ 22481:c19803db4a93

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