|
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
|
|
|
24 ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
|
|
|
25
|
|
|
26 ;;; Synched up with: FSF 19.28.
|
|
|
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 ;; This code derives from Steve Strassman's 1987 spook.el package, but
|
|
|
49 ;; has been generalized so that it supports multiple simultaneous
|
|
|
50 ;; cookie databases and fortune files. It is intended to be called
|
|
|
51 ;; from other packages such as yow.el and spook.el.
|
|
|
52 ;;
|
|
|
53 ;; TO DO: teach cookie-snarf to auto-detect ITS PINS or UNIX fortune(6)
|
|
|
54 ;; format and do the right thing.
|
|
|
55
|
|
|
56 ;;; Code:
|
|
|
57
|
|
|
58 ; Randomize the seed in the random number generator.
|
|
|
59 (random t)
|
|
|
60
|
|
|
61 (defconst cookie-delimiter "\n%%\n\\|\0"
|
|
|
62 "Delimiter used to separate cookie file entries.")
|
|
|
63
|
|
|
64 (defvar cookie-cache (make-vector 511 0)
|
|
|
65 "Cache of cookie files that have already been snarfed.")
|
|
|
66
|
|
|
67 ;;;###autoload
|
|
|
68 (defun cookie (phrase-file startmsg endmsg)
|
|
|
69 "Return a random phrase from PHRASE-FILE. When the phrase file
|
|
|
70 is read in, display STARTMSG at beginning of load, ENDMSG at end."
|
|
|
71 (let ((cookie-vector (cookie-snarf phrase-file startmsg endmsg)))
|
|
|
72 (shuffle-vector cookie-vector)
|
|
|
73 (aref cookie-vector 1)))
|
|
|
74
|
|
|
75 ;;;###autoload
|
|
|
76 (defun cookie-insert (phrase-file &optional count startmsg endmsg)
|
|
|
77 "Insert random phrases from PHRASE-FILE; COUNT of them. When the phrase file
|
|
|
78 is read in, display STARTMSG at beginning of load, ENDMSG at end."
|
|
|
79 (let ((cookie-vector (cookie-snarf phrase-file startmsg endmsg)))
|
|
|
80 (shuffle-vector cookie-vector)
|
|
|
81 (let ((start (point)))
|
|
|
82 (insert ?\n)
|
|
|
83 (cookie1 (min (- (length cookie-vector) 1) (or count 1)) cookie-vector)
|
|
|
84 (insert ?\n)
|
|
|
85 (fill-region-as-paragraph start (point) nil))))
|
|
|
86
|
|
|
87 (defun cookie1 (arg cookie-vec)
|
|
|
88 "Inserts a cookie phrase ARG times."
|
|
|
89 (cond ((zerop arg) t)
|
|
|
90 (t (insert (aref cookie-vec arg))
|
|
|
91 (insert " ")
|
|
|
92 (cookie1 (1- arg) cookie-vec))))
|
|
|
93
|
|
|
94 ;;;###autoload
|
|
|
95 (defun cookie-snarf (phrase-file startmsg endmsg)
|
|
|
96 "Reads in the PHRASE-FILE, returns it as a vector of strings.
|
|
|
97 Emit STARTMSG and ENDMSG before and after. Caches the result; second
|
|
|
98 and subsequent calls on the same file won't go to disk."
|
|
|
99 (let ((sym (intern-soft phrase-file cookie-cache)))
|
|
|
100 (and sym (not (equal (symbol-function sym)
|
|
|
101 (nth 5 (file-attributes phrase-file))))
|
|
|
102 (yes-or-no-p (concat phrase-file
|
|
|
103 " has changed. Read new contents? "))
|
|
|
104 (setq sym nil))
|
|
|
105 (if sym
|
|
|
106 (symbol-value sym)
|
|
|
107 (setq sym (intern phrase-file cookie-cache))
|
|
|
108 (message startmsg)
|
|
|
109 (save-excursion
|
|
|
110 (let ((buf (generate-new-buffer "*cookie*"))
|
|
|
111 (result nil))
|
|
|
112 (set-buffer buf)
|
|
|
113 (fset sym (nth 5 (file-attributes phrase-file)))
|
|
|
114 (insert-file-contents (expand-file-name phrase-file))
|
|
|
115 (re-search-forward cookie-delimiter)
|
|
|
116 (while (progn (skip-chars-forward " \t\n\r\f") (not (eobp)))
|
|
|
117 (let ((beg (point)))
|
|
|
118 (re-search-forward cookie-delimiter)
|
|
|
119 ;; DBC --- here's the change
|
|
|
120 ;; This used to be (buffer-substring beg (1- (point))),
|
|
|
121 ;; which only worked if the regexp matched was one
|
|
|
122 ;; character long
|
|
|
123 (setq result (cons (buffer-substring beg
|
|
|
124 (match-beginning 0))
|
|
|
125 result))))
|
|
|
126 (kill-buffer buf)
|
|
|
127 (message endmsg)
|
|
|
128 (set sym (apply 'vector result)))))))
|
|
|
129
|
|
|
130 (defun read-cookie (prompt phrase-file startmsg endmsg &optional require-match)
|
|
|
131 "Prompt with PROMPT and read with completion among cookies in PHRASE-FILE.
|
|
|
132 STARTMSG and ENDMSG are passed along to `cookie-snarf'.
|
|
|
133 Optional fifth arg REQUIRE-MATCH non-nil forces a matching cookie."
|
|
|
134 ;; Make sure the cookies are in the cache.
|
|
|
135 (or (intern-soft phrase-file cookie-cache)
|
|
|
136 (cookie-snarf phrase-file startmsg endmsg))
|
|
|
137 (completing-read prompt
|
|
|
138 (let ((sym (intern phrase-file cookie-cache)))
|
|
|
139 ;; We cache the alist form of the cookie in a property.
|
|
|
140 (or (get sym 'completion-alist)
|
|
|
141 (let* ((alist nil)
|
|
|
142 (vec (cookie-snarf phrase-file
|
|
|
143 startmsg endmsg))
|
|
|
144 (i (length vec)))
|
|
|
145 (while (> (setq i (1- i)) 0)
|
|
|
146 (setq alist (cons (list (aref vec i)) alist)))
|
|
|
147 (put sym 'completion-alist alist))))
|
|
|
148 nil require-match nil nil))
|
|
|
149
|
|
|
150 ; Thanks to Ian G Batten <BattenIG@CS.BHAM.AC.UK>
|
|
|
151 ; [of the University of Birmingham Computer Science Department]
|
|
|
152 ; for the iterative version of this shuffle.
|
|
|
153 ;
|
|
|
154 ;;;###autoload
|
|
|
155 (defun shuffle-vector (vector)
|
|
|
156 "Randomly permute the elements of VECTOR (all permutations equally likely)"
|
|
|
157 (let ((i 0)
|
|
|
158 j
|
|
|
159 temp
|
|
|
160 (len (length vector)))
|
|
|
161 (while (< i len)
|
|
|
162 (setq j (+ i (random (- len i))))
|
|
|
163 (setq temp (aref vector i))
|
|
|
164 (aset vector i (aref vector j))
|
|
|
165 (aset vector j temp)
|
|
|
166 (setq i (1+ i))))
|
|
|
167 vector)
|
|
|
168
|
|
|
169 (provide 'cookie1)
|
|
|
170
|
|
|
171 ;;; cookie1.el ends here
|
