annotate lisp/play/cookie1.el @ 2372:ad7cb938ae08

* xselect.c (SELECTION_QUANTUM): Don't use XMaxRequestSize on R3; access the display structure directly.
author Jim Blandy <jimb@redhat.com>
date Thu, 25 Mar 1993 23:27:42 +0000
parents a7ea7887481f
children f8ae5fc2c196
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
2321
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1 ;;; cookie.el --- retrieve random phrases from fortune cookie files
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
3 ;; Copyright (C) 1993 Free Software Foundation, Inc.
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
4
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
5 ;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
6 ;; Maintainer: FSF
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
7 ;; Keywords: games
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
8 ;; Created: Mon Mar 22 17:06:26 1993
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
9
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
10 ;; This file is part of GNU Emacs.
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
11
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
12 ;; GNU Emacs is free software; you can redistribute it and/or modify
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
13 ;; it under the terms of the GNU General Public License as published by
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
14 ;; the Free Software Foundation; either version 2, or (at your option)
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
15 ;; any later version.
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
16
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
17 ;; GNU Emacs is distributed in the hope that it will be useful,
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
20 ;; GNU General Public License for more details.
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
21
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
22 ;; You should have received a copy of the GNU General Public License
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
23 ;; along with GNU Emacs; see the file COPYING. If not, write to
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
24 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
25
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
26 ;;; Commentary:
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
27
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
28 ;; Support for random cookie fetches from phrase files, used for such
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
29 ;; critical applications as emulating Zippy the Pinhead and confounding
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
30 ;; the NSA Trunk Trawler.
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
31 ;;
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
32 ;; The two entry points are `cookie' and `cookie-insert'. The helper
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
33 ;; functions `pick-random' and `shuffle-vector' may be of interest to
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
34 ;; programmers.
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
35 ;;
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
36 ;; The code expects phrase files to be in ITS-style LINS format
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
37 ;; (strings terminated by ASCII 0 characters, leading whitespace
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
38 ;; ignored). Everything up to the first delimiter is treated as a
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
39 ;; comment. Other formats (notably UNIX fortune-file format) could
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
40 ;; easily be supported by changing the `cookie-delimiter' constant.
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
41 ;;
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
42 ;; This code derives from Steve Strassman's 1987 spook.el package, but
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
43 ;; has been generalized so that it supports multiple simultaneous cookie
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
44 ;; databases. It is intended to be called from other packages such as
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
45 ;; yow.el and spook.el.
2322
a7ea7887481f Add TO-DO list.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2321
diff changeset
46 ;;
a7ea7887481f Add TO-DO list.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2321
diff changeset
47 ;; TO DO: teach cookie-snarf to auto-detect ITS PINS or UNIX fortune(6)
a7ea7887481f Add TO-DO list.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2321
diff changeset
48 ;; format and do the right thing.
2321
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
49
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
50 ;;; Code:
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
51
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
52 ; Randomize the seed in the random number generator.
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
53 (random t)
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
54
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
55 (defconst cookie-delimiter "\0"
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
56 "Delimiter used to separate cookie file entries.")
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
57
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
58 (defun cookie (phrase-file startmsg endmsg)
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
59 "Return a random phrase from PHRASE-FILE. When the phrase file
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
60 is read in, display STARTMSG at beginning of load, ENDMSG at end."
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
61 (let ((cookie-vector (cookie-snarf phrase-file startmsg endmsg)))
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
62 (shuffle-vector cookie-vector)
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
63 (aref cookie-vector 1)))
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
64
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
65 (defun cookie-insert (phrase-file &optional count startmsg endmsg)
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
66 "Insert random phrases from PHRASE-FILE; COUNT of them. When the phrase file
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
67 is read in, display STARTMSG at beginning of load, ENDMSG at end."
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
68 (let ((cookie-vector (cookie-snarf phrase-file startmsg endmsg)))
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
69 (shuffle-vector cookie-vector)
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
70 (let ((start (point)))
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
71 (insert ?\n)
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
72 (cookie1 (min (- (length cookie-vector) 1) (or count 1)) cookie-vector)
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
73 (insert ?\n)
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
74 (fill-region-as-paragraph start (point) nil))))
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
75
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
76 (defun cookie1 (arg cookie-vec)
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
77 "Inserts a cookie phrase ARG times."
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
78 (cond ((zerop arg) t)
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
79 (t (insert (aref cookie-vec arg))
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
80 (insert " ")
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
81 (cookie1 (1- arg) cookie-vec))))
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
82
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
83 (defun cookie-snarf (phrase-file startmsg endmsg)
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
84 "Reads in the PHRASE-FILE, returns it as a vector of strings. Emit
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
85 STARTMSG and ENDMSG before and after. Caches the result; second and
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
86 subsequent calls on the same file won't go to disk."
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
87 (if (boundp (intern phrase-file))
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
88 (eval (intern phrase-file))
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
89 (message startmsg)
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
90 (save-excursion
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
91 (let ((buf (generate-new-buffer "*cookie*"))
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
92 (result nil))
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
93 (set-buffer buf)
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
94 (insert-file-contents (expand-file-name phrase-file))
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
95 (search-forward cookie-delimiter)
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
96 (while (progn (skip-chars-forward " \t\n\r\f") (not (eobp)))
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
97 (let ((beg (point)))
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
98 (search-forward "\0")
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
99 (setq result (cons (buffer-substring beg (1- (point)))
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
100 result))))
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
101 (kill-buffer buf)
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
102 (message endmsg)
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
103 (set (intern phrase-file) (apply 'vector result))))))
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
104
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
105 (defun pick-random (n)
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
106 "Returns a random number from 0 to N-1 inclusive."
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
107 (% (logand 0777777 (random)) n))
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
108
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
109 ; Thanks to Ian G Batten <BattenIG@CS.BHAM.AC.UK>
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
110 ; [of the University of Birmingham Computer Science Department]
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
111 ; for the iterative version of this shuffle.
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
112 ;
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
113 (defun shuffle-vector (vector)
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
114 "Randomly permute the elements of VECTOR (all permutations equally likely)"
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
115 (let ((i 0)
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
116 j
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
117 temp
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
118 (len (length vector)))
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
119 (while (< i len)
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
120 (setq j (+ i (pick-random (- len i))))
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
121 (setq temp (aref vector i))
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
122 (aset vector i (aref vector j))
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
123 (aset vector j temp)
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
124 (setq i (1+ i))))
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
125 vector)
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
126
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
127 (provide 'cookie)
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
128
63128ec90cfe Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
129 ;;; cookie.el ends here