Anonymous avatar Anonymous committed c8e0ac1

Created

Comments (0)

Files changed (17)

+1998-01-11  SL Baur  <steve@altair.xemacs.org>
+
+	* Makefile: Update to newer package interface.
+
+1997-01-06  SL Baur  <steve@altair.xemacs.org>
+
+	* tetris.el: removed.
+
+1997-01-05  SL Baur  <steve@altair.xemacs.org>
+
+	* tetris.el: fixes an error when x-find-smaller-font returns nil.
+	From Glynn Clements <glynn@sensei.co.uk>
+
+1997-12-24  SL Baur  <steve@altair.xemacs.org>
+
+	* Makefile: Created.
+
+# Makefile for XEmacs Games and diversions lisp code
+
+# This file is part of XEmacs.
+
+# XEmacs is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by the
+# Free Software Foundation; either version 2, or (at your option) any
+# later version.
+
+# XEmacs is distributed in the hope that it will be useful, but WITHOUT
+# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+# FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+# for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with XEmacs; see the file COPYING.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+# Boston, MA 02111-1307, USA.
+
+# This XEmacs package contains independent single file lisp packages
+
+VERSION = 1.04
+PACKAGE = misc-games
+PKG_TYPE = single-file
+REQUIRES = xemacs-base
+CATEGORY = games
+
+ELCS = NeXTify.elc advocacy.elc blackbox.elc conx.elc decipher.elc \
+	dissociate.elc doctor.elc dunnet.elc flame.elc gomoku.elc \
+	hanoi.elc life.elc mpuz.elc studly.elc
+
+include ../../XEmacs.rules
+
+all:: $(ELCS) auto-autoloads.elc
+
+srckit: srckit-std
+
+binkit: binkit-sourceonly
+;;; NeXTify.el --- Character insertion variation
+
+;; Copyright status unknown
+
+;; Author: Jamie Zawinski <jwz@netscape.com>
+;; Keywords: games
+
+;; This file is part of XEmacs.
+
+;; XEmacs is free software; you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; XEmacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with XEmacs; see the file COPYING.  If not, write to the Free
+;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+;; 02111-1307, USA.
+
+;;; Synched up with: Not in FSF
+
+;;; Commentary:
+
+;;; Code:
+
+(defun SeLF-insert-command (arg)
+  "Insert the character you TyPE.
+Whichever character you TyPE to run ThIS command is inserted."
+  (interactive "p")
+  (let ((p (point))
+	(case-fold-search nil))
+    (self-insert-command arg)
+    (save-excursion
+      (goto-char p)
+      (skip-chars-backward " \t\r\n")
+      (if (condition-case () (forward-char -4) (error t))
+	  nil
+	(if (looking-at "\\<[A-Za-z][a-z][a-z][a-z][^A-Za-z]")
+	    (progn
+	      (insert (upcase (following-char))) (delete-char 1)
+	      (forward-char 1)
+	      (insert (upcase (following-char))) (delete-char 1)
+	      (insert (upcase (following-char))) (delete-char 1)))))))
+
+(define-key text-mode-map " " 'SeLF-insert-command)
+(define-key text-mode-map "," 'SeLF-insert-command)
+(define-key text-mode-map "." 'SeLF-insert-command)
+(define-key text-mode-map "!" 'SeLF-insert-command)
+(define-key text-mode-map "-" 'SeLF-insert-command)
+(define-key text-mode-map "_" 'SeLF-insert-command)
+(define-key text-mode-map ";" 'SeLF-insert-command)
+(define-key text-mode-map ":" 'SeLF-insert-command)
+
+;;; NeXTify.el ends here
+;;; advocacy.el -- blatant XEmacs self promotion
+;; Copyright (C) 1996, 1997 Free Software Foundation, Inc.
+;; Copyright (C) 1996 Chuck Thompson <cthomp@xemacs.org>
+
+;; Original Author:  Steve L Baur <steve@altair.xemacs.org>
+
+;; This file is part of XEmacs.
+
+;; XEmacs is free software; you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; XEmacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with XEmacs; see the file COPYING.  If not, write to the 
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;;###autoload
+(defvar xemacs-praise-sound-file "im_so_happy.au"
+  "The name of an audio file containing something to play
+when praising XEmacs")
+
+;;;###autoload
+(defvar xemacs-praise-message
+  "All Hail XEmacs!\n"
+  "What to praise XEmacs with")
+
+;;;###autoload
+(defun praise-be-unto-xemacs (&optional arg)
+  "All Hail XEmacs!"
+  (interactive "_p")
+  (save-window-excursion
+    (let ((count (if (null arg)
+		     0
+		   arg))
+ 	  (max-faces (length (face-list))))
+      (with-output-to-temp-buffer "*Praise*"
+	(set-buffer "*Praise*")
+        (if (glyphp xemacs-logo)
+            (let ((p (point)))
+              (insert "\n")
+              (indent-to (startup-center-spaces xemacs-logo))
+              (set-extent-begin-glyph (make-extent (point) (point)) xemacs-logo)
+              (insert "\n\n")))
+	(while (> count 0)
+	  (progn
+	    (insert-face xemacs-praise-message
+			 (get-face (nth (random max-faces) (face-list))))
+	    (setq count (- count 1))))))
+    (let ((sound-file
+	   (or (and (file-exists-p xemacs-praise-sound-file)
+		    xemacs-praise-sound-file)
+	       (and (file-exists-p
+		     (concat (locate-data-directory "sounds")
+			     xemacs-praise-sound-file))
+		    (concat (locate-data-directory "sounds")
+			    xemacs-praise-sound-file)))))
+      (if (and (device-sound-enabled-p) sound-file)
+	  (progn
+	    (sit-for 0)
+	    (play-sound-file sound-file))
+	(sit-for 10)))))
+
+;;;###autoload
+(defun praise-be-unto-emacs (&optional arg)
+  (interactive "_p")
+  (error "Obsolete function.  Use `praise-be-unto-xemacs'."))
+(make-compatible 'praise-be-unto-emacs "use praise-be-unto-xemacs")
+
+;;;###autoload
+(defun all-hail-xemacs (&optional arg)
+  "All Hail XEmacs!"
+  (interactive "_p")
+  (praise-be-unto-xemacs arg))
+
+;;;###autoload
+(defun all-hail-emacs (&optional arg)
+  (interactive "_p")
+  (error "Obsolete function.  Use `all-hail-xemacs'."))
+(make-compatible 'all-hail-emacs "use all-hail-xemacs")
+
+;;; advocacy.el ends here
+;;; blackbox.el --- blackbox game in Emacs Lisp
+
+;; Copyright (C) 1985, 1986, 1987, 1992 Free Software Foundation, Inc.
+
+;; Author: F. Thomas May <uw-nsr!uw-warp!tom@beaver.cs.washington.edu>
+;; Adapted-By: ESR
+;; Keywords: games
+
+;; This file is part of XEmacs.
+
+;; XEmacs is free software; you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; XEmacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with XEmacs; see the file COPYING.  If not, write to the Free
+;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+;; 02111-1307, USA.
+
+;;; Synched up with: FSF 19.34.
+
+;;; Commentary:
+
+;; by F. Thomas May <uw-nsr!uw-warp!tom@beaver.cs.washington.edu>
+;; doc comment by Root Boy Jim <rbj@dsys.icst.nbs.gov>, 27 Apr 89
+;; interface improvements by ESR, Dec 5 1991.
+
+;; The object of the game is to find four hidden balls by shooting rays
+;; into the black box.  There are four possibilities: 1) the ray will
+;; pass thru the box undisturbed, 2) it will hit a ball and be absorbed,
+;; 3) it will be deflected and exit the box, or 4) be deflected immediately,
+;; not even being allowed entry into the box.
+
+;; The strange part is the method of deflection.  It seems that rays will
+;; not pass next to a ball, and change direction at right angles to avoid it.
+;; 
+;; 		             R   3   
+;; 		 1 - - - - - - - - 1 
+;; 		   - - - - - - - -   
+;; 		   - O - - - - - - 3 
+;; 		 2 - - - - O - O -   
+;; 		 4 - - - - - - - - 
+;; 		 5 - - - - - - - - 5 
+;; 		   - - - - - - - - R 
+;; 		 H - - - - - - - O   
+;; 		   2   H 4       H   
+;; 
+;; Rays which enter and exit are numbered.  You can see that rays 1 & 5 pass
+;; thru the box undisturbed. Ray 2 is deflected by the northwesternmost
+;; ball.  Likewise rays 3 and 4. Rays which hit balls and are absorbed are
+;; marked with H.  The bottom of the left and the right of the bottom hit
+;; the southeastern ball directly.  Rays may also hit balls after being
+;; reflected. Consider the H on the bottom next to the 4.  It bounces off
+;; the NW-ern most ball and hits the central ball.  A ray shot from above
+;; the right side 5 would hit the SE-ern most ball.  The R beneath the 5
+;; is because the ball is returned instantly.  It is not allowed into
+;; the box if it would reflect immediately.  The R on the top is a more
+;; leisurely return.  Both central balls would tend to deflect it east
+;; or west, but it cannot go either way, so it just retreats.
+
+;; At the end of the game, if you've placed guesses for as many balls as
+;; there are in the box, the true board position will be revealed.  Each
+;; `x' is an incorrect guess of yours;; `o' is the true location of a ball.
+
+;;; Code:
+
+(defvar blackbox-mode-map nil "")
+
+(if blackbox-mode-map
+    ()
+  (setq blackbox-mode-map (make-keymap))
+  (suppress-keymap blackbox-mode-map t)
+  (define-key blackbox-mode-map "\C-f" 'bb-right)
+  (define-key blackbox-mode-map [right] 'bb-right)
+  (define-key blackbox-mode-map "\C-b" 'bb-left)
+  (define-key blackbox-mode-map [left] 'bb-left)
+  (define-key blackbox-mode-map "\C-p" 'bb-up)
+  (define-key blackbox-mode-map [up] 'bb-up)
+  (define-key blackbox-mode-map "\C-n" 'bb-down)
+  (define-key blackbox-mode-map [down] 'bb-down)
+  (define-key blackbox-mode-map "\C-e" 'bb-eol)
+  (define-key blackbox-mode-map "\C-a" 'bb-bol)
+  (define-key blackbox-mode-map " " 'bb-romp)
+  (define-key blackbox-mode-map [insert] 'bb-romp)
+  (define-key blackbox-mode-map "\C-m" 'bb-done)
+  (define-key blackbox-mode-map [kp-enter] 'bb-done))
+
+;; Blackbox mode is suitable only for specially formatted data.
+(put 'blackbox-mode 'mode-class 'special)
+
+(defvar bb-board)
+(defvar bb-balls-placed)
+(defvar bb-x)
+(defvar bb-y)
+(defvar bb-score)
+(defvar bb-detour-count)
+
+(defun blackbox-mode ()
+  "Major mode for playing blackbox.  To learn how to play blackbox,
+see the documentation for function `blackbox'.
+
+The usual mnemonic keys move the cursor around the box.
+\\<blackbox-mode-map>\\[bb-bol] and \\[bb-eol] move to the beginning and end of line, respectively.
+
+\\[bb-romp] -- send in a ray from point, or toggle a ball at point
+\\[bb-done] -- end game and get score
+"
+  (interactive)
+  (kill-all-local-variables)
+  (use-local-map blackbox-mode-map)
+  (setq truncate-lines t)
+  (setq major-mode 'blackbox-mode)
+  (setq mode-name "Blackbox"))
+
+;;;###autoload
+(defun blackbox (num)
+  "Play blackbox.  Optional prefix argument is the number of balls;
+the default is 4.
+
+What is blackbox?
+
+Blackbox is a game of hide and seek played on an 8 by 8 grid (the
+Blackbox).  Your opponent (Emacs, in this case) has hidden several
+balls (usually 4) within this box.  By shooting rays into the box and
+observing where they emerge it is possible to deduce the positions of
+the hidden balls.  The fewer rays you use to find the balls, the lower
+your score.
+
+Overview of play:
+
+\\<blackbox-mode-map>\
+To play blackbox, type \\[blackbox].  An optional prefix argument
+specifies the number of balls to be hidden in the box; the default is
+four.
+
+The cursor can be moved around the box with the standard cursor
+movement keys.
+
+To shoot a ray, move the cursor to the edge of the box and press SPC.
+The result will be determined and the playfield updated.
+
+You may place or remove balls in the box by moving the cursor into the
+box and pressing \\[bb-romp].
+
+When you think the configuration of balls you have placed is correct,
+press \\[bb-done].  You will be informed whether you are correct or
+not, and be given your score.  Your score is the number of letters and
+numbers around the outside of the box plus five for each incorrectly
+placed ball.  If you placed any balls incorrectly, they will be
+indicated with `x', and their actual positions indicated with `o'.
+
+Details:
+
+There are three possible outcomes for each ray you send into the box:
+
+	Detour: the ray is deflected and emerges somewhere other than
+		where you sent it in.  On the playfield, detours are
+		denoted by matching pairs of numbers -- one where the
+		ray went in, and the other where it came out.
+
+	Reflection: the ray is reflected and emerges in the same place
+		it was sent in.  On the playfield, reflections are
+		denoted by the letter `R'.
+
+	Hit:	the ray strikes a ball directly and is absorbed.  It does
+		not emerge from the box.  On the playfield, hits are
+		denoted by the letter `H'.
+
+The rules for how balls deflect rays are simple and are best shown by
+example.
+
+As a ray approaches a ball it is deflected ninety degrees.  Rays can
+be deflected multiple times.  In the diagrams below, the dashes
+represent empty box locations and the letter `O' represents a ball.
+The entrance and exit points of each ray are marked with numbers as
+described under \"Detour\" above.  Note that the entrance and exit
+points are always interchangeable.  `*' denotes the path taken by the
+ray.
+
+Note carefully the relative positions of the ball and the ninety
+degree deflection it causes.
+
+    1                                            
+  - * - - - - - -         - - - - - - - -         - - - - - - - -       
+  - * - - - - - -         - - - - - - - -         - - - - - - - -       
+1 * * - - - - - -         - - - - - - - -         - O - - - - O -       
+  - - O - - - - -         - - O - - - - -         - - * * * * - -
+  - - - - - - - -         - - - * * * * * 2     3 * * * - - * - -
+  - - - - - - - -         - - - * - - - -         - - - O - * - -      
+  - - - - - - - -         - - - * - - - -         - - - - * * - -       
+  - - - - - - - -         - - - * - - - -         - - - - * - O -       
+                                2                         3
+
+As mentioned above, a reflection occurs when a ray emerges from the same point
+it was sent in.  This can happen in several ways:
+
+                                                                           
+  - - - - - - - -         - - - - - - - -          - - - - - - - -
+  - - - - O - - -         - - O - O - - -          - - - - - - - -
+R * * * * - - - -         - - - * - - - -          O - - - - - - -
+  - - - - O - - -         - - - * - - - -        R - - - - - - - -
+  - - - - - - - -         - - - * - - - -          - - - - - - - -
+  - - - - - - - -         - - - * - - - -          - - - - - - - -
+  - - - - - - - -       R * * * * - - - -          - - - - - - - -
+  - - - - - - - -         - - - - O - - -          - - - - - - - -
+
+In the first example, the ray is deflected downwards by the upper
+ball, then left by the lower ball, and finally retraces its path to
+its point of origin.  The second example is similar.  The third
+example is a bit anomalous but can be rationalized by realizing the
+ray never gets a chance to get into the box.  Alternatively, the ray
+can be thought of as being deflected downwards and immediately
+emerging from the box.
+
+A hit occurs when a ray runs straight into a ball:
+
+  - - - - - - - -         - - - - - - - -          - - - - - - - -
+  - - - - - - - -         - - - - - - - -          - - - - O - - -
+  - - - - - - - -         - - - - O - - -        H * * * * - - - -
+  - - - - - - - -       H * * * * O - - -          - - - * - - - -
+  - - - - - - - -         - - - - O - - -          - - - O - - - -
+H * * * O - - - -         - - - - - - - -          - - - - - - - -
+  - - - - - - - -         - - - - - - - -          - - - - - - - -
+  - - - - - - - -         - - - - - - - -          - - - - - - - -
+
+Be sure to compare the second example of a hit with the first example of
+a reflection."
+  (interactive "P")
+  (switch-to-buffer "*Blackbox*")
+  (blackbox-mode)
+  (setq buffer-read-only t)
+  (buffer-disable-undo (current-buffer))
+  ;; XEmacs makes some local variables here and FSF doesn't.
+  (make-local-variable 'bb-board)
+  (setq bb-board (bb-init-board (or num 4)))
+  (make-local-variable 'bb-balls-placed)
+  (setq bb-balls-placed nil)
+  (make-local-variable 'bb-x)
+  (setq bb-x -1)
+  (make-local-variable 'bb-y)
+  (setq bb-y -1)
+  (make-local-variable 'bb-score)
+  (setq bb-score 0)
+  (make-local-variable 'bb-detour-count)
+  (setq bb-detour-count 0)
+  (bb-insert-board)
+  (bb-goto (cons bb-x bb-y)))
+
+(defun bb-init-board (num-balls)
+  (random t)
+  (let (board pos)
+    (while (>= (setq num-balls (1- num-balls)) 0)
+      (while
+	  (progn
+	    (setq pos (cons (random 8) (random 8)))
+	    (bb-member pos board)))
+      (setq board (cons pos board)))
+    board))
+
+(defun bb-insert-board ()
+  (let (i (buffer-read-only nil))
+    (erase-buffer)
+    (insert "                     \n")
+    (setq i 8)
+    (while (>= (setq i (1- i)) 0)
+      (insert "   - - - - - - - -   \n"))
+    (insert "                     \n")
+    (insert (format "\nThere are %d balls in the box" (length bb-board)))
+    ))
+
+(defun bb-right ()
+  (interactive)
+  (if (= bb-x 8)
+      ()
+    (forward-char 2)
+    (setq bb-x (1+ bb-x))))
+
+(defun bb-left ()
+  (interactive)
+  (if (= bb-x -1)
+      ()
+    (backward-char 2)
+    (setq bb-x (1- bb-x))))
+
+(defun bb-up ()
+  (interactive)
+  (if (= bb-y -1)
+      ()
+    (previous-line 1)
+    (setq bb-y (1- bb-y))))
+
+(defun bb-down ()
+  (interactive)
+  (if (= bb-y 8)
+      ()
+    (next-line 1)
+    (setq bb-y (1+ bb-y))))
+
+(defun bb-eol ()
+  (interactive)
+  (setq bb-x 8)
+  (bb-goto (cons bb-x bb-y)))
+
+(defun bb-bol ()
+  (interactive)
+  (setq bb-x -1)
+  (bb-goto (cons bb-x bb-y)))
+
+(defun bb-romp ()
+  (interactive)
+  (cond
+   ((and
+     (or (= bb-x -1) (= bb-x 8))
+     (or (= bb-y -1) (= bb-y 8))))
+   ((bb-outside-box bb-x bb-y)
+    (bb-trace-ray bb-x bb-y))
+   (t
+    (bb-place-ball bb-x bb-y))))
+
+(defun bb-place-ball (x y)
+  (let ((coord (cons x y)))
+    (cond
+     ((bb-member coord bb-balls-placed)
+      (setq bb-balls-placed (bb-delete coord bb-balls-placed))
+      (bb-update-board "-"))
+     (t
+      (setq bb-balls-placed (cons coord bb-balls-placed))
+      (bb-update-board "O")))))
+
+(defun bb-trace-ray (x y)
+  (let ((result (bb-trace-ray-2
+		 t
+		 x
+		 (cond
+		  ((= x -1) 1)
+		  ((= x 8) -1)
+		  (t 0))
+		 y
+		 (cond
+		  ((= y -1) 1)
+		  ((= y 8) -1)
+		  (t 0)))))
+    (cond
+     ((eq result 'hit)
+      (bb-update-board "H")
+      (setq bb-score (1+ bb-score)))
+     ((equal result (cons x y))
+      (bb-update-board "R")
+      (setq bb-score (1+ bb-score)))
+     (t
+      (setq bb-detour-count (1+ bb-detour-count))
+      (bb-update-board (format "%d" bb-detour-count))
+      (save-excursion
+	(bb-goto result)
+	(bb-update-board (format "%d" bb-detour-count)))
+      (setq bb-score (+ bb-score 2))))))
+
+(defun bb-trace-ray-2 (first x dx y dy)
+  (cond
+   ((and (not first)
+	 (bb-outside-box x y))
+    (cons x y))
+   ((bb-member (cons (+ x dx) (+ y dy)) bb-board)
+    'hit)
+   ((bb-member (cons (+ x dx dy) (+ y dy dx)) bb-board)
+    (bb-trace-ray-2 nil x (- dy) y (- dx)))
+   ((bb-member (cons (+ x dx (- dy)) (+ y dy (- dx))) bb-board)
+    (bb-trace-ray-2 nil x dy y dx))
+   (t
+    (bb-trace-ray-2 nil (+ x dx) dx (+ y dy) dy))))
+
+(defun bb-done ()
+  "Finish the game and report score."
+  (interactive)
+  (let (bogus-balls)
+    (cond
+     ((not (= (length bb-balls-placed) (length bb-board)))
+      (message "There %s %d hidden ball%s; you have placed %d."
+	       (if (= (length bb-board) 1) "is" "are")
+	       (length bb-board)
+	       (if (= (length bb-board) 1) "" "s")
+	       (length bb-balls-placed)))
+     (t
+      (setq bogus-balls (bb-show-bogus-balls bb-balls-placed bb-board))
+      (if (= bogus-balls 0)
+	  (message "Right!  Your score is %d." bb-score)
+	(message "Oops!  You missed %d ball%s.  Your score is %d."
+		 bogus-balls
+		 (if (= bogus-balls 1) "" "s")
+		 (+ bb-score (* 5 bogus-balls))))
+      (bb-goto '(-1 . -1))))))
+
+(defun bb-show-bogus-balls (balls-placed board)
+  (bb-show-bogus-balls-2 balls-placed board "x")
+  (bb-show-bogus-balls-2 board balls-placed "o"))
+
+(defun bb-show-bogus-balls-2 (list-1 list-2 c)
+  (cond
+   ((null list-1)
+    0)
+   ((bb-member (car list-1) list-2)
+    (bb-show-bogus-balls-2 (cdr list-1) list-2 c))
+   (t
+    (bb-goto (car list-1))
+    (bb-update-board c)
+    (1+ (bb-show-bogus-balls-2 (cdr list-1) list-2 c)))))
+
+(defun bb-outside-box (x y)
+  (or (= x -1) (= x 8) (= y -1) (= y 8)))
+
+(defun bb-goto (pos)
+  (goto-char (+ (* (car pos) 2) (* (cdr pos) 22) 26)))
+
+(defun bb-update-board (c)
+  (let ((buffer-read-only nil))
+    (backward-char (1- (length c)))
+    (delete-char (length c))
+    (insert c)
+    (backward-char 1)))
+  
+(defun bb-member (elt list)
+  "Returns non-nil if ELT is an element of LIST."
+  (eval (cons 'or (mapcar (function (lambda (x) (equal x elt))) list))))
+
+(defun bb-delete (item list)
+  "Deletes ITEM from LIST and returns a copy."
+  (cond
+   ((equal item (car list)) (cdr list))
+   (t (cons (car list) (bb-delete item (cdr list))))))
+
+;;; blackbox.el ends here
+;;; conx.el --- Yet another dissociater
+
+;; Copyright status unknown
+
+;; Author: Jamie Zawinski <jwz@netscape.com>
+;; Keywords: games
+
+;; This file is part of XEmacs.
+
+;; XEmacs is free software; you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; XEmacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with XEmacs; see the file COPYING.  If not, write to the Free
+;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+;; 02111-1307, USA.
+
+;;; Synched up with: Not in FSF
+
+;;; Commentary:
+
+;;; conx.el: Yet Another Dissociator.
+;;; Original design by Skef Wholey <skef@cs.cmu.edu>;
+;;; ported to Emacs-Lisp by Jamie Zawinski <jwz@netscape.com>, 5-mar-91.
+;;; Run this compiled.  It will be an order of magnitude faster.
+;;;
+;;; Select a buffer with a lot of text in it.  Say M-x conx-buffer
+;;; or M-x conx-region.  Repeat on as many other bodies of text as
+;;; you like.
+;;;
+;;; M-x conx will use the word-frequency tree the above generated
+;;; to produce random sentences in a popped-up buffer.  It will pause
+;;; at the end of each paragraph for two seconds; type ^G to stop it.
+;;;
+;;; M-x conx-init will clear the data structures so you can start
+;;; over.  Note that if you run it twice consecutively on the same
+;;; body of text, word sequences in that buffer will be twice as
+;;; likely to be generated.
+;;;
+;;; Once you have sucked in a lot of text and like the kinds of
+;;; sentences conx is giving you, you can save the internal data
+;;; structures to a file with the M-x conx-save command.  Loading
+;;; this file with M-x conx-load will be a lot faster and easier
+;;; than re-absorbing all of the text files.  Beware that loading a
+;;; saved conx-file clears the conx database in memory.
+;;;
+;;; M-x conx-emit-c will write out C source code which, when compiled,
+;;; will produce a standalone program which generates sentences from
+;;; a copy of the database currently loaded.
+;;;
+;;; Ideas for future improvement:
+;;;
+;;;  o  It would be nice if we could load in more than one saved
+;;;     file at a time.
+;;;
+;;;  o  use it to collect statistics on newsgroup conversations by
+;;;     examining the tree for the most common words and phrases
+;;;
+;;;  o  when replying to mail, insert an X-CONX: header field which
+;;;     contains a sentence randomly generated from the body of the
+;;;     message being replied to.
+;;;
+;;;  o  It could stand to be faster...
+
+;;; Code:
+(defconst conx-version "1.6,  6-may-94.")
+
+(defvar conx-bounce 10) ; 1/x
+(defvar conx-hashtable-size 9923)  ; 9923 is prime
+(defconst conx-words-hashtable nil)
+(defconst conx-words-vector nil)
+(defconst conx-words-vector-fp 0)
+
+(defconst conx-last-word nil)
+p
+(defvar conx-files nil "FYI")
+
+(defun conx-init ()
+  "Forget the current word-frequency tree."
+  (interactive)
+  (if (and conx-words-hashtable
+	   (>= (length conx-words-hashtable) conx-hashtable-size))
+      (fillarray conx-words-hashtable 0)
+      (setq conx-words-hashtable (make-vector conx-hashtable-size 0)))
+  (if conx-words-vector
+      (fillarray conx-words-vector nil)
+      (setq conx-words-vector (make-vector 1000 nil))) ; this grows
+  (setq conx-words-vector-fp 0)
+  (setq conx-last-word nil
+	conx-files nil))
+
+(defun conx-rehash ()
+  ;; misnomer; this just grows the linear vector, growing the hash table
+  ;; is too hard.
+  (message "Rehashing...")
+  (let* ((L (length conx-words-vector))
+	 (v2 (make-vector (+ L L) nil)))
+    (while (< 0 L)
+      (aset v2 (1- L) (aref conx-words-vector (setq L (1- L)))))
+    (setq conx-words-vector v2)
+    )
+  (message "Rehashing...done"))
+
+(defmacro conx-count  (word) (list 'aref word 0))
+(defmacro conx-cap    (word) (list 'aref word 1))
+(defmacro conx-comma  (word) (list 'aref word 2))
+(defmacro conx-period (word) (list 'aref word 3))
+(defmacro conx-quem   (word) (list 'aref word 4))
+(defmacro conx-bang   (word) (list 'aref word 5))
+(defmacro conx-succ   (word) (list 'aref word 6))
+(defmacro conx-pred   (word) (list 'aref word 7))
+(defmacro conx-succ-c (word) (list 'aref word 8))
+(defmacro conx-pred-c (word) (list 'aref word 9))
+(defconst conx-length 10)
+
+(defmacro conx-make-word ()
+  '(copy-sequence '[1 0 0 0 0 0 nil nil 0 0]))
+
+(defmacro conx-setf (form val)  ; mind-numbingly simple
+  (setq form (macroexpand form (and (boundp 'byte-compile-macro-environment)
+				    byte-compile-macro-environment)))
+  (cond ((symbolp form) (list 'setq form val))
+	((eq (car form) 'aref) (cons 'aset (append (cdr form) (list val))))
+	((eq (car form) 'cdr) (list 'setcdr (nth 1 form) val))
+	((eq (car form) 'car) (list 'setcar (nth 1 form) val))
+	(t (error "can't setf %s" form))))
+
+(defmacro conx-push (thing list)
+  (list 'conx-setf list (list 'cons thing list)))
+
+(defconst conx-most-positive-fixnum (lsh -1 -1)
+  "The largest positive integer that can be represented in this emacs.")
+
+(defmacro conx-rand (n)
+  (list '% (list 'logand 'conx-most-positive-fixnum '(random)) n))
+
+(defmacro conx-relate-succ (word related)
+  (` (let ((vec (symbol-value (, word))))
+       (conx-setf (conx-succ-c vec) (1+ (conx-succ-c vec)))
+       (let ((rel (assq (, related) (conx-succ vec))))
+	 (if rel
+	     (setcdr rel (1+ (cdr rel)))
+	     (conx-push (cons (, related) 1) (conx-succ vec)))))))
+
+(defmacro conx-relate-pred (word related)
+  (` (let ((vec (symbol-value (, word))))
+       (conx-setf (conx-pred-c vec) (1+ (conx-pred-c vec)))
+       (let ((rel (assq (, related) (conx-pred vec))))
+	 (if rel
+	     (setcdr rel (1+ (cdr rel)))
+	     (conx-push (cons (, related) 1) (conx-pred vec)))))))
+
+(defmacro conx-add-word (word)
+  (` (let* ((word (, word))
+	    (fc (aref word 0)))
+       (setq word (intern (downcase word) conx-words-hashtable))
+       (let ((vec (and (boundp word) (symbol-value word))))
+	 (if vec
+	     (conx-setf (conx-count vec) (1+ (conx-count vec)))
+	   (if (= conx-words-vector-fp (length conx-words-vector))
+	       (conx-rehash))
+	   (set word (setq vec (conx-make-word)))
+	   (aset conx-words-vector conx-words-vector-fp word)
+	   (setq conx-words-vector-fp (1+ conx-words-vector-fp)))
+	 (or (< fc ?A) (> fc ?Z)
+	     (conx-setf (conx-cap vec) (1+ (conx-cap vec)))))
+       (if conx-last-word
+	   (progn
+	     (conx-relate-succ conx-last-word word)
+	     (conx-relate-pred word conx-last-word)))
+       (setq conx-last-word word))))
+
+(defmacro conx-punx (char)
+  (` (if conx-last-word
+	 (let ((char (, char))
+	       (vec (symbol-value conx-last-word)))
+	   (cond ((eq char ?\,)
+		  (conx-setf (conx-comma vec) (1+ (conx-comma vec))))
+		 ((or (eq char ?\.)
+		      (eq char ?\;))
+		  (conx-setf (conx-period vec) (1+ (conx-period vec)))
+		  (setq conx-last-word nil))
+		 ((eq char ?\?)
+		  (conx-setf (conx-quem vec) (1+ (conx-quem vec)))
+		  (setq conx-last-word nil))
+		 ((eq char ?\!)
+		  (conx-setf (conx-bang vec) (1+ (conx-bang vec)))
+		  (setq conx-last-word nil)))))))
+
+(defun conxify-internal ()
+  (let (p w)
+    (while (not (eobp))
+      (skip-chars-forward "^A-Za-z0-9'")
+      (while (memq (following-char) '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9 ?\'))
+	;; ignore words beginning with digits
+	(skip-chars-forward "A-Za-z0-9'")
+	(skip-chars-forward "^A-Za-z0-9'"))
+      (setq p (point))
+      (skip-chars-forward "A-Za-z0-9'")
+      (if (= ?\' (preceding-char)) (forward-char -1))
+      (if (eq p (point))
+	  nil
+	(setq w (buffer-substring p (point)))
+	(if (equal "nil" w)  ; hey, nil is totally magic, this doesn't work!
+	    nil
+	  (conx-add-word w)
+	  (setq n (1+ n))
+	  (skip-chars-forward " \t\n\r")
+	  (if (memq (setq p (following-char)) '(?\, ?\. ?\! ?\? ?\;))
+	      (conx-punx p)))))))
+
+;;;###autoload
+(defun conx-buffer ()
+  "Absorb the text in the current buffer into the tree."
+  (interactive)
+  (or conx-words-vector (conx-init))
+  (let ((i conx-words-vector-fp)
+	(n 0)
+	(pm (point-max)))
+    (save-excursion
+      (goto-char (point-min))
+      (save-restriction
+	(widen)
+	(while (< (setq p (point)) pm)
+	  (search-forward "\n\n" pm 0)
+	  (narrow-to-region p (point))
+	  (goto-char (prog1 p (setq p (point))))
+	  (conxify-internal)
+	  (widen)
+	  (message "%d%%..." (/ (* p 100) (point-max))))))
+    (if buffer-file-name
+	(setq conx-files (nconc conx-files (list buffer-file-name))))
+    (message "%s words, %d unique" n (- conx-words-vector-fp i))))
+
+;;;###autoload
+(defun conx-region (p m)
+  "Absorb the text in the current region into the tree."
+  (interactive "r")
+  (save-restriction
+    (widen)
+    (narrow-to-region p m)
+    (conx-buffer)))
+
+(defun conx-mail-buffer ()
+  "Conxify a buffer in /bin/mail format."
+  (interactive)
+  (save-excursion
+    (goto-char (point-min))
+    (skip-chars-forward "\n \t")
+    (let ((case-fold-search nil)
+	  (buffer-file-name nil)
+	  p p2 p3)
+      (or (looking-at "^From ") (error "not in /bin/mail format"))
+      (while (not (eobp))
+	(search-forward "\n\n" nil 0)
+	(setq p (point))
+	(search-forward "\nFrom " nil 0)
+	(setq p3 (setq p2 (point)))
+	;; don't count ".signature" sections.
+	(and (re-search-backward "\n--+\n" nil t)
+	     (< (count-lines (point) p2) 9)
+	     (setq p2 (point)))
+	(conx-region p (point))
+	(goto-char p3)))
+    (if buffer-file-name
+	(setq conx-files (nconc conx-files (list buffer-file-name))))
+    ))
+
+;;; output
+
+(defun conx-random-related (count list)
+  (let ((foll (if (= 0 count) 0 (conx-rand count)))
+	ans)
+    (while list
+      (if (<= foll (cdr (car list)))
+	  (setq ans (car (car list))
+		list nil)
+	  (setq foll (- foll (cdr (car list)))
+		list (cdr list))))
+    ans))
+
+(defun conx-random-succ (word)
+  (if (= 0 (conx-succ-c (symbol-value word)))
+      word
+      (let ((next (conx-random-related
+		    (conx-succ-c (symbol-value word))
+		    (conx-succ (symbol-value word)))))
+	(if (= 0 (conx-rand conx-bounce))
+	    (conx-random-succ
+	      (conx-random-related
+		(conx-pred-c (symbol-value next))
+		(conx-pred (symbol-value next))))
+	    next))))
+
+
+(defun conx-sentence ()
+  (or (> conx-words-vector-fp 0)
+      (error "no conx data is loaded; see `conx-buffer'."))
+  (let* ((word (aref conx-words-vector (conx-rand conx-words-vector-fp)))
+	 (first-p t)
+	 (p (point))
+	 vec punc str)
+    (while word
+      (setq punc (conx-rand (conx-count (setq vec (symbol-value word)))))
+      (if (or first-p
+	      ;; (< (conx-rand (conx-count vec)) (conx-cap vec))
+	      (= (conx-count vec) (conx-cap vec))
+	      )
+	  (progn
+	    (setq first-p nil)
+	    (setq str (symbol-name word))
+	    (insert (+ (- ?A ?a) (aref str 0)))
+	    (insert (substring str 1)))
+	  (insert (symbol-name word)))
+      (cond ((< punc (conx-comma vec))
+	     (insert ", "))
+	    ((< (setq punc (- punc (conx-comma vec))) (conx-period vec))
+	     (setq word nil)
+	     (if (= 0 (conx-rand 5))
+		 (if (= 0 (conx-rand 4))
+		     (insert ": ")
+		     (insert "; "))
+		 (insert ".  ")))
+	    ((< (setq punc (- punc (conx-period vec))) (conx-quem vec))
+	     (setq word nil)
+	     (insert "?  "))
+	    ((< (setq punc (- punc (conx-quem vec))) (conx-bang vec))
+	     (setq word nil)
+	     (insert "!  "))
+	    (t
+	     (insert " ")
+	     (if (= 0 (conx-succ-c vec)) (setq word nil))))
+      (if word
+	  (setq word (conx-random-succ word))))
+    (fill-region-as-paragraph (save-excursion
+				(goto-char p)
+				(beginning-of-line)
+				(point))
+			      (point))
+    (if (= (preceding-char) ?\n)
+	(if (= 0 (conx-rand 4))
+	    (insert "\n")
+	  (delete-char -1)
+	  (insert "  "))))
+  nil)
+
+;;;###autoload
+(defun conx ()
+  "Generate some random sentences in the *conx* buffer."
+  (interactive)
+  (display-buffer (set-buffer (get-buffer-create "*conx*")))
+  (select-window (get-buffer-window "*conx*"))
+  (message "type ^G to stop.")
+  (while t
+    (goto-char (point-max))
+    (sit-for (if (= (preceding-char) ?\n) 2 0))
+    (conx-sentence)))
+
+
+;;; GNUS interface; grab words from the current message.
+
+(defun conx-gnus-snarf ()
+  "For use as a gnus-select-article-hook."
+  (set-buffer gnus-article-buffer)
+  (save-excursion
+    (save-restriction
+      (widen)
+      (goto-char (point-min))
+      (search-forward "\n\n" nil t)
+      (conx-region (point) (point-max)))))
+
+;;(add-hook 'gnus-select-article-hook 'conx-gnus-snarf)
+
+(defun psychoanalyze-conx ()
+  "Mr. Random goes to the analyst."
+  (interactive)
+  (doctor)				; start the psychotherapy
+  (message "")
+  (switch-to-buffer "*doctor*")
+  (sit-for 0)
+  (while (not (input-pending-p))
+    (conx-sentence)
+    (if (= (random 2) 0)
+	(conx-sentence))
+    (sit-for 0)
+    (doctor-ret-or-read 1)))
+
+
+;;; Saving the database
+
+(defun conx-save (file)
+  "Save the current CONX database to a file for future retrieval.
+You can re-load this database with the \\[conx-load] command."
+  (interactive "FSave CONX corpus to file: ")
+  (save-excursion
+   (let (b)
+    (unwind-protect
+      (progn
+	(set-buffer (setq b (get-buffer-create "*conx-save-tmp*")))
+	(delete-region (point-min) (point-max))
+	(insert ";;; -*- Mode:Emacs-Lisp -*-\n")
+	(insert ";;; This is a CONX database file.  Load it with `conx-load'.\n")
+	(if conx-files
+	    (insert ";;; Corpus: " (mapconcat 'identity conx-files ", ") "\n"))
+	(insert ";;; Date: " (current-time-string) "\n\n")
+	;; The file format used here is such a cute hack that I'm going to
+	;; leave it as an excercise to the reader to figure it out.
+	(let ((p (point))
+	      (fill-column 78)
+	      (fill-prefix "\t")
+	      (i 0))
+	  (insert "(!! [\t")
+	  (while (< i conx-words-vector-fp)
+	    (prin1 (aref conx-words-vector i) (current-buffer))
+	    (insert " ")
+	    (setq i (1+ i)))
+	  (insert "])\n")
+	  (fill-region-as-paragraph p (point))
+	  (insert "\n"))
+	(mapatoms (function (lambda (sym)
+		    (if (not (boundp sym))
+			nil
+		      (insert "\(! ")
+		      (prin1 sym (current-buffer))
+		      (insert " ")
+		      (prin1 (symbol-value sym) (current-buffer))
+		      (insert "\)\n"))))
+		  conx-words-hashtable)
+	(goto-char (point-min))
+	(while (re-search-forward "\\bnil\\b" nil t)
+	  (replace-match "()"))
+	(set-visited-file-name file)
+	(save-buffer)))
+    (and b (kill-buffer b)))))
+
+;;;###autoload
+(defun conx-load (file)
+  "Load in a CONX database written by the \\[conx-save] command.
+This clears the database currently in memory."
+  (interactive "fLoad CONX corpus from file: ")
+  (conx-init)
+  (fset (intern "!!" conx-words-hashtable)
+	(function (lambda (vec)
+	  (setq conx-words-vector vec
+		conx-words-vector-fp (length vec)))))
+  (fset (intern "!" conx-words-hashtable)
+	(symbol-function 'setq))
+  (let ((obarray conx-words-hashtable))
+    (load file)))
+
+
+;;; Emitting C code
+
+(defun conx-emit-c-data (&optional ansi-p)
+  (let ((all '())
+	(standard-output (current-buffer))
+	(after-change-functions nil) ; turning off font-lock speeds it up x2
+	(before-change-functions nil)
+	(after-change-function nil)
+	(before-change-function nil)
+	(float-output-format "%.2f")
+	count total total100)
+    (or conx-words-hashtable (error "no words"))
+    (let ((i 0))
+      (mapatoms (function (lambda (x)
+			    (if (boundp x)
+				(setq all (cons (cons i x) all)
+				      i (1+ i)))))
+		conx-words-hashtable))
+    (setq all (nreverse all))
+    (setq total (* 4 (length all))
+	  total100 (max 1 (if (featurep 'lisp-float-type)
+			      (/ (float total) 100)
+			    (/ total 100)))
+	  count 0)
+    (let ((rest all)
+	  (i 5)
+	  rest2
+	  word)
+      (insert "static unsigned short D[] = {")
+      (while rest
+	(setq word (symbol-value (cdr (car rest))))
+	(setq rest2 (conx-pred word))
+	(setq count (1+ count))
+	(while rest2
+	  (princ (cdr (car rest2))) (insert ",")
+	  (princ (car (rassq (car (car rest2)) all)))
+	  (insert ",")
+	  (setq i (1+ i))
+	  (cond ((> i 10)
+		 (insert "\n")
+		 (setq i 0)))
+	  (setq rest2 (cdr rest2)))
+	(message "Writing C code... %s%%" (/ count total100))
+	(setq count (1+ count))
+	(setq rest2 (conx-succ word))
+	(while rest2
+	  (princ (cdr (car rest2)))
+	  (insert ",")
+	  (princ (car (rassq (car (car rest2)) all)))
+	  (insert ",")
+	  (setq i (1+ i))
+	  (cond ((> i 10)
+		 (insert "\n")
+		 (setq i 0)))
+	  (setq rest2 (cdr rest2)))
+	(message "Writing C code... %s%%" (/ count total100))
+	(setq count (1+ count))
+	(setq rest (cdr rest))))
+    (insert "0};\nstatic char T[] = \"")
+    (let ((rest all)
+	  (i 0) (j 20)
+	  k word)
+      (while rest
+	(setq word (symbol-name (cdr (car rest))))
+	(setq k (1+ (length word))
+	      i (+ i k)
+	      j (+ j k 3))
+	(cond ((> j 77)
+	       (insert (if ansi-p "\"\n\"" "\\\n"))
+	       (setq j (+ k 3))))
+	(insert word)		; assumes word has no chars needing backslashes
+	(insert "\\000")
+	(message "Writing C code... %s%%" (/ count total100))
+	(setq count (1+ count))
+	(setq rest (cdr rest))))
+    (insert "\";\nstatic struct conx_word words [] = {")
+    (let ((rest all)
+	  (i 0) (j 0)
+	  cons name word)
+      (while rest
+	(setq cons (car rest)
+	      name (symbol-name (cdr cons))
+	      word (symbol-value (cdr cons)))
+	(insert "{") (princ (conx-count word))
+	(insert ",") (princ (conx-cap word))
+	(insert ",") (princ (conx-comma word))
+	(insert ",") (princ (conx-period word))
+	(insert ",") (princ (conx-quem word))
+	(insert ",") (princ (conx-bang word))
+	(if (null (conx-pred word))
+	    (insert ",0")
+	  (insert ",")
+	  (princ i)
+	  (setq i (+ i (* 2 (length (conx-pred word))))))
+	(if (null (conx-succ word))
+	    (insert ",0,")
+	  (insert ",")
+	  (princ i)
+	  (insert ",")
+	  (setq i (+ i (* 2 (length (conx-succ word))))))
+	(princ (conx-pred-c word)) (insert ",")
+	(princ (conx-succ-c word)) (insert ",")
+	(princ j)
+	(setq j (+ j (length name) 1))
+	(insert (if (cdr rest) (if (= 0 (% (car cons) 2)) "},\n" "},") "}"))
+	(message "Writing C code... %s%%" (/ count total100))
+	(setq count (1+ count))
+	(setq rest (cdr rest))
+	))
+    (insert "};\n#define conx_bounce ")
+    (princ conx-bounce)
+    (insert "\n")
+    (message "Writing C code... done.")
+    ))
+
+(defvar conx-c-prolog "\
+#if __STDC__
+#include <stddef.h>
+#include <unistd.h>
+extern long random (void);
+extern void srandom (int);
+extern void abort (void);
+#endif
+#include <stdio.h>
+#include <time.h>
+
+struct conx_word {
+  unsigned short count;
+  unsigned short cap;
+  unsigned short comma;
+  unsigned short period;
+  unsigned short quem;
+  unsigned short bang;
+  unsigned short pred;
+  unsigned short succ;
+  unsigned short npred;
+  unsigned short nsucc;
+  unsigned short text;
+};
+")
+
+(defvar conx-c-code "\
+#define countof(x) (sizeof((x)) / sizeof(*(x)))
+#define conx_rand(n) (random()%(n))
+
+static struct conx_word *
+conx_random_related (count, which_list)
+     unsigned short count, which_list;
+{
+  unsigned short *list = D + which_list;
+  int i = 0;
+  unsigned short foll = (count == 0 ? 0 : conx_rand (count));
+  while (1)
+    {
+      if (foll <= list [i * 2])
+	{
+	  if ((list [i * 2 + 1]) > countof (words))
+	    abort ();
+	  return &words [list [i * 2 + 1]];
+	}
+      foll -= list [i * 2];
+      i++;
+    }
+}
+
+static struct conx_word *
+conx_random_succ (word)
+     struct conx_word *word;
+{
+  if (word->nsucc == 0)
+    return word;
+  else
+    {
+      struct conx_word *next = conx_random_related (word->nsucc, word->succ);
+      if (conx_rand (conx_bounce) != 0)
+	return next;
+      return conx_random_succ (conx_random_related (next->npred, next->pred));
+    }
+}
+
+static void
+conx_sentence ()
+{
+  static int x = 0;
+  struct conx_word *word = 0;
+  int first_p = 1;
+  int done = 0;
+  int count = 0;
+  while (!done)
+    {
+      int punc;
+      char *text;
+      int L;
+      if (word)
+	word = conx_random_succ (word);
+      else
+	word = &words [conx_rand (countof (words))];
+      count++;
+      punc = conx_rand (word->count);
+      text = T + word->text;
+      L = strlen (text);
+      if (x + L > 70)
+	{
+	  putchar ('\\n');
+	  x = 0;
+	}
+      x += L+1;
+
+      if (first_p || (word->count == word->cap))
+	{
+	  putchar ((*text >= 'a' && *text <= 'z') ? *text + ('A'-'a') : *text);
+	  fputs (text+1, stdout);
+	  first_p = 0;
+	}
+      else
+	fputs (text, stdout);
+
+      if (punc < word->comma)
+	{
+	  fputs (\", \", stdout);
+	  x++;
+	}
+      else if ((punc -= word->comma) < word->period)
+	{
+	  x++;
+	  if (count > 120 || conx_rand (5) != 0)
+	    {
+	      done = 1;
+	      fputs (\".  \", stdout);
+	      x++;
+	    }
+	  else
+	    {
+	      word = 0;
+	      if (conx_rand (4) == 0)
+		fputs (\": \", stdout);
+	      else
+		fputs (\"; \", stdout);
+	    }
+	}
+      else if ((punc -= word->period) < word->quem)
+	{
+	  done = 1;
+	  fputs (\"?  \", stdout);
+	  x += 2;
+	}
+      else if ((punc -= word->quem) < word->bang)
+	{
+	  done = 1;
+	  fputs (\"!  \", stdout);
+	  x += 2;
+	}
+      else
+	{
+	  if (word->nsucc == 0)
+	    {
+	      fputs (\".  \", stdout);
+	      x += 2;
+	      done = 1;
+	    }
+	  else
+	    putchar (' ');
+	}
+    }
+  if (conx_rand (3) == 0)
+    {
+      fputs (\"\\n\\n\", stdout);
+      x = 0;
+    }
+}
+
+main (argc, argv)
+     int argc;
+     char **argv;
+{
+  unsigned int howmany, delay;
+  char dummy;
+  if (argc == 1)
+    {
+      howmany = 1;
+      delay = 0;
+    }
+  else if (argc == 2 &&
+      1 == sscanf (argv[1], \"%ud%c\", &howmany, &dummy))
+    delay = 0;
+  else if (argc == 3 &&
+	   1 == sscanf (argv[1], \"%ud%c\", &howmany, &dummy) &&
+	   1 == sscanf (argv[2], \"%ud%c\", &delay, &dummy))
+    ;
+  else
+    {
+      fprintf (stderr, \"usage: %s [count [delay]]\\n\", argv [0]);
+      exit (1);
+    }
+
+  srandom (time (0));
+  if (howmany == 0)
+    howmany = ~0;
+  while (howmany > 0)
+    {
+      conx_sentence ();
+      fflush (stdout);
+      howmany--;
+      if (delay) sleep (delay);
+    }
+  putchar ('\\n');
+  exit (0);
+}
+")
+
+(defun conx-emit-c (file &optional non-ansi-p)
+  "Write the current CONX database to a file as C source code.
+The generated program will have the same effect as M-x conx,
+except that it runs without emacs.
+
+With a prefix argument, write K&R C instead of ANSI C.  ANSI is
+the default because, without a certain ANSI feature, large databases
+will overflow static limits in most K&R preprocessors."
+  (interactive "FWrite C file: \nP")
+  (find-file file)
+  (erase-buffer)
+  (let ((buffer-undo-list t))
+    (insert conx-c-prolog)
+    (if (not non-ansi-p)
+	(insert "\n#if !__STDC__\n"
+		"error! this file requires an ANSI C compiler\n"
+		"#endif\n\n"))
+    (conx-emit-c-data (not non-ansi-p))
+    (insert conx-c-code))
+  (goto-char (point-min)))
+
+
+;;; Reporting stats
+
+(defun conx-stats ()
+  (set-buffer (get-buffer-create "*conx-stats*"))
+  (delete-region (point-min) (point-max))
+  (mapatoms (function (lambda (x)
+	      (or (not (boundp x))
+		  (progn
+		    (insert (format "%s" (conx-count (symbol-value x))))
+		    (insert "\t\t")
+		    (insert (symbol-name x))
+		    (insert "\n")))))
+	    conx-words-hashtable)
+  (sort-numeric-fields -1 (point-min) (point-max)))
+
+;;; conx.el ends here
+;;; decipher.el --- Cryptanalyze monoalphabetic substitution ciphers
+;;
+;; Copyright (C) 1995, 1996 Free Software Foundation, Inc.
+;;
+;; Author: Christopher J. Madsen <ac608@yfn.ysu.edu>
+;; Keywords: games
+;;
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;;
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Quick Start:
+;;
+;; To decipher a message, type or load it into a buffer and type
+;; `M-x decipher'.  This will format the buffer and place it into
+;; Decipher mode.  You can save your work to a file with the normal
+;; Emacs save commands; when you reload the file it will automatically
+;; enter Decipher mode.
+;;
+;; I'm not going to discuss how to go about breaking a cipher; try
+;; your local library for a book on cryptanalysis.  One book you might
+;; find is:
+;;   Cryptanalysis:  A study of ciphers and their solution
+;;   Helen Fouche Gaines
+;;   ISBN 0-486-20097-3
+
+;;; Commentary:
+;;
+;; This package is designed to help you crack simple substitution
+;; ciphers where one letter stands for another.  It works for ciphers
+;; with or without word divisions.  (You must set the variable
+;; decipher-ignore-spaces for ciphers without word divisions.)
+;;
+;; First, some quick definitions:
+;;   ciphertext   The encrypted message (what you start with)
+;;   plaintext    The decrypted message (what you are trying to get)
+;;
+;; Decipher mode displays ciphertext in uppercase and plaintext in
+;; lowercase.  You must enter the plaintext in lowercase; uppercase
+;; letters are interpreted as commands.  The ciphertext may be entered
+;; in mixed case; `M-x decipher' will convert it to uppercase.
+;;
+;; Decipher mode depends on special characters in the first column of
+;; each line.  The command `M-x decipher' inserts these characters for
+;; you.  The characters and their meanings are:
+;;   (   The plaintext & ciphertext alphabets on the first line
+;;   )   The ciphertext & plaintext alphabets on the second line
+;;   :   A line of ciphertext (with plaintext below)
+;;   >   A line of plaintext  (with ciphertext above)
+;;   %   A comment
+;; Each line in the buffer MUST begin with one of these characters (or
+;; be left blank).  In addition, comments beginning with `%!' are reserved
+;; for checkpoints; see decipher-make-checkpoint & decipher-restore-checkpoint
+;; for more information.
+;;
+;; While the cipher message may contain digits or punctuation, Decipher
+;; mode will ignore these characters.
+;;
+;; The buffer is made read-only so it can't be modified by normal
+;; Emacs commands.
+;;
+;; Decipher supports Font Lock mode.  To use it, you can also add
+;;     (add-hook 'decipher-mode-hook 'turn-on-font-lock)
+;; See the variable `decipher-font-lock-keywords' if you want to customize
+;; the faces used.  I'd like to thank Simon Marshall for his help in making
+;; Decipher work well with Font Lock.
+
+;;; Things To Do:
+;;
+;; Email me if you have any suggestions or would like to help.
+;; But be aware that I work on Decipher only sporadically.
+;;
+;; 1. The consonant-line shortcut
+;; 2. More functions for analyzing ciphertext
+
+;;;===================================================================
+;;; Variables:
+;;;===================================================================
+
+(eval-when-compile
+  (require 'cl))
+
+(defvar decipher-force-uppercase t
+  "*Non-nil means to convert ciphertext to uppercase.
+Nil means the case of the ciphertext is preserved.
+This variable must be set before typing `\\[decipher]'.")
+
+(defvar decipher-ignore-spaces nil
+  "*Non-nil means to ignore spaces and punctuation when counting digrams.
+You should set this to `nil' if the cipher message is divided into words,
+or `t' if it is not.
+This variable is buffer-local.")
+(make-variable-buffer-local 'decipher-ignore-spaces)
+
+(defvar decipher-undo-limit 5000
+  "The maximum number of entries in the undo list.
+When the undo list exceeds this number, 100 entries are deleted from
+the tail of the list.")
+
+;; End of user modifiable variables
+;;--------------------------------------------------------------------
+
+(defvar decipher-font-lock-keywords
+  '(("^:.*"  . font-lock-keyword-face)
+    ("^>.*"  . font-lock-string-face)
+    ("^%!.*" . font-lock-reference-face)
+    ("^%.*"  . font-lock-comment-face)
+    ("\\`(\\([a-z]+\\) +\\([A-Z]+\\)"
+     (1 font-lock-string-face)
+     (2 font-lock-keyword-face))
+    ("^)\\([A-Z ]+\\)\\([a-z ]+\\)"
+     (1 font-lock-keyword-face)
+     (2 font-lock-string-face)))
+  "Expressions to fontify in Decipher mode.
+Ciphertext uses `font-lock-keyword-face', plaintext uses
+`font-lock-string-face', comments use `font-lock-comment-face', and
+checkpoints use `font-lock-reference-face'.  You can customize the
+display by changing these variables.  For best results, I recommend
+that all faces use the same background color.
+For example, to display ciphertext in the `bold' face, use
+  (add-hook 'decipher-mode-hook
+            (lambda () (set (make-local-variable 'font-lock-keyword-face)
+                            'bold)))
+in your `.emacs' file.")
+
+(defvar decipher-mode-map nil
+  "Keymap for Decipher mode.")
+(if (not decipher-mode-map)
+    (progn
+      (setq decipher-mode-map (make-keymap))
+      (suppress-keymap decipher-mode-map)
+      (define-key decipher-mode-map "A" 'decipher-show-alphabet)
+      (define-key decipher-mode-map "C" 'decipher-complete-alphabet)
+      (define-key decipher-mode-map "D" 'decipher-digram-list)
+      (define-key decipher-mode-map "F" 'decipher-frequency-count)
+      (define-key decipher-mode-map "M" 'decipher-make-checkpoint)
+      (define-key decipher-mode-map "N" 'decipher-adjacency-list)
+      (define-key decipher-mode-map "R" 'decipher-restore-checkpoint)
+      (define-key decipher-mode-map "U" 'decipher-undo)
+      (define-key decipher-mode-map " " 'decipher-keypress)
+      (substitute-key-definition 'undo  'decipher-undo
+                                 decipher-mode-map global-map)
+      (substitute-key-definition 'advertised-undo  'decipher-undo
+                                 decipher-mode-map global-map)
+      (let ((key ?a))
+        (while (<= key ?z)
+          (define-key decipher-mode-map (vector key) 'decipher-keypress)
+          (incf key)))))
+
+(defvar decipher-stats-mode-map nil
+  "Keymap for Decipher-Stats mode.")
+(if (not decipher-stats-mode-map)
+    (progn
+      (setq decipher-stats-mode-map (make-keymap))
+      (suppress-keymap decipher-stats-mode-map)
+      (define-key decipher-stats-mode-map "D" 'decipher-digram-list)
+      (define-key decipher-stats-mode-map "F" 'decipher-frequency-count)
+      (define-key decipher-stats-mode-map "N" 'decipher-adjacency-list)
+      ))
+
+(defvar decipher-mode-syntax-table nil
+  "Decipher mode syntax table")
+
+(if decipher-mode-syntax-table
+    ()
+  (let ((table (make-syntax-table))
+        (c ?0))
+    (while (<= c ?9)
+      (modify-syntax-entry c "_" table) ;Digits are not part of words
+      (incf c))
+    (setq decipher-mode-syntax-table table)))
+
+(defvar decipher-alphabet nil)
+;; This is an alist containing entries (PLAIN-CHAR . CIPHER-CHAR),
+;; where PLAIN-CHAR runs from ?a to ?z and CIPHER-CHAR is an uppercase
+;; letter or space (which means no mapping is known for that letter).
+;; This *must* contain entries for all lowercase characters.
+(make-variable-buffer-local 'decipher-alphabet)
+
+(defvar decipher-stats-buffer nil
+  "The buffer which displays statistics for this ciphertext.
+Do not access this variable directly, use the function
+`decipher-stats-buffer' instead.")
+(make-variable-buffer-local 'decipher-stats-buffer)
+
+(defvar decipher-undo-list-size 0
+  "The number of entries in the undo list.")
+(make-variable-buffer-local 'decipher-undo-list-size)
+
+(defvar decipher-undo-list nil
+  "The undo list for this buffer.
+Each element is either a cons cell (PLAIN-CHAR . CIPHER-CHAR) or a
+list of such cons cells.")
+(make-variable-buffer-local 'decipher-undo-list)
+
+(defvar decipher-pending-undo-list nil)
+
+;; The following variables are used by the analysis functions
+;; and are defined here to avoid byte-compiler warnings.
+;; Don't mess with them unless you know what you're doing.
+(defvar decipher-char nil
+  "See the functions decipher-loop-with-breaks and decipher-loop-no-breaks.")
+(defvar decipher--prev-char)
+(defvar decipher--digram)
+(defvar decipher--digram-list)
+(defvar decipher--before)
+(defvar decipher--after)
+(defvar decipher--freqs)
+
+;;;===================================================================
+;;; Code:
+;;;===================================================================
+;; Main entry points:
+;;--------------------------------------------------------------------
+
+;;;###autoload
+(defun decipher ()
+  "Format a buffer of ciphertext for cryptanalysis and enter Decipher mode."
+  (interactive)
+  ;; Make sure the buffer ends in a newline:
+  (goto-char (point-max))
+  (or (bolp)
+      (insert "\n"))
+  ;; See if it's already in decipher format:
+  (goto-char (point-min))
+  (if (looking-at "^(abcdefghijklmnopqrstuvwxyz   \
+ABCDEFGHIJKLMNOPQRSTUVWXYZ   -\\*-decipher-\\*-\n)")
+      (message "Buffer is already formatted, entering Decipher mode...")
+    ;; Add the alphabet at the beginning of the file
+    (insert "(abcdefghijklmnopqrstuvwxyz   \
+ABCDEFGHIJKLMNOPQRSTUVWXYZ   -*-decipher-*-\n)\n\n")
+    ;; Add lines for the solution:
+    (let (begin)
+      (while (not (eobp))
+        (if (looking-at "^%")
+            (forward-line)              ;Leave comments alone
+          (delete-horizontal-space)
+          (if (eolp)
+              (forward-line)            ;Just leave blank lines alone
+            (insert ":")                ;Mark ciphertext line
+            (setq begin (point))
+            (forward-line)
+            (if decipher-force-uppercase
+                (upcase-region begin (point))) ;Convert ciphertext to uppercase
+            (insert ">\n")))))          ;Mark plaintext line
+    (delete-blank-lines)                ;Remove any blank lines
+    (delete-blank-lines))               ; at end of buffer
+  (goto-line 4)
+  (decipher-mode))
+
+;;;###autoload
+(defun decipher-mode ()
+  "Major mode for decrypting monoalphabetic substitution ciphers.
+Lower-case letters enter plaintext.
+Upper-case letters are commands.
+
+The buffer is made read-only so that normal Emacs commands cannot
+modify it.
+
+The most useful commands are:
+\\<decipher-mode-map>
+\\[decipher-digram-list]  Display a list of all digrams & their frequency
+\\[decipher-frequency-count]  Display the frequency of each ciphertext letter
+\\[decipher-adjacency-list]\
+  Show adjacency list for current letter (lists letters appearing next to it)
+\\[decipher-make-checkpoint]  Save the current cipher alphabet (checkpoint)
+\\[decipher-restore-checkpoint]  Restore a saved cipher alphabet (checkpoint)"
+  (interactive)
+  (kill-all-local-variables)
+  (setq buffer-undo-list  t             ;Disable undo
+        indent-tabs-mode  nil           ;Do not use tab characters
+        major-mode       'decipher-mode
+        mode-name        "Decipher")
+  (if decipher-force-uppercase
+      (setq case-fold-search nil))      ;Case is significant when searching
+  (use-local-map decipher-mode-map)
+  (set-syntax-table decipher-mode-syntax-table)
+  (decipher-read-alphabet)
+  (set (make-local-variable 'font-lock-defaults)
+       '(decipher-font-lock-keywords t))
+  ;; Make the buffer writable when we exit Decipher mode:
+  (make-local-hook 'change-major-mode-hook)
+  (add-hook 'change-major-mode-hook
+            (lambda () (setq buffer-read-only nil
+                             buffer-undo-list nil))
+            nil t)
+  (run-hooks 'decipher-mode-hook)
+  (setq buffer-read-only t))
+(put 'decipher-mode 'mode-class 'special)
+
+;;--------------------------------------------------------------------
+;; Normal key handling:
+;;--------------------------------------------------------------------
+
+(defmacro decipher-last-command-char ()
+  ;; Return the char which ran this command (for compatibility with XEmacs)
+  (if (fboundp 'event-to-character)
+      '(event-to-character last-command-event)
+    'last-command-event))
+
+(defun decipher-keypress ()
+  "Enter a plaintext or ciphertext character."
+  (interactive)
+  (let ((decipher-function 'decipher-set-map)
+        buffer-read-only)               ;Make buffer writable
+    (save-excursion
+      (or (save-excursion
+            (beginning-of-line)
+            (let ((first-char (following-char)))
+              (cond
+               ((= ?: first-char)
+                t)
+               ((= ?> first-char)
+                nil)
+               ((= ?\( first-char)
+                (setq decipher-function 'decipher-alphabet-keypress)
+                t)
+               ((= ?\) first-char)
+                (setq decipher-function 'decipher-alphabet-keypress)
+                nil)
+               (t
+                (error "Bad location")))))
+          (let (goal-column)
+            (previous-line 1)))
+      (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
+            (funcall decipher-function char-a char-b)))))
+  (forward-char))
+
+(defun decipher-alphabet-keypress (a b)
+  ;; Handle keypresses in the alphabet lines.
+  ;; A is the character in the alphabet row (which starts with '(')
+  ;; B is the character pressed
+  (cond ((and (>= a ?A) (<= a ?Z))
+         ;; If A is uppercase, then it is in the ciphertext alphabet:
+         (decipher-set-map a b))
+        ((and (>= a ?a) (<= a ?z))
+         ;; If A is lowercase, then it is in the plaintext alphabet:
+         (if (= b ?\ )
+             ;; We are clearing the association (if any):
+             (if (/= ?\  (setq b (cdr (assoc a decipher-alphabet))))
+                 (decipher-set-map b ?\ ))
+           ;; Associate the plaintext char with the char pressed:
+           (decipher-set-map b a)))
+        (t
+         ;; If A is not a letter, that's a problem:
+         (error "Bad character"))))
+
+;;--------------------------------------------------------------------
+;; Undo:
+;;--------------------------------------------------------------------
+
+(defun decipher-undo ()
+  "Undo a change in Decipher mode."
+  (interactive)
+  ;; If we don't get all the way thru, make last-command indicate that
+  ;; for the following command.
+  (setq this-command t)
+  (or (eq major-mode 'decipher-mode)
+      (error "This buffer is not in Decipher mode"))
+  (or (eq last-command 'decipher-undo)
+      (setq decipher-pending-undo-list decipher-undo-list))
+  (or decipher-pending-undo-list
+      (error "No further undo information"))
+  (let ((undo-rec (pop decipher-pending-undo-list))
+        buffer-read-only                ;Make buffer writable
+        redo-map redo-rec undo-map)
+    (or (consp (car undo-rec))
+        (setq undo-rec (list undo-rec)))
+    (while (setq undo-map (pop undo-rec))
+      (setq redo-map (decipher-get-undo (cdr undo-map) (car undo-map)))
+      (if redo-map
+          (setq redo-rec
+                (if (consp (car redo-map))
+                    (append redo-map redo-rec)
+                  (cons redo-map redo-rec))))
+      (decipher-set-map (cdr undo-map) (car undo-map) t))
+    (decipher-add-undo redo-rec))
+  (setq this-command 'decipher-undo)
+  (message "Undo!"))
+
+(defun decipher-add-undo (undo-rec)
+  "Add UNDO-REC to the undo list."
+  (if undo-rec
+      (progn
+        (push undo-rec decipher-undo-list)
+        (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:
+              (setcdr (nthcdr (1- new-size) decipher-undo-list) nil)
+              (setq decipher-undo-list-size new-size))))))
+
+(defun decipher-get-undo (cipher-char plain-char)
+  ;; Return an undo record that will undo the result of
+  ;;   (decipher-set-map CIPHER-CHAR PLAIN-CHAR)
+  ;; We must use copy-list because the original cons cells will be
+  ;; modified using setcdr.
+  (let ((cipher-map (copy-list (rassoc cipher-char decipher-alphabet)))
+        (plain-map  (copy-list (assoc  plain-char  decipher-alphabet))))
+    (cond ((equal ?\  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)))
+          (cipher-map
+           (list plain-map cipher-map))
+          (t
+           plain-map))))
+
+;;--------------------------------------------------------------------
+;; Mapping ciphertext and plaintext:
+;;--------------------------------------------------------------------
+
+(defun decipher-set-map (cipher-char plain-char &optional no-undo)
+  ;; Associate a ciphertext letter with a plaintext letter
+  ;; CIPHER-CHAR must be an uppercase or lowercase letter
+  ;; PLAIN-CHAR must be a lowercase letter (or a space)
+  ;; NO-UNDO if non-nil means do not record undo information
+  ;; Any existing associations for CIPHER-CHAR or PLAIN-CHAR will be erased.
+  (setq cipher-char (upcase cipher-char))
+  (or (and (>= cipher-char ?A) (<= cipher-char ?Z))
+      (error "Bad character"))          ;Cipher char must be uppercase letter
+  (or no-undo
+      (decipher-add-undo (decipher-get-undo cipher-char plain-char)))
+  (let ((cipher-string (char-to-string cipher-char))
+        (plain-string  (char-to-string plain-char))
+        case-fold-search                ;Case is significant
+        mapping bound)
+    (save-excursion
+      (goto-char (point-min))
+      (if (setq mapping (rassoc cipher-char decipher-alphabet))
+          (progn
+            (setcdr mapping ?\ )
+            (search-forward-regexp (concat "^([a-z]*"
+                                           (char-to-string (car mapping))))
+            (decipher-insert ?\ )
+            (beginning-of-line)))
+      (if (setq mapping (assoc plain-char decipher-alphabet))
+          (progn
+            (if (/= ?\  (cdr mapping))
+                (decipher-set-map (cdr mapping) ?\  t))
+            (setcdr mapping cipher-char)
+            (search-forward-regexp (concat "^([a-z]*" plain-string))
+            (decipher-insert cipher-char)
+            (beginning-of-line)))
+      (search-forward-regexp (concat "^([a-z]+   [A-Z]*" cipher-string))
+      (decipher-insert plain-char)
+      (setq case-fold-search t          ;Case is not significant
+            cipher-string    (downcase cipher-string))
+      (let ((font-lock-fontify-region-function 'ignore))
+        ;; insert-and-inherit will pick the right face automatically
+        (while (search-forward-regexp "^:" nil t)
+          (setq bound (save-excursion (end-of-line) (point)))
+          (while (search-forward cipher-string bound 'end)
+            (decipher-insert plain-char)))))))
+
+(defun decipher-insert (char)
+  ;; Insert CHAR in the row below point.  It replaces any existing
+  ;; character in that position.
+  (let ((col (1- (current-column))))
+    (save-excursion
+      (forward-line)
+      (or (= ?\> (following-char))
+          (= ?\) (following-char))
+          (error "Bad location"))
+      (move-to-column col t)
+      (or (eolp)
+          (delete-char 1))
+      (insert-and-inherit char))))
+
+;;--------------------------------------------------------------------
+;; Checkpoints:
+;;--------------------------------------------------------------------
+;; A checkpoint is a comment of the form:
+;;   %!ABCDEFGHIJKLMNOPQRSTUVWXYZ! Description
+;; Such comments are usually placed at the end of the buffer following
+;; this header (which is inserted by decipher-make-checkpoint):
+;;   %---------------------------
+;;   % Checkpoints:
+;;   % abcdefghijklmnopqrstuvwxyz
+;; but this is not required; checkpoints can be placed anywhere.
+;;
+;; The description is optional; all that is required is the alphabet.
+
+(defun decipher-make-checkpoint (desc)
+  "Checkpoint the current cipher alphabet.
+This records the current alphabet so you can return to it later.
+You may have any number of checkpoints.
+Type `\\[decipher-restore-checkpoint]' to restore a checkpoint."
+  (interactive "sCheckpoint description: ")
+  (or (stringp desc)
+      (setq desc ""))
+  (let (alphabet
+        buffer-read-only                ;Make buffer writable
+        mapping)
+    (goto-char (point-min))
+    (re-search-forward "^)")
+    (move-to-column 27 t)
+    (setq alphabet (buffer-substring-no-properties (- (point) 26) (point)))
+    (if (re-search-forward "^%![A-Z ]+!" nil 'end)
+       nil ; Add new checkpoint with others
+      (if (re-search-backward "^% *Local Variables:" nil t)
+          ;; Add checkpoints before local variables list:
+          (progn (forward-line -1)
+                 (or (looking-at "^ *$")
+                     (progn (forward-line) (insert ?\n) (forward-line -1)))))
+      (insert "\n%" (make-string 69 ?\-)
+              "\n% Checkpoints:\n% abcdefghijklmnopqrstuvwxyz\n"))
+    (beginning-of-line)
+    (insert "%!" alphabet "! " desc ?\n)))
+
+(defun decipher-restore-checkpoint ()
+  "Restore the cipher alphabet from a checkpoint.
+If point is not on a checkpoint line, moves to the first checkpoint line.
+If point is on a checkpoint, restores that checkpoint.
+
+Type `\\[decipher-make-checkpoint]' to make a checkpoint."
+  (interactive)
+  (beginning-of-line)
+  (if (looking-at "%!\\([A-Z ]+\\)!")
+      ;; Restore this checkpoint:
+      (let ((alphabet (match-string 1))
+            buffer-read-only)           ;Make buffer writable
+        (goto-char (point-min))
+        (re-search-forward "^)")
+        (or (eolp)
+            (delete-region (point) (progn (end-of-line) (point))))
+        (insert alphabet)
+        (decipher-resync))
+    ;; Move to the first checkpoint:
+    (goto-char (point-min))
+    (if (re-search-forward "^%![A-Z ]+!" nil t)
+        (message "Select the checkpoint to restore and type `%s'"
+                 (substitute-command-keys "\\[decipher-restore-checkpoint]"))
+      (error "No checkpoints in this buffer"))))
+
+;;--------------------------------------------------------------------
+;; Miscellaneous commands:
+;;--------------------------------------------------------------------
+
+(defun decipher-complete-alphabet ()
+  "Complete the cipher alphabet.
+This fills any blanks in the cipher alphabet with the unused letters
+in alphabetical order.  Use this when you have a keyword cipher and
+you have determined the keyword."
+  (interactive)
+  (let ((cipher-char ?A)
+        (ptr decipher-alphabet)
+        buffer-read-only                ;Make buffer writable
+        plain-map undo-rec)
+    (while (setq plain-map (pop ptr))
+      (if (equal ?\  (cdr plain-map))
+          (progn
+            (while (rassoc cipher-char decipher-alphabet)
+              ;; Find the next unused letter
+              (incf cipher-char))
+            (push (cons ?\  cipher-char) undo-rec)
+            (decipher-set-map cipher-char (car plain-map) t))))
+    (decipher-add-undo undo-rec)))
+
+(defun decipher-show-alphabet ()
+  "Display the current cipher alphabet in the message line."
+  (interactive)
+  (message
+   (mapconcat (lambda (a)
+                (concat
+                 (char-to-string (car a))
+                 (char-to-string (cdr a))))
+              decipher-alphabet
+              "")))
+
+(defun decipher-resync ()
+  "Reprocess the buffer using the alphabet from the top.
+This regenerates all deciphered plaintext and clears the undo list.
+You should use this if you edit the ciphertext."
+  (interactive)
+  (message "Reprocessing buffer...")
+  (let (alphabet
+        buffer-read-only                ;Make buffer writable
+        mapping)
+    (save-excursion
+      (decipher-read-alphabet)
+      (setq alphabet decipher-alphabet)
+      (goto-char (point-min))
+      (and (re-search-forward "^).+" nil t)
+           (replace-match ")" nil nil))
+      (while (re-search-forward "^>.+" nil t)
+        (replace-match ">" nil nil))
+      (decipher-read-alphabet)
+      (while (setq mapping (pop alphabet))
+        (or (equal ?\  (cdr mapping))
+            (decipher-set-map (cdr mapping) (car mapping))))))
+  (setq decipher-undo-list       nil
+        decipher-undo-list-size  0)
+  (message "Reprocessing buffer...done"))
+
+;;--------------------------------------------------------------------
+;; Miscellaneous functions:
+;;--------------------------------------------------------------------
+
+(defun decipher-read-alphabet ()
+  "Build the decipher-alphabet from the alphabet line in the buffer."
+  (save-excursion
+    (goto-char (point-min))
+    (search-forward-regexp "^)")
+    (move-to-column 27 t)
+    (setq decipher-alphabet nil)
+    (let ((plain-char ?z))
+      (while (>= plain-char ?a)
+        (backward-char)
+        (push (cons plain-char (following-char)) decipher-alphabet)
+        (decf plain-char)))))
+
+;;;===================================================================
+;;; Analyzing ciphertext:
+;;;===================================================================
+
+(defun decipher-frequency-count ()
+  "Display the frequency count in the statistics buffer."
+  (interactive)
+  (decipher-analyze)
+  (decipher-display-regexp "^A" "^[A-Z][A-Z]"))
+
+(defun decipher-digram-list ()
+  "Display the list of digrams in the statistics buffer."
+  (interactive)
+  (decipher-analyze)
+  (decipher-display-regexp "[A-Z][A-Z] +[0-9]" "^$"))
+
+(defun decipher-adjacency-list (cipher-char)
+  "Display the adjacency list for the letter at point.
+The adjacency list shows all letters which come next to CIPHER-CHAR.
+
+An adjacency list (for the letter X) looks like this:
+       1 1         1     1   1       3 2 1             3   8
+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
+of 11 different letters.  It occurs 14 times, making up 9% of the
+ciphertext."
+  (interactive (list (upcase (following-char))))
+  (decipher-analyze)
+  (let (start end)
+    (save-excursion
+      (set-buffer (decipher-stats-buffer))
+      (goto-char (point-min))
+      (or (re-search-forward (format "^%c: " cipher-char) nil t)
+          (error "Character `%c' is not used in ciphertext." cipher-char))
+      (forward-line -1)
+      (setq start (point))
+      (forward-line 3)
+      (setq end (point)))
+    (decipher-display-range start end)))
+
+;;--------------------------------------------------------------------
+(defun decipher-analyze ()
+  "Perform frequency analysis on the current buffer if necessary."
+  (cond
+   ;; If this is the statistics buffer, do nothing:
+   ((eq major-mode 'decipher-stats-mode))
+   ;; If this is the Decipher buffer, see if the stats buffer exists:
+   ((eq major-mode 'decipher-mode)
+    (or (and (bufferp decipher-stats-buffer)
+             (buffer-name decipher-stats-buffer))
+        (decipher-analyze-buffer)))
+   ;; Otherwise:
+   (t (error "This buffer is not in Decipher mode"))))
+
+;;--------------------------------------------------------------------
+(defun decipher-display-range (start end)
+  "Display text between START and END in the statistics buffer.
+START and END are positions in the statistics buffer.  Makes the
+statistics buffer visible and sizes the window to just fit the
+displayed text, but leaves the current window selected."
+  (let ((stats-buffer (decipher-stats-buffer))
+        (current-window (selected-window))
+        (pop-up-windows t))
+    (or (eq (current-buffer) stats-buffer)
+        (pop-to-buffer stats-buffer))
+    (goto-char start)
+    (or (one-window-p t)
+        (enlarge-window (- (1+ (count-lines start end)) (window-height))))
+    (recenter 0)
+    (select-window current-window)))
+
+(defun decipher-display-regexp (start-regexp end-regexp)
+  "Display text between two regexps in the statistics buffer.
+
+START-REGEXP matches the first line to display.
+END-REGEXP matches the line after that which ends the display.
+The ending line is included in the display unless it is blank."
+  (let (start end)
+    (save-excursion
+      (set-buffer (decipher-stats-buffer))
+      (goto-char (point-min))
+      (re-search-forward start-regexp)
+      (beginning-of-line)
+      (setq start (point))
+      (re-search-forward end-regexp)
+      (beginning-of-line)
+      (or (looking-at "^ *$")
+          (forward-line 1))
+      (setq end (point)))
+    (decipher-display-range start end)))
+
+;;--------------------------------------------------------------------
+(defun decipher-loop-with-breaks (func)
+  "Loop through ciphertext, calling FUNC once for each letter & word division.
+
+FUNC is called with no arguments, and its return value is unimportant.
+It may examine `decipher-char' to see the current ciphertext
+character.  `decipher-char' contains either an uppercase letter or a space.
+
+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 ?\ ))
+    (save-excursion
+      (goto-char (point-min))
+      (funcall func)              ;Space marks beginning of first word
+      (while (search-forward-regexp "^:" nil t)
+        (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 ?\ ))
+              (funcall func))
+          (setq decipher--loop-prev-char decipher-char)
+          (forward-char))
+        (or (equal decipher-char ?\ )
+            (progn
+              (setq decipher-char ?\ ;
+                    decipher--loop-prev-char ?\ )
+              (funcall func)))))))
+
+(defun decipher-loop-no-breaks (func)
+  "Loop through ciphertext, calling FUNC once for each letter.
+
+FUNC is called with no arguments, and its return value is unimportant.
+It may examine `decipher-char' to see the current ciphertext letter.
+`decipher-char' contains an uppercase letter.
+
+Punctuation and spacing in the ciphertext are ignored.
+See `decipher-loop-with-breaks' if you care about word divisions."
+  (let (decipher-char)
+    (save-excursion
+      (goto-char (point-min))
+      (while (search-forward-regexp "^:" nil t)
+        (while (not (eolp))
+          (setq decipher-char (upcase (following-char)))
+          (and (>= decipher-char ?A)
+               (<= decipher-char ?Z)
+               (funcall func))
+          (forward-char))))))
+
+;;--------------------------------------------------------------------
+;; Perform the analysis:
+;;--------------------------------------------------------------------
+
+(defun decipher-insert-frequency-counts (freq-list total)
+  "Insert frequency counts in current buffer.
+Each element of FREQ-LIST is a list (LETTER FREQ ...).
+TOTAL is the total number of letters in the ciphertext."
+  (let ((i 4) temp-list)
+    (while (> i 0)
+      (setq temp-list freq-list)
+      (while temp-list
+        (insert (caar temp-list)
+                (format "%4d%3d%%  "
+                        (cadar temp-list)
+                        (/ (* 100 (cadar temp-list)) total)))
+        (setq temp-list (nthcdr 4 temp-list)))
+      (insert ?\n)
+      (setq freq-list (cdr freq-list)
+            i         (1- i)))))
+
+(defun decipher--analyze ()
+  ;; Perform frequency analysis on ciphertext.
+  ;;
+  ;; This function is called repeatedly with decipher-char set to each
+  ;; character of ciphertext.  It uses decipher--prev-char to remember
+  ;; the previous ciphertext character.
+  ;;
+  ;; It builds several data structures, which must be initialized
+  ;; before the first call to decipher--analyze.  The arrays are
+  ;; indexed with A = 0, B = 1, ..., Z = 25, SPC = 26 (if used).
+  ;;   decipher--after: (initialize to zeros)
+  ;;     A vector of 26 vectors of 27 integers.  The first vector
+  ;;     represents the number of times A follows each character, the
+  ;;     second vector represents B, and so on.
+  ;;   decipher--before: (initialize to zeros)
+  ;;     The same as decipher--after, but representing the number of
+  ;;     times the character precedes each other character.
+  ;;   decipher--digram-list: (initialize to nil)
+  ;;     An alist with an entry for each digram (2-character sequence)
+  ;;     encountered.  Each element is a cons cell (DIGRAM . FREQ),
+  ;;     where DIGRAM is a 2 character string and FREQ is the number
+  ;;     of times it occurs.
+  ;;   decipher--freqs: (initialize to zeros)
+  ;;     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)
+                 (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 ?\ )
+                       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 ?\ )
+                       26
+                     (- decipher--prev-char ?A)))))
+  (setq decipher--prev-char decipher-char))
+
+(defun decipher--digram-counts (counts)
+  "Generate the counts for an adjacency list."
+  (let ((total 0))
+    (concat
+     (mapconcat (lambda (x)
+                  (cond ((> x 99) (incf total) "XX")
+                        ((> x 0)  (incf total) (format "%2d" x))
+                        (t        "  ")))
+                counts
+                "")
+     (format "%4d" (if (> (aref counts 26) 0)
+                       (1- total)    ;Don't count space
+                     total)))))
+
+(defun decipher--digram-total (before-count after-count)
+  "Count the number of different letters a letter appears next to."
+  ;; We do not include spaces (word divisions) in this count.
+  (let ((total 0)
+        (i 26))
+    (while (>= (decf i) 0)
+      (if (or (> (aref before-count i) 0)
+              (> (aref after-count  i) 0))
+          (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 ?\  ?\*))
+        (decipher--before (make-vector 26 nil))
+        (decipher--after  (make-vector 26 nil))
+        (decipher--freqs   (make-vector 26 0))
+        (total-chars  0)
+        decipher--digram decipher--digram-list freq-list)
+    (message "Scanning buffer...")
+    (let ((i 26))
+      (while (>= (decf i) 0)
+        (aset decipher--before i (make-vector 27 0))
+        (aset decipher--after  i (make-vector 27 0))))
+    (if decipher-ignore-spaces
+        (progn
+          (decipher-loop-no-breaks 'decipher--analyze)
+          ;; The first character of ciphertext was marked as following a space:
+          (let ((i 26))
+            (while (>= (decf i) 0)
+              (aset (aref decipher--after  i) 26 0))))
+      (decipher-loop-with-breaks 'decipher--analyze))
+    (message "Processing results...")
+    (setcdr (last decipher--digram-list 2) nil)   ;Delete the phony "* " digram
+    ;; Sort the digram list by frequency and alphabetical order:
+    (setq decipher--digram-list (sort (sort decipher--digram-list
+                                  (lambda (a b) (string< (car a) (car b))))
+                            (lambda (a b) (> (cdr a) (cdr b)))))
+    ;; Generate the frequency list:
+    ;;   Each element is a list of 3 elements (LETTER FREQ DIFFERENT),
+    ;;   where LETTER is the ciphertext character, FREQ is the number
+    ;;   of times it occurs, and DIFFERENT is the number of different
+    ;;   letters it appears next to.
+    (let ((i 26))
+      (while (>= (decf i) 0)
+        (setq freq-list
+              (cons (list (+ i ?A)
+                          (aref decipher--freqs i)
+                          (decipher--digram-total (aref decipher--before i)
+                                                  (aref decipher--after  i)))
+                    freq-list)
+              total-chars (+ total-chars (aref decipher--freqs i)))))
+    (save-excursion
+      ;; Switch to statistics buffer, creating it if necessary:
+      (set-buffer (decipher-stats-buffer t))
+      ;; This can't happen, but it never hurts to double-check:
+      (or (eq major-mode 'decipher-stats-mode)
+          (error "Buffer %s is not in Decipher-Stats mode" (buffer-name)))
+      (setq buffer-read-only nil)
+      (erase-buffer)
+      ;; Display frequency counts for letters A-Z:
+      (decipher-insert-frequency-counts freq-list total-chars)
+      (insert ?\n)
+      ;; Display frequency counts for letters in order of frequency:
+      (setq freq-list (sort freq-list
+                            (lambda (a b) (> (second a) (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)))
+                             freq-list nil)
+              "\n\n")
+      ;; Display list of digrams in order of frequency:
+      (let* ((rows (floor (+ (length decipher--digram-list) 9) 10))
+             (i rows)
+             temp-list)
+        (while (> i 0)
+          (setq temp-list decipher--digram-list)
+          (while temp-list