1;;; cookie1.el --- retrieve random phrases from fortune cookie files 2 3;; Copyright (C) 1993, 2001, 2002, 2003, 2004, 2005, 4;; 2006, 2007 Free Software Foundation, Inc. 5 6;; Author: Eric S. Raymond <esr@snark.thyrsus.com> 7;; Maintainer: FSF 8;; Keywords: games, extensions 9;; Created: Mon Mar 22 17:06:26 1993 10 11;; This file is part of GNU Emacs. 12 13;; GNU Emacs is free software; you can redistribute it and/or modify 14;; it under the terms of the GNU General Public License as published by 15;; the Free Software Foundation; either version 2, or (at your option) 16;; any later version. 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 24;; along with GNU Emacs; see the file COPYING. If not, write to the 25;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 26;; Boston, MA 02110-1301, USA. 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;; strfile(1) is the program used to compile the files for fortune(6). 49;; In order to achieve total compatibility with strfile(1), cookie files 50;; should start with two consecutive delimiters (and no comment). 51;; 52;; This code derives from Steve Strassman's 1987 spook.el package, but 53;; has been generalized so that it supports multiple simultaneous 54;; cookie databases and fortune files. It is intended to be called 55;; from other packages such as yow.el and spook.el. 56;; 57;; TO DO: teach cookie-snarf to auto-detect ITS PINS or UNIX fortune(6) 58;; format and do the right thing. 59 60;;; Code: 61 62; Randomize the seed in the random number generator. 63(random t) 64 65(defconst cookie-delimiter "\n%%\n\\|\n%\n\\|\0" 66 "Delimiter used to separate cookie file entries.") 67 68(defvar cookie-cache (make-vector 511 0) 69 "Cache of cookie files that have already been snarfed.") 70 71;;;###autoload 72(defun cookie (phrase-file startmsg endmsg) 73 "Return a random phrase from PHRASE-FILE. 74When the phrase file is read in, display STARTMSG at the beginning 75of load, ENDMSG at the end." 76 (let ((cookie-vector (cookie-snarf phrase-file startmsg endmsg))) 77 (shuffle-vector cookie-vector) 78 (aref cookie-vector 0))) 79 80;;;###autoload 81(defun cookie-insert (phrase-file &optional count startmsg endmsg) 82 "Insert random phrases from PHRASE-FILE; COUNT of them. 83When the phrase file is read in, display STARTMSG at the beginning 84of load, ENDMSG at the end." 85 (let ((cookie-vector (cookie-snarf phrase-file startmsg endmsg))) 86 (shuffle-vector cookie-vector) 87 (let ((start (point))) 88 (insert ?\n) 89 (cookie1 (min (- (length cookie-vector) 1) (or count 1)) cookie-vector) 90 (insert ?\n) 91 (fill-region-as-paragraph start (point) nil)))) 92 93(defun cookie1 (arg cookie-vec) 94 "Inserts a cookie phrase ARG times." 95 (cond ((zerop arg) t) 96 (t (insert (aref cookie-vec arg)) 97 (insert " ") 98 (cookie1 (1- arg) cookie-vec)))) 99 100;;;###autoload 101(defun cookie-snarf (phrase-file startmsg endmsg) 102 "Reads in the PHRASE-FILE, returns it as a vector of strings. 103Emit STARTMSG and ENDMSG before and after. Caches the result; second 104and subsequent calls on the same file won't go to disk." 105 (let ((sym (intern-soft phrase-file cookie-cache))) 106 (and sym (not (equal (symbol-function sym) 107 (nth 5 (file-attributes phrase-file)))) 108 (yes-or-no-p (concat phrase-file 109 " has changed. Read new contents? ")) 110 (setq sym nil)) 111 (if sym 112 (symbol-value sym) 113 (setq sym (intern phrase-file cookie-cache)) 114 (message "%s" startmsg) 115 (save-excursion 116 (let ((buf (generate-new-buffer "*cookie*")) 117 (result nil)) 118 (set-buffer buf) 119 (fset sym (nth 5 (file-attributes phrase-file))) 120 (insert-file-contents (expand-file-name phrase-file)) 121 (re-search-forward cookie-delimiter) 122 (while (progn (skip-chars-forward " \t\n\r\f") (not (eobp))) 123 (let ((beg (point))) 124 (re-search-forward cookie-delimiter) 125 (setq result (cons (buffer-substring beg (match-beginning 0)) 126 result)))) 127 (kill-buffer buf) 128 (message "%s" endmsg) 129 (set sym (apply 'vector result))))))) 130 131(defun read-cookie (prompt phrase-file startmsg endmsg &optional require-match) 132 "Prompt with PROMPT and read with completion among cookies in PHRASE-FILE. 133STARTMSG and ENDMSG are passed along to `cookie-snarf'. 134Optional fifth arg REQUIRE-MATCH non-nil forces a matching cookie." 135 ;; Make sure the cookies are in the cache. 136 (or (intern-soft phrase-file cookie-cache) 137 (cookie-snarf phrase-file startmsg endmsg)) 138 (completing-read prompt 139 (let ((sym (intern phrase-file cookie-cache))) 140 ;; We cache the alist form of the cookie in a property. 141 (or (get sym 'completion-alist) 142 (let* ((alist nil) 143 (vec (cookie-snarf phrase-file 144 startmsg endmsg)) 145 (i (length vec))) 146 (while (> (setq i (1- i)) 0) 147 (setq alist (cons (list (aref vec i)) alist))) 148 (put sym 'completion-alist alist)))) 149 nil require-match nil nil)) 150 151; Thanks to Ian G Batten <BattenIG@CS.BHAM.AC.UK> 152; [of the University of Birmingham Computer Science Department] 153; for the iterative version of this shuffle. 154; 155;;;###autoload 156(defun shuffle-vector (vector) 157 "Randomly permute the elements of VECTOR (all permutations equally likely)." 158 (let ((i 0) 159 j 160 temp 161 (len (length vector))) 162 (while (< i len) 163 (setq j (+ i (random (- len i)))) 164 (setq temp (aref vector i)) 165 (aset vector i (aref vector j)) 166 (aset vector j temp) 167 (setq i (1+ i)))) 168 vector) 169 170(provide 'cookie1) 171 172;;; arch-tag: 4a8a8712-df6a-4f34-b030-108a1b47f9f2 173;;; cookie1.el ends here 174