--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/games/cookie1.el	Mon Aug 13 08:45:50 2007 +0200
@@ -0,0 +1,171 @@
+;;; cookie1.el --- retrieve random phrases from fortune cookie files
+
+;; Copyright (C) 1993 Free Software Foundation, Inc.
+
+;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
+;; Maintainer: FSF
+;; Keywords: games
+;; Created: Mon Mar 22 17:06:26 1993
+
+;; 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, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;;; Synched up with: FSF 19.28.
+
+;;; Commentary:
+
+;; Support for random cookie fetches from phrase files, used for such
+;; critical applications as emulating Zippy the Pinhead and confounding
+;; the NSA Trunk Trawler.
+;;
+;; The two entry points are `cookie' and `cookie-insert'.  The helper
+;; function `shuffle-vector' may be of interest to programmers.
+;;
+;; The code expects phrase files to be in one of two formats:
+;;
+;; * ITS-style LINS format (strings terminated by ASCII 0 characters,
+;; leading whitespace ignored).
+;;
+;; * UNIX fortune file format (quotes terminated by %% on a line by itself).
+;;
+;; Everything up to the first delimiter is treated as a comment.  Other
+;; formats could be supported by adding alternates to the regexp
+;; `cookie-delimiter'.
+;;
+;; This code derives from Steve Strassman's 1987 spook.el package, but
+;; has been generalized so that it supports multiple simultaneous
+;; cookie databases and fortune files.  It is intended to be called
+;; from other packages such as yow.el and spook.el.
+;;
+;; TO DO: teach cookie-snarf to auto-detect ITS PINS or UNIX fortune(6)
+;; format and do the right thing.
+
+;;; Code:
+
+; Randomize the seed in the random number generator.
+(random t)
+
+(defconst cookie-delimiter "\n%%\n\\|\0"
+  "Delimiter used to separate cookie file entries.")
+
+(defvar cookie-cache (make-vector 511 0)
+  "Cache of cookie files that have already been snarfed.")
+
+;;;###autoload
+(defun cookie (phrase-file startmsg endmsg)
+  "Return a random phrase from PHRASE-FILE.  When the phrase file
+is read in, display STARTMSG at beginning of load, ENDMSG at end."
+  (let ((cookie-vector (cookie-snarf phrase-file startmsg endmsg)))
+    (shuffle-vector cookie-vector)
+    (aref cookie-vector 1)))
+
+;;;###autoload
+(defun cookie-insert (phrase-file &optional count startmsg endmsg)
+  "Insert random phrases from PHRASE-FILE; COUNT of them.  When the phrase file
+is read in, display STARTMSG at beginning of load, ENDMSG at end."
+  (let ((cookie-vector (cookie-snarf phrase-file startmsg endmsg)))
+    (shuffle-vector cookie-vector)
+    (let ((start (point)))
+      (insert ?\n)
+      (cookie1 (min (- (length cookie-vector) 1) (or count 1)) cookie-vector)
+      (insert ?\n)
+      (fill-region-as-paragraph start (point) nil))))
+
+(defun cookie1 (arg cookie-vec)
+  "Inserts a cookie phrase ARG times."
+  (cond ((zerop arg) t)
+	(t (insert (aref cookie-vec arg))
+	   (insert " ")
+	   (cookie1 (1- arg) cookie-vec))))
+
+;;;###autoload
+(defun cookie-snarf (phrase-file startmsg endmsg)
+  "Reads in the PHRASE-FILE, returns it as a vector of strings.
+Emit STARTMSG and ENDMSG before and after.  Caches the result; second
+and subsequent calls on the same file won't go to disk."
+  (let ((sym (intern-soft phrase-file cookie-cache)))
+    (and sym (not (equal (symbol-function sym)
+			 (nth 5 (file-attributes phrase-file))))
+	 (yes-or-no-p (concat phrase-file
+			      " has changed.  Read new contents? "))
+	 (setq sym nil))
+    (if sym
+	(symbol-value sym)
+      (setq sym (intern phrase-file cookie-cache))
+      (message startmsg)
+      (save-excursion
+	(let ((buf (generate-new-buffer "*cookie*"))
+	      (result nil))
+	  (set-buffer buf)
+	  (fset sym (nth 5 (file-attributes phrase-file)))
+	  (insert-file-contents (expand-file-name phrase-file))
+	  (re-search-forward cookie-delimiter)
+	  (while (progn (skip-chars-forward " \t\n\r\f") (not (eobp)))
+	    (let ((beg (point)))
+	      (re-search-forward cookie-delimiter)
+	      ;; DBC --- here's the change
+	      ;; This used to be (buffer-substring beg (1- (point))),
+	      ;; which only worked if the regexp matched was one
+	      ;; character long
+	      (setq result (cons (buffer-substring beg
+						   (match-beginning 0))
+				 result))))
+	  (kill-buffer buf)
+	  (message endmsg)
+	  (set sym (apply 'vector result)))))))
+
+(defun read-cookie (prompt phrase-file startmsg endmsg &optional require-match)
+  "Prompt with PROMPT and read with completion among cookies in PHRASE-FILE.
+STARTMSG and ENDMSG are passed along to `cookie-snarf'.
+Optional fifth arg REQUIRE-MATCH non-nil forces a matching cookie."
+  ;; Make sure the cookies are in the cache.
+  (or (intern-soft phrase-file cookie-cache)
+      (cookie-snarf phrase-file startmsg endmsg))
+  (completing-read prompt
+		   (let ((sym (intern phrase-file cookie-cache)))
+		     ;; We cache the alist form of the cookie in a property.
+		     (or (get sym 'completion-alist)
+			 (let* ((alist nil)
+				(vec (cookie-snarf phrase-file
+						   startmsg endmsg))
+				(i (length vec)))
+			   (while (> (setq i (1- i)) 0)
+			     (setq alist (cons (list (aref vec i)) alist)))
+			   (put sym 'completion-alist alist))))
+		   nil require-match nil nil))
+
+; Thanks to Ian G Batten <BattenIG@CS.BHAM.AC.UK>
+; [of the University of Birmingham Computer Science Department]
+; for the iterative version of this shuffle.
+;
+;;;###autoload
+(defun shuffle-vector (vector)
+  "Randomly permute the elements of VECTOR (all permutations equally likely)"
+  (let ((i 0)
+	j
+	temp
+	(len (length vector)))
+    (while (< i len)
+      (setq j (+ i (random (- len i))))
+      (setq temp (aref vector i))
+      (aset vector i (aref vector j))
+      (aset vector j temp)
+      (setq i (1+ i))))
+  vector)
+
+(provide 'cookie1)
+
+;;; cookie1.el ends here