Mercurial > emacs
annotate lisp/play/cookie1.el @ 95038:a25916c502ba
(vc-rcs-create-tag): Fix typo in error message and pass backend arg.
author | Juanma Barranquero <lekktu@gmail.com> |
---|---|
date | Fri, 16 May 2008 08:32:57 +0000 |
parents | 949bd6ad1ba4 |
children | 010f128dcc33 |
rev | line source |
---|---|
3383 | 1 ;;; cookie1.el --- retrieve random phrases from fortune cookie files |
2321 | 2 |
75347 | 3 ;; Copyright (C) 1993, 2001, 2002, 2003, 2004, 2005, |
79716 | 4 ;; 2006, 2007, 2008 Free Software Foundation, Inc. |
2321 | 5 |
6 ;; Author: Eric S. Raymond <esr@snark.thyrsus.com> | |
7 ;; Maintainer: FSF | |
30858
b9f0d1526fea
Add `extensions' to keywords, since it's internal.
Dave Love <fx@gnu.org>
parents:
30514
diff
changeset
|
8 ;; Keywords: games, extensions |
2321 | 9 ;; Created: Mon Mar 22 17:06:26 1993 |
10 | |
11 ;; This file is part of GNU Emacs. | |
12 | |
94675
949bd6ad1ba4
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
13 ;; GNU Emacs is free software: you can redistribute it and/or modify |
2321 | 14 ;; it under the terms of the GNU General Public License as published by |
94675
949bd6ad1ba4
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
15 ;; the Free Software Foundation, either version 3 of the License, or |
949bd6ad1ba4
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
16 ;; (at your option) any later version. |
2321 | 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 | |
94675
949bd6ad1ba4
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
24 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
2321 | 25 |
26 ;;; Commentary: | |
27 | |
28 ;; Support for random cookie fetches from phrase files, used for such | |
29 ;; critical applications as emulating Zippy the Pinhead and confounding | |
30 ;; the NSA Trunk Trawler. | |
31 ;; | |
32 ;; The two entry points are `cookie' and `cookie-insert'. The helper | |
4405 | 33 ;; function `shuffle-vector' may be of interest to programmers. |
2321 | 34 ;; |
2381
f8ae5fc2c196
(cookie) Enhanced it to handle both LINS files and UNIX fortune files.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2322
diff
changeset
|
35 ;; The code expects phrase files to be in one of two formats: |
f8ae5fc2c196
(cookie) Enhanced it to handle both LINS files and UNIX fortune files.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2322
diff
changeset
|
36 ;; |
f8ae5fc2c196
(cookie) Enhanced it to handle both LINS files and UNIX fortune files.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2322
diff
changeset
|
37 ;; * ITS-style LINS format (strings terminated by ASCII 0 characters, |
f8ae5fc2c196
(cookie) Enhanced it to handle both LINS files and UNIX fortune files.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2322
diff
changeset
|
38 ;; leading whitespace ignored). |
f8ae5fc2c196
(cookie) Enhanced it to handle both LINS files and UNIX fortune files.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2322
diff
changeset
|
39 ;; |
f8ae5fc2c196
(cookie) Enhanced it to handle both LINS files and UNIX fortune files.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2322
diff
changeset
|
40 ;; * UNIX fortune file format (quotes terminated by %% on a line by itself). |
f8ae5fc2c196
(cookie) Enhanced it to handle both LINS files and UNIX fortune files.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2322
diff
changeset
|
41 ;; |
f8ae5fc2c196
(cookie) Enhanced it to handle both LINS files and UNIX fortune files.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2322
diff
changeset
|
42 ;; Everything up to the first delimiter is treated as a comment. Other |
f8ae5fc2c196
(cookie) Enhanced it to handle both LINS files and UNIX fortune files.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2322
diff
changeset
|
43 ;; formats could be supported by adding alternates to the regexp |
f8ae5fc2c196
(cookie) Enhanced it to handle both LINS files and UNIX fortune files.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2322
diff
changeset
|
44 ;; `cookie-delimiter'. |
2321 | 45 ;; |
30514
42bf9adb59a3
Add explanation of how to make cookie.el
Gerd Moellmann <gerd@gnu.org>
parents:
20887
diff
changeset
|
46 ;; strfile(1) is the program used to compile the files for fortune(6). |
42bf9adb59a3
Add explanation of how to make cookie.el
Gerd Moellmann <gerd@gnu.org>
parents:
20887
diff
changeset
|
47 ;; In order to achieve total compatibility with strfile(1), cookie files |
42bf9adb59a3
Add explanation of how to make cookie.el
Gerd Moellmann <gerd@gnu.org>
parents:
20887
diff
changeset
|
48 ;; should start with two consecutive delimiters (and no comment). |
42bf9adb59a3
Add explanation of how to make cookie.el
Gerd Moellmann <gerd@gnu.org>
parents:
20887
diff
changeset
|
49 ;; |
2321 | 50 ;; This code derives from Steve Strassman's 1987 spook.el package, but |
2381
f8ae5fc2c196
(cookie) Enhanced it to handle both LINS files and UNIX fortune files.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2322
diff
changeset
|
51 ;; has been generalized so that it supports multiple simultaneous |
f8ae5fc2c196
(cookie) Enhanced it to handle both LINS files and UNIX fortune files.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2322
diff
changeset
|
52 ;; cookie databases and fortune files. It is intended to be called |
f8ae5fc2c196
(cookie) Enhanced it to handle both LINS files and UNIX fortune files.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2322
diff
changeset
|
53 ;; from other packages such as yow.el and spook.el. |
2322 | 54 ;; |
55 ;; TO DO: teach cookie-snarf to auto-detect ITS PINS or UNIX fortune(6) | |
56 ;; format and do the right thing. | |
2321 | 57 |
58 ;;; Code: | |
59 | |
60 ; Randomize the seed in the random number generator. | |
61 (random t) | |
62 | |
20887
bb0f5fde5973
(cookie-snarf): Use match-beginning on the delimiter.
Richard M. Stallman <rms@gnu.org>
parents:
14307
diff
changeset
|
63 (defconst cookie-delimiter "\n%%\n\\|\n%\n\\|\0" |
2321 | 64 "Delimiter used to separate cookie file entries.") |
65 | |
4090
afa2afad53c4
(cookie-cache): New defvar.
Roland McGrath <roland@gnu.org>
parents:
3432
diff
changeset
|
66 (defvar cookie-cache (make-vector 511 0) |
afa2afad53c4
(cookie-cache): New defvar.
Roland McGrath <roland@gnu.org>
parents:
3432
diff
changeset
|
67 "Cache of cookie files that have already been snarfed.") |
afa2afad53c4
(cookie-cache): New defvar.
Roland McGrath <roland@gnu.org>
parents:
3432
diff
changeset
|
68 |
4151
e6d5beaca907
(cookie, cookie-insert, cookie-snarf, shuffle-vector): Autoload these.
Roland McGrath <roland@gnu.org>
parents:
4090
diff
changeset
|
69 ;;;###autoload |
2321 | 70 (defun cookie (phrase-file startmsg endmsg) |
41666
5cd64b3e28c3
(cookie, cookie-insert, shuffle-vector): Doc fixes.
Pavel Janík <Pavel@Janik.cz>
parents:
30858
diff
changeset
|
71 "Return a random phrase from PHRASE-FILE. |
5cd64b3e28c3
(cookie, cookie-insert, shuffle-vector): Doc fixes.
Pavel Janík <Pavel@Janik.cz>
parents:
30858
diff
changeset
|
72 When the phrase file is read in, display STARTMSG at the beginning |
5cd64b3e28c3
(cookie, cookie-insert, shuffle-vector): Doc fixes.
Pavel Janík <Pavel@Janik.cz>
parents:
30858
diff
changeset
|
73 of load, ENDMSG at the end." |
2321 | 74 (let ((cookie-vector (cookie-snarf phrase-file startmsg endmsg))) |
75 (shuffle-vector cookie-vector) | |
71413
e04e474d258e
lisp/play/cookie1.el (cookie): Work properly when there's only one entry
Miles Bader <miles@gnu.org>
parents:
68634
diff
changeset
|
76 (aref cookie-vector 0))) |
2321 | 77 |
4151
e6d5beaca907
(cookie, cookie-insert, cookie-snarf, shuffle-vector): Autoload these.
Roland McGrath <roland@gnu.org>
parents:
4090
diff
changeset
|
78 ;;;###autoload |
2321 | 79 (defun cookie-insert (phrase-file &optional count startmsg endmsg) |
41666
5cd64b3e28c3
(cookie, cookie-insert, shuffle-vector): Doc fixes.
Pavel Janík <Pavel@Janik.cz>
parents:
30858
diff
changeset
|
80 "Insert random phrases from PHRASE-FILE; COUNT of them. |
5cd64b3e28c3
(cookie, cookie-insert, shuffle-vector): Doc fixes.
Pavel Janík <Pavel@Janik.cz>
parents:
30858
diff
changeset
|
81 When the phrase file is read in, display STARTMSG at the beginning |
5cd64b3e28c3
(cookie, cookie-insert, shuffle-vector): Doc fixes.
Pavel Janík <Pavel@Janik.cz>
parents:
30858
diff
changeset
|
82 of load, ENDMSG at the end." |
2321 | 83 (let ((cookie-vector (cookie-snarf phrase-file startmsg endmsg))) |
84 (shuffle-vector cookie-vector) | |
85 (let ((start (point))) | |
86 (insert ?\n) | |
87 (cookie1 (min (- (length cookie-vector) 1) (or count 1)) cookie-vector) | |
88 (insert ?\n) | |
89 (fill-region-as-paragraph start (point) nil)))) | |
90 | |
91 (defun cookie1 (arg cookie-vec) | |
92 "Inserts a cookie phrase ARG times." | |
93 (cond ((zerop arg) t) | |
94 (t (insert (aref cookie-vec arg)) | |
95 (insert " ") | |
96 (cookie1 (1- arg) cookie-vec)))) | |
97 | |
4151
e6d5beaca907
(cookie, cookie-insert, cookie-snarf, shuffle-vector): Autoload these.
Roland McGrath <roland@gnu.org>
parents:
4090
diff
changeset
|
98 ;;;###autoload |
2321 | 99 (defun cookie-snarf (phrase-file startmsg endmsg) |
4736
6aeb2227ed30
(read-cookie): New function.
Roland McGrath <roland@gnu.org>
parents:
4405
diff
changeset
|
100 "Reads in the PHRASE-FILE, returns it as a vector of strings. |
6aeb2227ed30
(read-cookie): New function.
Roland McGrath <roland@gnu.org>
parents:
4405
diff
changeset
|
101 Emit STARTMSG and ENDMSG before and after. Caches the result; second |
6aeb2227ed30
(read-cookie): New function.
Roland McGrath <roland@gnu.org>
parents:
4405
diff
changeset
|
102 and subsequent calls on the same file won't go to disk." |
4090
afa2afad53c4
(cookie-cache): New defvar.
Roland McGrath <roland@gnu.org>
parents:
3432
diff
changeset
|
103 (let ((sym (intern-soft phrase-file cookie-cache))) |
afa2afad53c4
(cookie-cache): New defvar.
Roland McGrath <roland@gnu.org>
parents:
3432
diff
changeset
|
104 (and sym (not (equal (symbol-function sym) |
afa2afad53c4
(cookie-cache): New defvar.
Roland McGrath <roland@gnu.org>
parents:
3432
diff
changeset
|
105 (nth 5 (file-attributes phrase-file)))) |
afa2afad53c4
(cookie-cache): New defvar.
Roland McGrath <roland@gnu.org>
parents:
3432
diff
changeset
|
106 (yes-or-no-p (concat phrase-file |
afa2afad53c4
(cookie-cache): New defvar.
Roland McGrath <roland@gnu.org>
parents:
3432
diff
changeset
|
107 " has changed. Read new contents? ")) |
afa2afad53c4
(cookie-cache): New defvar.
Roland McGrath <roland@gnu.org>
parents:
3432
diff
changeset
|
108 (setq sym nil)) |
afa2afad53c4
(cookie-cache): New defvar.
Roland McGrath <roland@gnu.org>
parents:
3432
diff
changeset
|
109 (if sym |
afa2afad53c4
(cookie-cache): New defvar.
Roland McGrath <roland@gnu.org>
parents:
3432
diff
changeset
|
110 (symbol-value sym) |
afa2afad53c4
(cookie-cache): New defvar.
Roland McGrath <roland@gnu.org>
parents:
3432
diff
changeset
|
111 (setq sym (intern phrase-file cookie-cache)) |
14307
8f846c3889c8
(cookie-snarf): Pass proper format string to message.
Karl Heuer <kwzh@gnu.org>
parents:
14169
diff
changeset
|
112 (message "%s" startmsg) |
4090
afa2afad53c4
(cookie-cache): New defvar.
Roland McGrath <roland@gnu.org>
parents:
3432
diff
changeset
|
113 (save-excursion |
afa2afad53c4
(cookie-cache): New defvar.
Roland McGrath <roland@gnu.org>
parents:
3432
diff
changeset
|
114 (let ((buf (generate-new-buffer "*cookie*")) |
afa2afad53c4
(cookie-cache): New defvar.
Roland McGrath <roland@gnu.org>
parents:
3432
diff
changeset
|
115 (result nil)) |
afa2afad53c4
(cookie-cache): New defvar.
Roland McGrath <roland@gnu.org>
parents:
3432
diff
changeset
|
116 (set-buffer buf) |
afa2afad53c4
(cookie-cache): New defvar.
Roland McGrath <roland@gnu.org>
parents:
3432
diff
changeset
|
117 (fset sym (nth 5 (file-attributes phrase-file))) |
afa2afad53c4
(cookie-cache): New defvar.
Roland McGrath <roland@gnu.org>
parents:
3432
diff
changeset
|
118 (insert-file-contents (expand-file-name phrase-file)) |
afa2afad53c4
(cookie-cache): New defvar.
Roland McGrath <roland@gnu.org>
parents:
3432
diff
changeset
|
119 (re-search-forward cookie-delimiter) |
afa2afad53c4
(cookie-cache): New defvar.
Roland McGrath <roland@gnu.org>
parents:
3432
diff
changeset
|
120 (while (progn (skip-chars-forward " \t\n\r\f") (not (eobp))) |
afa2afad53c4
(cookie-cache): New defvar.
Roland McGrath <roland@gnu.org>
parents:
3432
diff
changeset
|
121 (let ((beg (point))) |
afa2afad53c4
(cookie-cache): New defvar.
Roland McGrath <roland@gnu.org>
parents:
3432
diff
changeset
|
122 (re-search-forward cookie-delimiter) |
20887
bb0f5fde5973
(cookie-snarf): Use match-beginning on the delimiter.
Richard M. Stallman <rms@gnu.org>
parents:
14307
diff
changeset
|
123 (setq result (cons (buffer-substring beg (match-beginning 0)) |
4090
afa2afad53c4
(cookie-cache): New defvar.
Roland McGrath <roland@gnu.org>
parents:
3432
diff
changeset
|
124 result)))) |
afa2afad53c4
(cookie-cache): New defvar.
Roland McGrath <roland@gnu.org>
parents:
3432
diff
changeset
|
125 (kill-buffer buf) |
14307
8f846c3889c8
(cookie-snarf): Pass proper format string to message.
Karl Heuer <kwzh@gnu.org>
parents:
14169
diff
changeset
|
126 (message "%s" endmsg) |
4090
afa2afad53c4
(cookie-cache): New defvar.
Roland McGrath <roland@gnu.org>
parents:
3432
diff
changeset
|
127 (set sym (apply 'vector result))))))) |
2321 | 128 |
4736
6aeb2227ed30
(read-cookie): New function.
Roland McGrath <roland@gnu.org>
parents:
4405
diff
changeset
|
129 (defun read-cookie (prompt phrase-file startmsg endmsg &optional require-match) |
6aeb2227ed30
(read-cookie): New function.
Roland McGrath <roland@gnu.org>
parents:
4405
diff
changeset
|
130 "Prompt with PROMPT and read with completion among cookies in PHRASE-FILE. |
6aeb2227ed30
(read-cookie): New function.
Roland McGrath <roland@gnu.org>
parents:
4405
diff
changeset
|
131 STARTMSG and ENDMSG are passed along to `cookie-snarf'. |
6aeb2227ed30
(read-cookie): New function.
Roland McGrath <roland@gnu.org>
parents:
4405
diff
changeset
|
132 Optional fifth arg REQUIRE-MATCH non-nil forces a matching cookie." |
6aeb2227ed30
(read-cookie): New function.
Roland McGrath <roland@gnu.org>
parents:
4405
diff
changeset
|
133 ;; Make sure the cookies are in the cache. |
6aeb2227ed30
(read-cookie): New function.
Roland McGrath <roland@gnu.org>
parents:
4405
diff
changeset
|
134 (or (intern-soft phrase-file cookie-cache) |
6aeb2227ed30
(read-cookie): New function.
Roland McGrath <roland@gnu.org>
parents:
4405
diff
changeset
|
135 (cookie-snarf phrase-file startmsg endmsg)) |
6aeb2227ed30
(read-cookie): New function.
Roland McGrath <roland@gnu.org>
parents:
4405
diff
changeset
|
136 (completing-read prompt |
6aeb2227ed30
(read-cookie): New function.
Roland McGrath <roland@gnu.org>
parents:
4405
diff
changeset
|
137 (let ((sym (intern phrase-file cookie-cache))) |
6aeb2227ed30
(read-cookie): New function.
Roland McGrath <roland@gnu.org>
parents:
4405
diff
changeset
|
138 ;; We cache the alist form of the cookie in a property. |
6aeb2227ed30
(read-cookie): New function.
Roland McGrath <roland@gnu.org>
parents:
4405
diff
changeset
|
139 (or (get sym 'completion-alist) |
6aeb2227ed30
(read-cookie): New function.
Roland McGrath <roland@gnu.org>
parents:
4405
diff
changeset
|
140 (let* ((alist nil) |
6aeb2227ed30
(read-cookie): New function.
Roland McGrath <roland@gnu.org>
parents:
4405
diff
changeset
|
141 (vec (cookie-snarf phrase-file |
6aeb2227ed30
(read-cookie): New function.
Roland McGrath <roland@gnu.org>
parents:
4405
diff
changeset
|
142 startmsg endmsg)) |
6aeb2227ed30
(read-cookie): New function.
Roland McGrath <roland@gnu.org>
parents:
4405
diff
changeset
|
143 (i (length vec))) |
6aeb2227ed30
(read-cookie): New function.
Roland McGrath <roland@gnu.org>
parents:
4405
diff
changeset
|
144 (while (> (setq i (1- i)) 0) |
6aeb2227ed30
(read-cookie): New function.
Roland McGrath <roland@gnu.org>
parents:
4405
diff
changeset
|
145 (setq alist (cons (list (aref vec i)) alist))) |
6aeb2227ed30
(read-cookie): New function.
Roland McGrath <roland@gnu.org>
parents:
4405
diff
changeset
|
146 (put sym 'completion-alist alist)))) |
6aeb2227ed30
(read-cookie): New function.
Roland McGrath <roland@gnu.org>
parents:
4405
diff
changeset
|
147 nil require-match nil nil)) |
6aeb2227ed30
(read-cookie): New function.
Roland McGrath <roland@gnu.org>
parents:
4405
diff
changeset
|
148 |
2321 | 149 ; Thanks to Ian G Batten <BattenIG@CS.BHAM.AC.UK> |
150 ; [of the University of Birmingham Computer Science Department] | |
151 ; for the iterative version of this shuffle. | |
152 ; | |
4151
e6d5beaca907
(cookie, cookie-insert, cookie-snarf, shuffle-vector): Autoload these.
Roland McGrath <roland@gnu.org>
parents:
4090
diff
changeset
|
153 ;;;###autoload |
2321 | 154 (defun shuffle-vector (vector) |
41666
5cd64b3e28c3
(cookie, cookie-insert, shuffle-vector): Doc fixes.
Pavel Janík <Pavel@Janik.cz>
parents:
30858
diff
changeset
|
155 "Randomly permute the elements of VECTOR (all permutations equally likely)." |
2321 | 156 (let ((i 0) |
157 j | |
158 temp | |
159 (len (length vector))) | |
160 (while (< i len) | |
4405 | 161 (setq j (+ i (random (- len i)))) |
2321 | 162 (setq temp (aref vector i)) |
163 (aset vector i (aref vector j)) | |
164 (aset vector j temp) | |
165 (setq i (1+ i)))) | |
166 vector) | |
167 | |
3388 | 168 (provide 'cookie1) |
2321 | 169 |
93975
1e3a407766b9
Fix up comment convention on the arch-tag lines.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
79716
diff
changeset
|
170 ;; arch-tag: 4a8a8712-df6a-4f34-b030-108a1b47f9f2 |
3432 | 171 ;;; cookie1.el ends here |