Commit | Line | Data |
---|---|---|
8eb74eec | 1 | ;;; cookie1.el --- retrieve random phrases from fortune cookie files |
d5edbd11 | 2 | |
d7a0267c GM |
3 | ;; Copyright (C) 1993, 2001, 2002, 2003, 2004, 2005, |
4 | ;; 2006, 2007 Free Software Foundation, Inc. | |
d5edbd11 ER |
5 | |
6 | ;; Author: Eric S. Raymond <esr@snark.thyrsus.com> | |
7 | ;; Maintainer: FSF | |
0419a4af | 8 | ;; Keywords: games, extensions |
d5edbd11 ER |
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 | |
5a9dffec | 15 | ;; the Free Software Foundation; either version 3, or (at your option) |
d5edbd11 ER |
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 | |
b578f267 | 24 | ;; along with GNU Emacs; see the file COPYING. If not, write to the |
3a35cf56 LK |
25 | ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
26 | ;; Boston, MA 02110-1301, USA. | |
d5edbd11 ER |
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 | |
c5eeaf52 | 35 | ;; function `shuffle-vector' may be of interest to programmers. |
d5edbd11 | 36 | ;; |
45b44a5a ER |
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'. | |
d5edbd11 | 47 | ;; |
96ce5c4f GM |
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 | ;; | |
d5edbd11 | 52 | ;; This code derives from Steve Strassman's 1987 spook.el package, but |
45b44a5a ER |
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. | |
cf597dc8 ER |
56 | ;; |
57 | ;; TO DO: teach cookie-snarf to auto-detect ITS PINS or UNIX fortune(6) | |
58 | ;; format and do the right thing. | |
d5edbd11 ER |
59 | |
60 | ;;; Code: | |
61 | ||
62 | ; Randomize the seed in the random number generator. | |
63 | (random t) | |
64 | ||
bfaef6dc | 65 | (defconst cookie-delimiter "\n%%\n\\|\n%\n\\|\0" |
d5edbd11 ER |
66 | "Delimiter used to separate cookie file entries.") |
67 | ||
4054367c RM |
68 | (defvar cookie-cache (make-vector 511 0) |
69 | "Cache of cookie files that have already been snarfed.") | |
70 | ||
f58c6f70 | 71 | ;;;###autoload |
d5edbd11 | 72 | (defun cookie (phrase-file startmsg endmsg) |
132c0cc0 PJ |
73 | "Return a random phrase from PHRASE-FILE. |
74 | When the phrase file is read in, display STARTMSG at the beginning | |
75 | of load, ENDMSG at the end." | |
d5edbd11 ER |
76 | (let ((cookie-vector (cookie-snarf phrase-file startmsg endmsg))) |
77 | (shuffle-vector cookie-vector) | |
a2064b09 | 78 | (aref cookie-vector 0))) |
d5edbd11 | 79 | |
f58c6f70 | 80 | ;;;###autoload |
d5edbd11 | 81 | (defun cookie-insert (phrase-file &optional count startmsg endmsg) |
132c0cc0 PJ |
82 | "Insert random phrases from PHRASE-FILE; COUNT of them. |
83 | When the phrase file is read in, display STARTMSG at the beginning | |
84 | of load, ENDMSG at the end." | |
d5edbd11 ER |
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 | ||
f58c6f70 | 100 | ;;;###autoload |
d5edbd11 | 101 | (defun cookie-snarf (phrase-file startmsg endmsg) |
b81d991d RM |
102 | "Reads in the PHRASE-FILE, returns it as a vector of strings. |
103 | Emit STARTMSG and ENDMSG before and after. Caches the result; second | |
104 | and subsequent calls on the same file won't go to disk." | |
4054367c RM |
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)) | |
4120f5f5 | 114 | (message "%s" startmsg) |
4054367c RM |
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) | |
bfaef6dc | 125 | (setq result (cons (buffer-substring beg (match-beginning 0)) |
4054367c RM |
126 | result)))) |
127 | (kill-buffer buf) | |
4120f5f5 | 128 | (message "%s" endmsg) |
4054367c | 129 | (set sym (apply 'vector result))))))) |
d5edbd11 | 130 | |
b81d991d RM |
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. | |
133 | STARTMSG and ENDMSG are passed along to `cookie-snarf'. | |
134 | Optional 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 | ||
d5edbd11 ER |
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 | ; | |
f58c6f70 | 155 | ;;;###autoload |
d5edbd11 | 156 | (defun shuffle-vector (vector) |
132c0cc0 | 157 | "Randomly permute the elements of VECTOR (all permutations equally likely)." |
d5edbd11 ER |
158 | (let ((i 0) |
159 | j | |
160 | temp | |
161 | (len (length vector))) | |
162 | (while (< i len) | |
c5eeaf52 | 163 | (setq j (+ i (random (- len i)))) |
d5edbd11 ER |
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 | ||
3aa7cce7 | 170 | (provide 'cookie1) |
d5edbd11 | 171 | |
ab5796a9 | 172 | ;;; arch-tag: 4a8a8712-df6a-4f34-b030-108a1b47f9f2 |
20a82895 | 173 | ;;; cookie1.el ends here |