home *** CD-ROM | disk | FTP | other *** search
/ Education Sampler 1992 [NeXTSTEP] / Education_1992_Sampler.iso / NeXT / GnuSource / emacs-15.0.3 / lisp / yow.el < prev    next >
Lisp/Scheme  |  1990-07-19  |  3KB  |  89 lines
  1. ;; Copyright (C) 1985, 1987 Free Software Foundation
  2.  
  3. ;; This file is part of GNU Emacs.
  4.  
  5. ;; GNU Emacs is distributed in the hope that it will be useful,
  6. ;; but WITHOUT ANY WARRANTY.  No author or distributor
  7. ;; accepts responsibility to anyone for the consequences of using it
  8. ;; or for whether it serves any particular purpose or works at all,
  9. ;; unless he says so in writing.  Refer to the GNU Emacs General Public
  10. ;; License for full details.
  11.  
  12. ;; Everyone is granted permission to copy, modify and redistribute
  13. ;; GNU Emacs, but only under the conditions described in the
  14. ;; GNU Emacs General Public License.   A copy of this license is
  15. ;; supposed to have been given to you along with GNU Emacs so you
  16. ;; can know your rights and responsibilities.  It should be in a
  17. ;; file named COPYING.  Among other things, the copyright notice
  18. ;; and this notice must be preserved on all copies.
  19.  
  20. ; Randomize the seed in the random number generator.
  21. (random t)
  22.  
  23. ; Important pinheaddery for GNU Emacs.
  24. ; Expects file emacs/etc/yow.lines to be in ITS-style LINS format
  25. ;  (ie strings terminated by ascii 0 characters.  Leading whitespace ignored)
  26. ; Everything up to the first \000 is a comment.
  27. (defun yow (&optional n interactive)
  28.   "Return or display a Zippy quotation"
  29.   (interactive
  30.     (if current-prefix-arg
  31.     (list (prefix-numeric-value current-prefix-arg) t)
  32.       (list nil t)))
  33.   (if (null yow-vector)
  34.       (setq yow-vector (snarf-yows)))
  35.   (cond (n)
  36.     ((>= (setq n (% (random) (length yow-vector))) 0))
  37.     (t (setq n (- n))))
  38.   (let ((yow (aref yow-vector n)))
  39.     (cond ((not interactive)
  40.        yow)
  41.       ((not (string-match "\n" yow))
  42.        (delete-windows-on (get-buffer-create "*Help*"))
  43.        (message yow))
  44.       (t
  45.        (message "Yow!")
  46.        (with-output-to-temp-buffer "*Help*"
  47.          (princ yow))))))
  48.  
  49. (defvar yow-vector nil "Pertinent pinhead statements")
  50. (defun snarf-yows (&optional file)
  51.   (save-excursion
  52.     (let ((buf (generate-new-buffer " yow"))
  53.       (result '())
  54.       (cursor-in-echo-area t))
  55.       (message "Am I CONSING yet?...")
  56.       (set-buffer buf)
  57.       (insert-file-contents (or file
  58.                 (expand-file-name "yow.lines" exec-directory)))
  59.       (search-forward "\0")
  60.       (while (progn (skip-chars-forward " \t\n\r\f") (not (eobp)))
  61.     (let ((beg (point)))
  62.       (search-forward "\0")
  63.       (setq result (cons (buffer-substring beg (1- (point)))
  64.                  result))))
  65.       (kill-buffer buf)
  66.       (message "I have SEEN the CONSING!!" (length result))
  67.       (apply 'vector (nreverse result)))))
  68.  
  69. ; Yowza!! Feed zippy quotes to the doctor. Watch results.
  70. ; fun, fun, fun. Entertainment for hours...
  71. ;
  72. ; written by Kayvan Aghaiepour
  73.  
  74. (defun psychoanalyze-pinhead ()
  75.   "Zippy goes to the analyst."
  76.   (interactive)
  77.   (doctor)                ; start the psychotherapy
  78.   (if (null yow-vector)
  79.       (setq yow-vector (snarf-yows)))
  80.   (message "")
  81.   (switch-to-buffer "*doctor*")
  82.   (sit-for 0)
  83.   (while (not (input-pending-p))
  84.     (insert-string (yow))
  85.     (sit-for 0)
  86.     (doctor-ret-or-read 1)
  87.     (doctor-ret-or-read 1)))
  88.  
  89.