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