annotate lisp/play/yow.el @ 46:ca2ddc6f6950

Initial revision
author Richard M. Stallman <rms@gnu.org>
date Wed, 31 Jan 1990 17:24:10 +0000
parents
children 7e4c7ef44243
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
46
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1 ;; Copyright (C) 1985, 1987 Free Software Foundation, Inc.
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
3 ;; This file is part of GNU Emacs.
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
4
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
5 ;; GNU Emacs is free software; you can redistribute it and/or modify
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
6 ;; it under the terms of the GNU General Public License as published by
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
7 ;; the Free Software Foundation; either version 1, or (at your option)
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
8 ;; any later version.
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
9
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
10 ;; GNU Emacs is distributed in the hope that it will be useful,
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
11 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
12 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
13 ;; GNU General Public License for more details.
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
14
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
15 ;; You should have received a copy of the GNU General Public License
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
16 ;; along with GNU Emacs; see the file COPYING. If not, write to
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
17 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
18
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
19 (provide 'yow)
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
20
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
21 ; Randomize the seed in the random number generator.
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
22 (random t)
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
23
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
24 ; Important pinheaddery for GNU Emacs.
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
25 ; Expects file emacs/etc/yow.lines to be in ITS-style LINS format
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
26 ; (ie strings terminated by ascii 0 characters. Leading whitespace ignored)
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
27 ; Everything up to the first \000 is a comment.
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
28 (defun yow (&optional n interactive)
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
29 "Return or display a Zippy quotation."
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
30 (interactive "P\np")
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
31 (if (null yow-vector)
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
32 (setq yow-vector (snarf-yows)))
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
33 (cond (n (setq n (prefix-numeric-value n)))
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
34 ((>= (setq n (random (length yow-vector))) 0))
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
35 (t (setq n (- n))))
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
36 (let ((yow (aref yow-vector n)))
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
37 (cond ((not interactive)
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
38 yow)
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
39 ((not (string-match "\n" yow))
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
40 (delete-windows-on (get-buffer-create "*Help*"))
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
41 (message "%s" yow))
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
42 (t
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
43 (message "Yow!")
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
44 (with-output-to-temp-buffer "*Help*"
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
45 (princ yow))))))
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
46
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
47 (defvar yow-vector nil "Pertinent pinhead statements")
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
48 (defun snarf-yows (&optional file)
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
49 (save-excursion
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
50 (let ((buf (generate-new-buffer " yow"))
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
51 (result '())
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
52 (cursor-in-echo-area t))
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
53 (message "Am I CONSING yet?...")
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
54 (set-buffer buf)
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
55 (insert-file-contents (or file
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
56 (expand-file-name "yow.lines" exec-directory)))
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
57 (search-forward "\0")
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
58 (while (progn (skip-chars-forward " \t\n\r\f") (not (eobp)))
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
59 (let ((beg (point)))
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
60 (search-forward "\0")
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
61 (setq result (cons (buffer-substring beg (1- (point)))
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
62 result))))
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
63 (kill-buffer buf)
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
64 (message "I have SEEN the CONSING!!" (length result))
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
65 (apply 'vector (nreverse result)))))
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
66
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
67 ; Yowza!! Feed zippy quotes to the doctor. Watch results.
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
68 ; fun, fun, fun. Entertainment for hours...
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
69 ;
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
70 ; written by Kayvan Aghaiepour
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
71
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
72 (defun psychoanalyze-pinhead ()
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
73 "Zippy goes to the analyst."
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
74 (interactive)
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
75 (doctor) ; start the psychotherapy
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
76 (if (null yow-vector)
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
77 (setq yow-vector (snarf-yows)))
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
78 (message "")
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
79 (switch-to-buffer "*doctor*")
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
80 (sit-for 0)
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
81 (while (not (input-pending-p))
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
82 (insert-string (yow))
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
83 (sit-for 0)
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
84 (doctor-ret-or-read 1)
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
85 (doctor-ret-or-read 1)))
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
86