Commit | Line | Data |
---|---|---|
8eb74eec | 1 | ;;; cookie1.el --- retrieve random phrases from fortune cookie files |
d5edbd11 | 2 | |
ab422c4d | 3 | ;; Copyright (C) 1993, 2001-2013 Free Software Foundation, Inc. |
d5edbd11 ER |
4 | |
5 | ;; Author: Eric S. Raymond <esr@snark.thyrsus.com> | |
6 | ;; Maintainer: FSF | |
0419a4af | 7 | ;; Keywords: games, extensions |
d5edbd11 ER |
8 | ;; Created: Mon Mar 22 17:06:26 1993 |
9 | ||
10 | ;; This file is part of GNU Emacs. | |
11 | ||
b1fc2b50 | 12 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
d5edbd11 | 13 | ;; it under the terms of the GNU General Public License as published by |
b1fc2b50 GM |
14 | ;; the Free Software Foundation, either version 3 of the License, or |
15 | ;; (at your option) any later version. | |
d5edbd11 ER |
16 | |
17 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
18 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
19 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
20 | ;; GNU General Public License for more details. | |
21 | ||
22 | ;; You should have received a copy of the GNU General Public License | |
b1fc2b50 | 23 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
d5edbd11 ER |
24 | |
25 | ;;; Commentary: | |
26 | ||
27 | ;; Support for random cookie fetches from phrase files, used for such | |
e7a526e3 | 28 | ;; critical applications as confounding the NSA Trunk Trawler. |
d5edbd11 ER |
29 | ;; |
30 | ;; The two entry points are `cookie' and `cookie-insert'. The helper | |
e7a526e3 | 31 | ;; function `cookie-shuffle-vector' may be of interest to programmers. |
d5edbd11 | 32 | ;; |
45b44a5a ER |
33 | ;; The code expects phrase files to be in one of two formats: |
34 | ;; | |
35 | ;; * ITS-style LINS format (strings terminated by ASCII 0 characters, | |
36 | ;; leading whitespace ignored). | |
37 | ;; | |
38 | ;; * UNIX fortune file format (quotes terminated by %% on a line by itself). | |
39 | ;; | |
40 | ;; Everything up to the first delimiter is treated as a comment. Other | |
41 | ;; formats could be supported by adding alternates to the regexp | |
42 | ;; `cookie-delimiter'. | |
d5edbd11 | 43 | ;; |
96ce5c4f GM |
44 | ;; strfile(1) is the program used to compile the files for fortune(6). |
45 | ;; In order to achieve total compatibility with strfile(1), cookie files | |
46 | ;; should start with two consecutive delimiters (and no comment). | |
47 | ;; | |
22bcf204 | 48 | ;; This code derives from Steve Strassmann's 1987 spook.el package, but |
45b44a5a ER |
49 | ;; has been generalized so that it supports multiple simultaneous |
50 | ;; cookie databases and fortune files. It is intended to be called | |
e7a526e3 | 51 | ;; from other packages such as spook.el. |
d5edbd11 ER |
52 | |
53 | ;;; Code: | |
54 | ||
e7a526e3 GM |
55 | (defgroup cookie nil |
56 | "Random cookies from phrase files." | |
57 | :prefix "cookie-" | |
58 | :group 'games) | |
59 | ||
60 | (defcustom cookie-file nil | |
61 | "Default phrase file for cookie functions." | |
62 | :type '(choice (const nil) file) | |
63 | :group 'cookie | |
64 | :version "24.4") | |
65 | ||
bfaef6dc | 66 | (defconst cookie-delimiter "\n%%\n\\|\n%\n\\|\0" |
d5edbd11 ER |
67 | "Delimiter used to separate cookie file entries.") |
68 | ||
4054367c RM |
69 | (defvar cookie-cache (make-vector 511 0) |
70 | "Cache of cookie files that have already been snarfed.") | |
71 | ||
e7a526e3 GM |
72 | (defun cookie-check-file (file) |
73 | "Return either FILE or `cookie-file'. | |
74 | Signal an error if the result is nil or not readable." | |
75 | (or (setq file (or file cookie-file)) (user-error "No phrase file specified")) | |
76 | (or (file-readable-p file) (user-error "Cannot read file `%s'" file)) | |
77 | file) | |
78 | ||
f58c6f70 | 79 | ;;;###autoload |
e7a526e3 | 80 | (defun cookie (phrase-file &optional startmsg endmsg) |
132c0cc0 PJ |
81 | "Return a random phrase from PHRASE-FILE. |
82 | When the phrase file is read in, display STARTMSG at the beginning | |
e7a526e3 GM |
83 | of load, ENDMSG at the end. |
84 | Interactively, PHRASE-FILE defaults to `cookie-file', unless that | |
85 | is nil or a prefix argument is used." | |
86 | (interactive (list (if (or current-prefix-arg (not cookie-file)) | |
87 | (read-file-name "Cookie file: " nil | |
88 | cookie-file t cookie-file) | |
89 | cookie-file) nil nil)) | |
90 | (setq phrase-file (cookie-check-file phrase-file)) | |
91 | (let ((cookie-vector (cookie-snarf phrase-file startmsg endmsg)) | |
92 | res) | |
93 | (cookie-shuffle-vector cookie-vector) | |
94 | (setq res (aref cookie-vector 0)) | |
95 | (if (called-interactively-p 'interactive) | |
96 | (message "%s" res) | |
97 | res))) | |
d5edbd11 | 98 | |
f58c6f70 | 99 | ;;;###autoload |
d5edbd11 | 100 | (defun cookie-insert (phrase-file &optional count startmsg endmsg) |
132c0cc0 PJ |
101 | "Insert random phrases from PHRASE-FILE; COUNT of them. |
102 | When the phrase file is read in, display STARTMSG at the beginning | |
103 | of load, ENDMSG at the end." | |
e7a526e3 | 104 | (setq phrase-file (cookie-check-file phrase-file)) |
d5edbd11 | 105 | (let ((cookie-vector (cookie-snarf phrase-file startmsg endmsg))) |
e7a526e3 | 106 | (cookie-shuffle-vector cookie-vector) |
d5edbd11 ER |
107 | (let ((start (point))) |
108 | (insert ?\n) | |
109 | (cookie1 (min (- (length cookie-vector) 1) (or count 1)) cookie-vector) | |
110 | (insert ?\n) | |
111 | (fill-region-as-paragraph start (point) nil)))) | |
112 | ||
113 | (defun cookie1 (arg cookie-vec) | |
114 | "Inserts a cookie phrase ARG times." | |
115 | (cond ((zerop arg) t) | |
116 | (t (insert (aref cookie-vec arg)) | |
117 | (insert " ") | |
118 | (cookie1 (1- arg) cookie-vec)))) | |
119 | ||
f58c6f70 | 120 | ;;;###autoload |
e7a526e3 | 121 | (defun cookie-snarf (phrase-file &optional startmsg endmsg) |
b81d991d RM |
122 | "Reads in the PHRASE-FILE, returns it as a vector of strings. |
123 | Emit STARTMSG and ENDMSG before and after. Caches the result; second | |
124 | and subsequent calls on the same file won't go to disk." | |
e7a526e3 | 125 | (setq phrase-file (cookie-check-file phrase-file)) |
4054367c RM |
126 | (let ((sym (intern-soft phrase-file cookie-cache))) |
127 | (and sym (not (equal (symbol-function sym) | |
128 | (nth 5 (file-attributes phrase-file)))) | |
129 | (yes-or-no-p (concat phrase-file | |
130 | " has changed. Read new contents? ")) | |
131 | (setq sym nil)) | |
132 | (if sym | |
133 | (symbol-value sym) | |
134 | (setq sym (intern phrase-file cookie-cache)) | |
e7a526e3 GM |
135 | (if startmsg (message "%s" startmsg)) |
136 | (fset sym (nth 5 (file-attributes phrase-file))) | |
137 | (let (result) | |
138 | (with-temp-buffer | |
4054367c RM |
139 | (insert-file-contents (expand-file-name phrase-file)) |
140 | (re-search-forward cookie-delimiter) | |
141 | (while (progn (skip-chars-forward " \t\n\r\f") (not (eobp))) | |
142 | (let ((beg (point))) | |
143 | (re-search-forward cookie-delimiter) | |
bfaef6dc | 144 | (setq result (cons (buffer-substring beg (match-beginning 0)) |
e7a526e3 GM |
145 | result))))) |
146 | (if endmsg (message "%s" endmsg)) | |
147 | (set sym (apply 'vector result)))))) | |
d5edbd11 | 148 | |
e7a526e3 | 149 | (defun cookie-read (prompt phrase-file &optional startmsg endmsg require-match) |
b81d991d RM |
150 | "Prompt with PROMPT and read with completion among cookies in PHRASE-FILE. |
151 | STARTMSG and ENDMSG are passed along to `cookie-snarf'. | |
e7a526e3 GM |
152 | Argument REQUIRE-MATCH non-nil forces a matching cookie." |
153 | (setq phrase-file (cookie-check-file phrase-file)) | |
b81d991d RM |
154 | ;; Make sure the cookies are in the cache. |
155 | (or (intern-soft phrase-file cookie-cache) | |
156 | (cookie-snarf phrase-file startmsg endmsg)) | |
157 | (completing-read prompt | |
158 | (let ((sym (intern phrase-file cookie-cache))) | |
159 | ;; We cache the alist form of the cookie in a property. | |
160 | (or (get sym 'completion-alist) | |
161 | (let* ((alist nil) | |
162 | (vec (cookie-snarf phrase-file | |
163 | startmsg endmsg)) | |
164 | (i (length vec))) | |
\81ukasz Stelmach, 2010-08-26 17:33:52 +0200">d5720b4c | 165 | (while (>= (setq i (1- i)) 0) |
b81d991d RM |
166 | (setq alist (cons (list (aref vec i)) alist))) |
167 | (put sym 'completion-alist alist)))) | |
168 | nil require-match nil nil)) | |
169 | ||
e7a526e3 GM |
170 | (define-obsolete-function-alias 'read-cookie 'cookie-read "24.4") |
171 | ||
172 | ;; Thanks to Ian G Batten <BattenIG@CS.BHAM.AC.UK> | |
173 | ;; [of the University of Birmingham Computer Science Department] | |
174 | ;; for the iterative version of this shuffle. | |
175 | (defun cookie-shuffle-vector (vector) | |
132c0cc0 | 176 | "Randomly permute the elements of VECTOR (all permutations equally likely)." |
e7a526e3 GM |
177 | (let ((len (length vector)) |
178 | j temp) | |
179 | (dotimes (i len vector) | |
180 | (setq j (+ i (random (- len i))) | |
181 | temp (aref vector i)) | |
d5edbd11 | 182 | (aset vector i (aref vector j)) |
e7a526e3 GM |
183 | (aset vector j temp)))) |
184 | ||
185 | (define-obsolete-function-alias 'shuffle-vector 'cookie-shuffle-vector "24.4") | |
186 | ||
187 | ||
cad5d1cb | 188 | (defun cookie-apropos (regexp phrase-file &optional display) |
e7a526e3 GM |
189 | "Return a list of all entries matching REGEXP from PHRASE-FILE. |
190 | Interactively, PHRASE-FILE defaults to `cookie-file', unless that | |
191 | is nil or a prefix argument is used. | |
cad5d1cb | 192 | If called interactively, or if DISPLAY is non-nil, display a list of matches." |
e7a526e3 GM |
193 | (interactive (list (read-regexp "Apropos phrase (regexp): ") |
194 | (if (or current-prefix-arg (not cookie-file)) | |
195 | (read-file-name "Cookie file: " nil | |
196 | cookie-file t cookie-file) | |
2663dd23 | 197 | cookie-file) t)) |
e7a526e3 GM |
198 | (setq phrase-file (cookie-check-file phrase-file)) |
199 | ;; Make sure phrases are loaded. | |
200 | (cookie phrase-file) | |
201 | (let* ((case-fold-search t) | |
202 | (cookie-table-symbol (intern phrase-file cookie-cache)) | |
203 | (string-table (symbol-value cookie-table-symbol)) | |
2663dd23 GM |
204 | (matches nil)) |
205 | (and (dotimes (i (length string-table) matches) | |
206 | (and (string-match-p regexp (aref string-table i)) | |
207 | (setq matches (cons (aref string-table i) matches)))) | |
e7a526e3 | 208 | (setq matches (sort matches 'string-lessp))) |
2663dd23 GM |
209 | (and display |
210 | (if matches | |
211 | (let ((l matches)) | |
212 | (with-output-to-temp-buffer "*Cookie Apropos*" | |
213 | (while l | |
214 | (princ (car l)) | |
215 | (setq l (cdr l)) | |
216 | (and l (princ "\n\n"))) | |
217 | (help-print-return-message))) | |
218 | (message "No matches found."))) | |
e7a526e3 GM |
219 | matches)) |
220 | ||
221 | ||
222 | (declare-function doctor-ret-or-read "doctor" (arg)) | |
223 | ||
224 | (defun cookie-doctor (phrase-file) | |
225 | "Feed cookie phrases from PHRASE-FILE to the doctor. | |
226 | Interactively, PHRASE-FILE defaults to `cookie-file', unless that | |
227 | is nil or a prefix argument is used." | |
228 | (interactive (list (if (or current-prefix-arg (not cookie-file)) | |
229 | (read-file-name "Cookie file: " nil | |
230 | cookie-file t cookie-file) | |
231 | cookie-file))) | |
232 | (setq phrase-file (cookie-check-file phrase-file)) | |
233 | (doctor) ; start the psychotherapy | |
234 | (message "") | |
235 | (switch-to-buffer "*doctor*") | |
236 | (sit-for 0) | |
237 | (while (not (input-pending-p)) | |
238 | (insert (cookie phrase-file)) | |
239 | (sit-for 0) | |
240 | (doctor-ret-or-read 1) | |
241 | (doctor-ret-or-read 1))) | |
242 | ||
d5edbd11 | 243 | |
3aa7cce7 | 244 | (provide 'cookie1) |
d5edbd11 | 245 | |
20a82895 | 246 | ;;; cookie1.el ends here |