X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/67ab0163d67fbfeb41c37c8a259f27eeef965520..62f65abf279da30e6fff4bcf3462b548aeb2dc97:/lisp/play/decipher.el diff --git a/lisp/play/decipher.el b/lisp/play/decipher.el index 3de8ca3d4f..c2268a9b05 100644 --- a/lisp/play/decipher.el +++ b/lisp/play/decipher.el @@ -1,6 +1,6 @@ ;;; decipher.el --- cryptanalyze monoalphabetic substitution ciphers ;; -;; Copyright (C) 1995-1996, 2001-2011 Free Software Foundation, Inc. +;; Copyright (C) 1995-1996, 2001-2015 Free Software Foundation, Inc. ;; ;; Author: Christopher J. Madsen ;; Keywords: games @@ -88,8 +88,7 @@ ;;; Variables: ;;;=================================================================== -(eval-when-compile - (require 'cl)) +(eval-when-compile (require 'cl-lib)) (defgroup decipher nil "Cryptanalyze monoalphabetic substitution ciphers." @@ -139,19 +138,7 @@ the tail of the list." ("^)\\([A-Z ]+\\)\\([a-z ]+\\)" (1 font-lock-keyword-face) (2 font-lock-string-face))) - "Expressions to fontify in Decipher mode. - -Ciphertext uses `font-lock-keyword-face', plaintext uses -`font-lock-string-face', comments use `font-lock-comment-face', and -checkpoints use `font-lock-constant-face'. You can customize the -display by changing these variables. For best results, I recommend -that all faces use the same background color. - -For example, to display ciphertext in the `bold' face, use - (add-hook 'decipher-mode-hook - (lambda () (set (make-local-variable 'font-lock-keyword-face) - 'bold))) -in your `.emacs' file.") + "Font Lock keywords for Decipher mode.") (defvar decipher-mode-map (let ((map (make-keymap))) @@ -170,7 +157,7 @@ in your `.emacs' file.") (let ((key ?a)) (while (<= key ?z) (define-key map (vector key) 'decipher-keypress) - (incf key))) + (cl-incf key))) map) "Keymap for Decipher mode.") @@ -194,7 +181,7 @@ in your `.emacs' file.") (c ?0)) (while (<= c ?9) (modify-syntax-entry c "_" table) ;Digits are not part of words - (incf c)) + (cl-incf c)) (setq decipher-mode-syntax-table table))) (defvar decipher-alphabet nil) @@ -353,7 +340,7 @@ The most useful commands are: (let ((char-a (following-char)) (char-b (decipher-last-command-char))) (or (and (not (= ?w (char-syntax char-a))) - (= char-b ?\ )) ;Spacebar just advances on non-letters + (= char-b ?\s)) ;Spacebar just advances on non-letters (funcall decipher-function char-a char-b))))) (forward-char)) @@ -366,10 +353,10 @@ The most useful commands are: (decipher-set-map a b)) ((and (>= a ?a) (<= a ?z)) ;; If A is lowercase, then it is in the plaintext alphabet: - (if (= b ?\ ) + (if (= b ?\s) ;; We are clearing the association (if any): - (if (/= ?\ (setq b (cdr (assoc a decipher-alphabet)))) - (decipher-set-map b ?\ )) + (if (/= ?\s (setq b (cdr (assoc a decipher-alphabet)))) + (decipher-set-map b ?\s)) ;; Associate the plaintext char with the char pressed: (decipher-set-map b a))) (t @@ -414,7 +401,7 @@ The most useful commands are: (if undo-rec (progn (push undo-rec decipher-undo-list) - (incf decipher-undo-list-size) + (cl-incf decipher-undo-list-size) (if (> decipher-undo-list-size decipher-undo-limit) (let ((new-size (- decipher-undo-limit 100))) ;; Truncate undo list to NEW-SIZE elements: @@ -432,12 +419,12 @@ The most useful commands are: ;; modified using setcdr. (let ((cipher-map (decipher-copy-cons (rassoc cipher-char decipher-alphabet))) (plain-map (decipher-copy-cons (assoc plain-char decipher-alphabet)))) - (cond ((equal ?\ plain-char) + (cond ((equal ?\s plain-char) cipher-map) ((equal cipher-char (cdr plain-map)) nil) ;We aren't changing anything - ((equal ?\ (cdr plain-map)) - (or cipher-map (cons ?\ cipher-char))) + ((equal ?\s (cdr plain-map)) + (or cipher-map (cons ?\s cipher-char))) (cipher-map (list plain-map cipher-map)) (t @@ -466,15 +453,15 @@ The most useful commands are: (goto-char (point-min)) (if (setq mapping (rassoc cipher-char decipher-alphabet)) (progn - (setcdr mapping ?\ ) + (setcdr mapping ?\s) (search-forward-regexp (concat "^([a-z]*" (char-to-string (car mapping)))) - (decipher-insert ?\ ) + (decipher-insert ?\s) (beginning-of-line))) (if (setq mapping (assoc plain-char decipher-alphabet)) (progn - (if (/= ?\ (cdr mapping)) - (decipher-set-map (cdr mapping) ?\ t)) + (if (/= ?\s (cdr mapping)) + (decipher-set-map (cdr mapping) ?\s t)) (setcdr mapping cipher-char) (search-forward-regexp (concat "^([a-z]*" plain-string)) (decipher-insert cipher-char) @@ -527,8 +514,7 @@ Type `\\[decipher-restore-checkpoint]' to restore a checkpoint." (or (stringp desc) (setq desc "")) (let (alphabet - buffer-read-only ;Make buffer writable - mapping) + buffer-read-only) ;Make buffer writable (goto-char (point-min)) (re-search-forward "^)") (move-to-column 27 t) @@ -585,12 +571,12 @@ you have determined the keyword." buffer-read-only ;Make buffer writable plain-map undo-rec) (while (setq plain-map (pop ptr)) - (if (equal ?\ (cdr plain-map)) + (if (equal ?\s (cdr plain-map)) (progn (while (rassoc cipher-char decipher-alphabet) ;; Find the next unused letter - (incf cipher-char)) - (push (cons ?\ cipher-char) undo-rec) + (cl-incf cipher-char)) + (push (cons ?\s cipher-char) undo-rec) (decipher-set-map cipher-char (car plain-map) t)))) (decipher-add-undo undo-rec))) @@ -624,7 +610,7 @@ You should use this if you edit the ciphertext." (replace-match ">" nil nil)) (decipher-read-alphabet) (while (setq mapping (pop alphabet)) - (or (equal ?\ (cdr mapping)) + (or (equal ?\s (cdr mapping)) (decipher-set-map (cdr mapping) (car mapping)))))) (setq decipher-undo-list nil decipher-undo-list-size 0) @@ -645,7 +631,7 @@ You should use this if you edit the ciphertext." (while (>= plain-char ?a) (backward-char) (push (cons plain-char (following-char)) decipher-alphabet) - (decf plain-char))))) + (cl-decf plain-char))))) ;;;=================================================================== ;;; Analyzing ciphertext: @@ -673,7 +659,7 @@ 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% 1 1 1 2 1 1 2 5 7 This says that X comes before D once, and after B once. X begins 5 words, and ends 3 words (`*' represents a space). X comes before 8 -different letters, after 7 differerent letters, and is next to a total +different letters, after 7 different letters, and is next to a total of 11 different letters. It occurs 14 times, making up 9% of the ciphertext." (interactive (list (upcase (following-char)))) @@ -751,8 +737,8 @@ FUNC is called exactly once between words, with `decipher-char' set to a space. See `decipher-loop-no-breaks' if you do not care about word divisions." - (let ((decipher-char ?\ ) - (decipher--loop-prev-char ?\ )) + (let ((decipher-char ?\s) + (decipher--loop-prev-char ?\s)) (save-excursion (goto-char (point-min)) (funcall func) ;Space marks beginning of first word @@ -760,16 +746,16 @@ See `decipher-loop-no-breaks' if you do not care about word divisions." (while (not (eolp)) (setq decipher-char (upcase (following-char))) (or (and (>= decipher-char ?A) (<= decipher-char ?Z)) - (setq decipher-char ?\ )) - (or (and (equal decipher-char ?\ ) - (equal decipher--loop-prev-char ?\ )) + (setq decipher-char ?\s)) + (or (and (equal decipher-char ?\s) + (equal decipher--loop-prev-char ?\s)) (funcall func)) (setq decipher--loop-prev-char decipher-char) (forward-char)) - (or (equal decipher-char ?\ ) + (or (equal decipher-char ?\s) (progn (setq decipher-char ?\s - decipher--loop-prev-char ?\ ) + decipher--loop-prev-char ?\s) (funcall func))))))) (defun decipher-loop-no-breaks (func) @@ -806,8 +792,8 @@ TOTAL is the total number of letters in the ciphertext." (while temp-list (insert (caar temp-list) (format "%4d%3d%% " - (cadar temp-list) - (/ (* 100 (cadar temp-list)) total))) + (cl-cadar temp-list) + (floor (* 100.0 (cl-cadar temp-list)) total))) (setq temp-list (nthcdr 4 temp-list))) (insert ?\n) (setq freq-list (cdr freq-list) @@ -839,18 +825,18 @@ TOTAL is the total number of letters in the ciphertext." ;; A vector of 26 integers, counting the number of occurrences ;; of the corresponding characters. (setq decipher--digram (format "%c%c" decipher--prev-char decipher-char)) - (incf (cdr (or (assoc decipher--digram decipher--digram-list) + (cl-incf (cdr (or (assoc decipher--digram decipher--digram-list) (car (push (cons decipher--digram 0) decipher--digram-list))))) (and (>= decipher--prev-char ?A) - (incf (aref (aref decipher--before (- decipher--prev-char ?A)) - (if (equal decipher-char ?\ ) + (cl-incf (aref (aref decipher--before (- decipher--prev-char ?A)) + (if (equal decipher-char ?\s) 26 (- decipher-char ?A))))) (and (>= decipher-char ?A) - (incf (aref decipher--freqs (- decipher-char ?A))) - (incf (aref (aref decipher--after (- decipher-char ?A)) - (if (equal decipher--prev-char ?\ ) + (cl-incf (aref decipher--freqs (- decipher-char ?A))) + (cl-incf (aref (aref decipher--after (- decipher-char ?A)) + (if (equal decipher--prev-char ?\s) 26 (- decipher--prev-char ?A))))) (setq decipher--prev-char decipher-char)) @@ -860,8 +846,8 @@ TOTAL is the total number of letters in the ciphertext." (let ((total 0)) (concat (mapconcat (lambda (x) - (cond ((> x 99) (incf total) "XX") - ((> x 0) (incf total) (format "%2d" x)) + (cond ((> x 99) (cl-incf total) "XX") + ((> x 0) (cl-incf total) (format "%2d" x)) (t " "))) counts "") @@ -874,16 +860,16 @@ TOTAL is the total number of letters in the ciphertext." ;; We do not include spaces (word divisions) in this count. (let ((total 0) (i 26)) - (while (>= (decf i) 0) + (while (>= (cl-decf i) 0) (if (or (> (aref before-count i) 0) (> (aref after-count i) 0)) - (incf total))) + (cl-incf total))) total)) (defun decipher-analyze-buffer () "Perform frequency analysis and store results in statistics buffer. Creates the statistics buffer if it doesn't exist." - (let ((decipher--prev-char (if decipher-ignore-spaces ?\ ?\*)) + (let ((decipher--prev-char (if decipher-ignore-spaces ?\s ?\*)) (decipher--before (make-vector 26 nil)) (decipher--after (make-vector 26 nil)) (decipher--freqs (make-vector 26 0)) @@ -891,7 +877,7 @@ Creates the statistics buffer if it doesn't exist." decipher--digram decipher--digram-list freq-list) (message "Scanning buffer...") (let ((i 26)) - (while (>= (decf i) 0) + (while (>= (cl-decf i) 0) (aset decipher--before i (make-vector 27 0)) (aset decipher--after i (make-vector 27 0)))) (if decipher-ignore-spaces @@ -899,7 +885,7 @@ Creates the statistics buffer if it doesn't exist." (decipher-loop-no-breaks 'decipher--analyze) ;; The first character of ciphertext was marked as following a space: (let ((i 26)) - (while (>= (decf i) 0) + (while (>= (cl-decf i) 0) (aset (aref decipher--after i) 26 0)))) (decipher-loop-with-breaks 'decipher--analyze)) (message "Processing results...") @@ -914,7 +900,7 @@ Creates the statistics buffer if it doesn't exist." ;; of times it occurs, and DIFFERENT is the number of different ;; letters it appears next to. (let ((i 26)) - (while (>= (decf i) 0) + (while (>= (cl-decf i) 0) (setq freq-list (cons (list (+ i ?A) (aref decipher--freqs i) @@ -934,7 +920,7 @@ Creates the statistics buffer if it doesn't exist." (insert ?\n) ;; Display frequency counts for letters in order of frequency: (setq freq-list (sort freq-list - (lambda (a b) (> (second a) (second b))))) + (lambda (a b) (> (cl-second a) (cl-second b))))) (decipher-insert-frequency-counts freq-list total-chars) ;; Display letters in order of frequency: (insert ?\n (mapconcat (lambda (a) (char-to-string (car a))) @@ -958,11 +944,11 @@ Creates the statistics buffer if it doesn't exist." ;; Display adjacency list for each letter, sorted in descending ;; order of the number of adjacent letters: (setq freq-list (sort freq-list - (lambda (a b) (> (third a) (third b))))) + (lambda (a b) (> (cl-third a) (cl-third b))))) (let ((temp-list freq-list) entry i) (while (setq entry (pop temp-list)) - (if (equal 0 (second entry)) + (if (equal 0 (cl-second entry)) nil ;This letter was not used (setq i (- (car entry) ?A)) (insert ?\n " " @@ -970,8 +956,8 @@ Creates the statistics buffer if it doesn't exist." (car entry) ": A B C D E F G H I J K L M N O P Q R S T U V W X Y Z *" (format "%4d %4d %3d%%\n " - (third entry) (second entry) - (/ (* 100 (second entry)) total-chars)) + (cl-third entry) (cl-second entry) + (floor (* 100.0 (cl-second entry)) total-chars)) (decipher--digram-counts (aref decipher--after i)) ?\n)))) (setq buffer-read-only t) (set-buffer-modified-p nil) @@ -1057,7 +1043,7 @@ if it can't, it signals an error." ;; (setq undo-rec (list undo-rec))) ;; (insert ?\() ;; (while (setq undo-map (pop undo-rec)) -;; (insert (cdr undo-map) (car undo-map) ?\ )) +;; (insert (cdr undo-map) (car undo-map) ?\s)) ;; (delete-char -1) ;; (insert ")\n"))))))