annotate lisp/play/yow.el @ 551:36827ee0a6df

*** empty log message ***
author Jim Blandy <jimb@redhat.com>
date Sun, 16 Feb 1992 04:14:10 +0000
parents 4cec2e6d4f9e
children 4cd7543be581
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.
256
7e4c7ef44243 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 46
diff changeset
28 ;;;###autoload
46
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
29 (defun yow (&optional n interactive)
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
30 "Return or display a Zippy quotation."
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
31 (interactive "P\np")
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
32 (if (null yow-vector)
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
33 (setq yow-vector (snarf-yows)))
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
34 (cond (n (setq n (prefix-numeric-value n)))
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
35 ((>= (setq n (random (length yow-vector))) 0))
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
36 (t (setq n (- n))))
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
37 (let ((yow (aref yow-vector n)))
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
38 (cond ((not interactive)
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
39 yow)
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
40 ((not (string-match "\n" yow))
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
41 (delete-windows-on (get-buffer-create "*Help*"))
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
42 (message "%s" yow))
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
43 (t
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
44 (message "Yow!")
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
45 (with-output-to-temp-buffer "*Help*"
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
46 (princ yow))))))
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
47
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
48 (defvar yow-vector nil "Pertinent pinhead statements")
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
49 (defun snarf-yows (&optional file)
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
50 (save-excursion
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
51 (let ((buf (generate-new-buffer " yow"))
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
52 (result '())
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
53 (cursor-in-echo-area t))
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
54 (message "Am I CONSING yet?...")
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
55 (set-buffer buf)
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
56 (insert-file-contents (or file
444
4cec2e6d4f9e *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 256
diff changeset
57 (expand-file-name "yow.lines" data-directory)))
46
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
58 (search-forward "\0")
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
59 (while (progn (skip-chars-forward " \t\n\r\f") (not (eobp)))
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
60 (let ((beg (point)))
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
61 (search-forward "\0")
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
62 (setq result (cons (buffer-substring beg (1- (point)))
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
63 result))))
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
64 (kill-buffer buf)
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
65 (message "I have SEEN the CONSING!!" (length result))
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
66 (apply 'vector (nreverse result)))))
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
67
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
68 ; Yowza!! Feed zippy quotes to the doctor. Watch results.
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
69 ; fun, fun, fun. Entertainment for hours...
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
70 ;
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
71 ; written by Kayvan Aghaiepour
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
72
256
7e4c7ef44243 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 46
diff changeset
73 ;;;###autoload
46
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
74 (defun psychoanalyze-pinhead ()
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
75 "Zippy goes to the analyst."
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
76 (interactive)
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
77 (doctor) ; start the psychotherapy
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
78 (if (null yow-vector)
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
79 (setq yow-vector (snarf-yows)))
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
80 (message "")
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
81 (switch-to-buffer "*doctor*")
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
82 (sit-for 0)
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
83 (while (not (input-pending-p))
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
84 (insert-string (yow))
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
85 (sit-for 0)
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
86 (doctor-ret-or-read 1)
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
87 (doctor-ret-or-read 1)))
ca2ddc6f6950 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
88