1;;; cookie1.el --- retrieve random phrases from fortune cookie files
2
3;; Copyright (C) 1993, 2001, 2002, 2003, 2004, 2005,
4;;   2006, 2007 Free Software Foundation, Inc.
5
6;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
7;; Maintainer: FSF
8;; Keywords: games, extensions
9;; Created: Mon Mar 22 17:06:26 1993
10
11;; This file is part of GNU Emacs.
12
13;; GNU Emacs is free software; you can redistribute it and/or modify
14;; it under the terms of the GNU General Public License as published by
15;; the Free Software Foundation; either version 2, or (at your option)
16;; any later version.
17
18;; GNU Emacs is distributed in the hope that it will be useful,
19;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
21;; GNU General Public License for more details.
22
23;; You should have received a copy of the GNU General Public License
24;; along with GNU Emacs; see the file COPYING.  If not, write to the
25;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
26;; Boston, MA 02110-1301, USA.
27
28;;; Commentary:
29
30;; Support for random cookie fetches from phrase files, used for such
31;; critical applications as emulating Zippy the Pinhead and confounding
32;; the NSA Trunk Trawler.
33;;
34;; The two entry points are `cookie' and `cookie-insert'.  The helper
35;; function `shuffle-vector' may be of interest to programmers.
36;;
37;; The code expects phrase files to be in one of two formats:
38;;
39;; * ITS-style LINS format (strings terminated by ASCII 0 characters,
40;; leading whitespace ignored).
41;;
42;; * UNIX fortune file format (quotes terminated by %% on a line by itself).
43;;
44;; Everything up to the first delimiter is treated as a comment.  Other
45;; formats could be supported by adding alternates to the regexp
46;; `cookie-delimiter'.
47;;
48;; strfile(1) is the program used to compile the files for fortune(6).
49;; In order to achieve total compatibility with strfile(1), cookie files
50;; should start with two consecutive delimiters (and no comment).
51;;
52;; This code derives from Steve Strassman's 1987 spook.el package, but
53;; has been generalized so that it supports multiple simultaneous
54;; cookie databases and fortune files.  It is intended to be called
55;; from other packages such as yow.el and spook.el.
56;;
57;; TO DO: teach cookie-snarf to auto-detect ITS PINS or UNIX fortune(6)
58;; format and do the right thing.
59
60;;; Code:
61
62; Randomize the seed in the random number generator.
63(random t)
64
65(defconst cookie-delimiter "\n%%\n\\|\n%\n\\|\0"
66  "Delimiter used to separate cookie file entries.")
67
68(defvar cookie-cache (make-vector 511 0)
69  "Cache of cookie files that have already been snarfed.")
70
71;;;###autoload
72(defun cookie (phrase-file startmsg endmsg)
73  "Return a random phrase from PHRASE-FILE.
74When the phrase file is read in, display STARTMSG at the beginning
75of load, ENDMSG at the end."
76  (let ((cookie-vector (cookie-snarf phrase-file startmsg endmsg)))
77    (shuffle-vector cookie-vector)
78    (aref cookie-vector 0)))
79
80;;;###autoload
81(defun cookie-insert (phrase-file &optional count startmsg endmsg)
82  "Insert random phrases from PHRASE-FILE; COUNT of them.
83When the phrase file is read in, display STARTMSG at the beginning
84of load, ENDMSG at the end."
85  (let ((cookie-vector (cookie-snarf phrase-file startmsg endmsg)))
86    (shuffle-vector cookie-vector)
87    (let ((start (point)))
88      (insert ?\n)
89      (cookie1 (min (- (length cookie-vector) 1) (or count 1)) cookie-vector)
90      (insert ?\n)
91      (fill-region-as-paragraph start (point) nil))))
92
93(defun cookie1 (arg cookie-vec)
94  "Inserts a cookie phrase ARG times."
95  (cond ((zerop arg) t)
96	(t (insert (aref cookie-vec arg))
97	   (insert " ")
98	   (cookie1 (1- arg) cookie-vec))))
99
100;;;###autoload
101(defun cookie-snarf (phrase-file startmsg endmsg)
102  "Reads in the PHRASE-FILE, returns it as a vector of strings.
103Emit STARTMSG and ENDMSG before and after.  Caches the result; second
104and subsequent calls on the same file won't go to disk."
105  (let ((sym (intern-soft phrase-file cookie-cache)))
106    (and sym (not (equal (symbol-function sym)
107			 (nth 5 (file-attributes phrase-file))))
108	 (yes-or-no-p (concat phrase-file
109			      " has changed.  Read new contents? "))
110	 (setq sym nil))
111    (if sym
112	(symbol-value sym)
113      (setq sym (intern phrase-file cookie-cache))
114      (message "%s" startmsg)
115      (save-excursion
116	(let ((buf (generate-new-buffer "*cookie*"))
117	      (result nil))
118	  (set-buffer buf)
119	  (fset sym (nth 5 (file-attributes phrase-file)))
120	  (insert-file-contents (expand-file-name phrase-file))
121	  (re-search-forward cookie-delimiter)
122	  (while (progn (skip-chars-forward " \t\n\r\f") (not (eobp)))
123	    (let ((beg (point)))
124	      (re-search-forward cookie-delimiter)
125	      (setq result (cons (buffer-substring beg (match-beginning 0))
126				 result))))
127	  (kill-buffer buf)
128	  (message "%s" endmsg)
129	  (set sym (apply 'vector result)))))))
130
131(defun read-cookie (prompt phrase-file startmsg endmsg &optional require-match)
132  "Prompt with PROMPT and read with completion among cookies in PHRASE-FILE.
133STARTMSG and ENDMSG are passed along to `cookie-snarf'.
134Optional fifth arg REQUIRE-MATCH non-nil forces a matching cookie."
135  ;; Make sure the cookies are in the cache.
136  (or (intern-soft phrase-file cookie-cache)
137      (cookie-snarf phrase-file startmsg endmsg))
138  (completing-read prompt
139		   (let ((sym (intern phrase-file cookie-cache)))
140		     ;; We cache the alist form of the cookie in a property.
141		     (or (get sym 'completion-alist)
142			 (let* ((alist nil)
143				(vec (cookie-snarf phrase-file
144						   startmsg endmsg))
145				(i (length vec)))
146			   (while (> (setq i (1- i)) 0)
147			     (setq alist (cons (list (aref vec i)) alist)))
148			   (put sym 'completion-alist alist))))
149		   nil require-match nil nil))
150
151; Thanks to Ian G Batten <BattenIG@CS.BHAM.AC.UK>
152; [of the University of Birmingham Computer Science Department]
153; for the iterative version of this shuffle.
154;
155;;;###autoload
156(defun shuffle-vector (vector)
157  "Randomly permute the elements of VECTOR (all permutations equally likely)."
158  (let ((i 0)
159	j
160	temp
161	(len (length vector)))
162    (while (< i len)
163      (setq j (+ i (random (- len i))))
164      (setq temp (aref vector i))
165      (aset vector i (aref vector j))
166      (aset vector j temp)
167      (setq i (1+ i))))
168  vector)
169
170(provide 'cookie1)
171
172;;; arch-tag: 4a8a8712-df6a-4f34-b030-108a1b47f9f2
173;;; cookie1.el ends here
174