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