Mercurial > emacs
annotate lisp/play/cookie1.el @ 3647:cf5972f69f8a
* frame.el (frame-initialize): Remember to actually traverse
initial-frame-alist.
author | Jim Blandy <jimb@redhat.com> |
---|---|
date | Fri, 11 Jun 1993 11:33:31 +0000 |
parents | 972428ca06b6 |
children | afa2afad53c4 |
rev | line source |
---|---|
3383 | 1 ;;; cookie1.el --- retrieve random phrases from fortune cookie files |
2321 | 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 GNU Emacs. | |
11 | |
12 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
13 ;; it 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 ;; 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 | |
23 ;; along with GNU Emacs; see the file COPYING. If not, write to | |
24 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | |
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 | |
33 ;; functions `pick-random' and `shuffle-vector' may be of interest to | |
34 ;; programmers. | |
35 ;; | |
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
|
36 ;; 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
|
37 ;; |
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 ;; * 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
|
39 ;; 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
|
40 ;; |
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 ;; * 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
|
42 ;; |
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 ;; 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
|
44 ;; 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
|
45 ;; `cookie-delimiter'. |
2321 | 46 ;; |
47 ;; 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
|
48 ;; 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
|
49 ;; 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
|
50 ;; from other packages such as yow.el and spook.el. |
2322 | 51 ;; |
52 ;; TO DO: teach cookie-snarf to auto-detect ITS PINS or UNIX fortune(6) | |
53 ;; format and do the right thing. | |
2321 | 54 |
55 ;;; Code: | |
56 | |
57 ; Randomize the seed in the random number generator. | |
58 (random t) | |
59 | |
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
|
60 (defconst cookie-delimiter "\n%%\n\\|\0" |
2321 | 61 "Delimiter used to separate cookie file entries.") |
62 | |
63 (defun cookie (phrase-file startmsg endmsg) | |
64 "Return a random phrase from PHRASE-FILE. When the phrase file | |
65 is read in, display STARTMSG at beginning of load, ENDMSG at end." | |
66 (let ((cookie-vector (cookie-snarf phrase-file startmsg endmsg))) | |
67 (shuffle-vector cookie-vector) | |
68 (aref cookie-vector 1))) | |
69 | |
70 (defun cookie-insert (phrase-file &optional count startmsg endmsg) | |
71 "Insert random phrases from PHRASE-FILE; COUNT of them. When the phrase file | |
72 is read in, display STARTMSG at beginning of load, ENDMSG at end." | |
73 (let ((cookie-vector (cookie-snarf phrase-file startmsg endmsg))) | |
74 (shuffle-vector cookie-vector) | |
75 (let ((start (point))) | |
76 (insert ?\n) | |
77 (cookie1 (min (- (length cookie-vector) 1) (or count 1)) cookie-vector) | |
78 (insert ?\n) | |
79 (fill-region-as-paragraph start (point) nil)))) | |
80 | |
81 (defun cookie1 (arg cookie-vec) | |
82 "Inserts a cookie phrase ARG times." | |
83 (cond ((zerop arg) t) | |
84 (t (insert (aref cookie-vec arg)) | |
85 (insert " ") | |
86 (cookie1 (1- arg) cookie-vec)))) | |
87 | |
88 (defun cookie-snarf (phrase-file startmsg endmsg) | |
89 "Reads in the PHRASE-FILE, returns it as a vector of strings. Emit | |
90 STARTMSG and ENDMSG before and after. Caches the result; second and | |
91 subsequent calls on the same file won't go to disk." | |
92 (if (boundp (intern phrase-file)) | |
93 (eval (intern phrase-file)) | |
94 (message startmsg) | |
95 (save-excursion | |
96 (let ((buf (generate-new-buffer "*cookie*")) | |
97 (result nil)) | |
98 (set-buffer buf) | |
99 (insert-file-contents (expand-file-name phrase-file)) | |
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
|
100 (re-search-forward cookie-delimiter) |
2321 | 101 (while (progn (skip-chars-forward " \t\n\r\f") (not (eobp))) |
102 (let ((beg (point))) | |
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
|
103 (re-search-forward cookie-delimiter) |
2321 | 104 (setq result (cons (buffer-substring beg (1- (point))) |
105 result)))) | |
106 (kill-buffer buf) | |
107 (message endmsg) | |
108 (set (intern phrase-file) (apply 'vector result)))))) | |
109 | |
110 (defun pick-random (n) | |
111 "Returns a random number from 0 to N-1 inclusive." | |
112 (% (logand 0777777 (random)) n)) | |
113 | |
114 ; Thanks to Ian G Batten <BattenIG@CS.BHAM.AC.UK> | |
115 ; [of the University of Birmingham Computer Science Department] | |
116 ; for the iterative version of this shuffle. | |
117 ; | |
118 (defun shuffle-vector (vector) | |
119 "Randomly permute the elements of VECTOR (all permutations equally likely)" | |
120 (let ((i 0) | |
121 j | |
122 temp | |
123 (len (length vector))) | |
124 (while (< i len) | |
125 (setq j (+ i (pick-random (- len i)))) | |
126 (setq temp (aref vector i)) | |
127 (aset vector i (aref vector j)) | |
128 (aset vector j temp) | |
129 (setq i (1+ i)))) | |
130 vector) | |
131 | |
3388 | 132 (provide 'cookie1) |
2321 | 133 |
3432 | 134 ;;; cookie1.el ends here |