home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / gnu / lucid / lemacs-19.6 / lisp / packages / yow.el < prev    next >
Encoding:
Text File  |  1992-06-29  |  2.8 KB  |  87 lines
  1. ;; Copyright (C) 1985, 1987 Free Software Foundation, Inc.
  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. (provide 'yow)
  20.  
  21. ; Randomize the seed in the random number generator.
  22. (random t)
  23.  
  24. ; Important pinheaddery for GNU Emacs.
  25. ; Expects file emacs/etc/yow.lines to be in ITS-style LINS format
  26. ;  (ie strings terminated by ascii 0 characters.  Leading whitespace ignored)
  27. ; Everything up to the first \000 is a comment.
  28. (defun yow (&optional n interactive)
  29.   "Return or display a Zippy quotation."
  30.   (interactive "P\np")
  31.   (if (null yow-vector)
  32.       (setq yow-vector (snarf-yows)))
  33.   (cond (n (setq n (prefix-numeric-value n)))
  34.     ((>= (setq n (random (length yow-vector))) 0))
  35.     (t (setq n (- n))))
  36.   (let ((yow (aref yow-vector n)))
  37.     (cond ((not interactive)
  38.        yow)
  39.       ((not (string-match "\n" yow))
  40.        (delete-windows-on (get-buffer-create "*Help*"))
  41.        (message "%s" yow))
  42.       (t
  43.        (message "Yow!")
  44.        (with-output-to-temp-buffer "*Help*"
  45.          (princ yow))))))
  46.  
  47. (defvar yow-vector nil "Pertinent pinhead statements")
  48. (defun snarf-yows (&optional file)
  49.   (save-excursion
  50.     (let ((buf (generate-new-buffer " yow"))
  51.       (result '())
  52.       (cursor-in-echo-area t))
  53.       (message "Am I CONSING yet?...")
  54.       (set-buffer buf)
  55.       (insert-file-contents (or file
  56.                 (expand-file-name "yow.lines" exec-directory)))
  57.       (search-forward "\0")
  58.       (while (progn (skip-chars-forward " \t\n\r\f") (not (eobp)))
  59.     (let ((beg (point)))
  60.       (search-forward "\0")
  61.       (setq result (cons (buffer-substring beg (1- (point)))
  62.                  result))))
  63.       (kill-buffer buf)
  64.       (message "I have SEEN the CONSING!!" (length result))
  65.       (apply 'vector (nreverse result)))))
  66.  
  67. ; Yowza!! Feed zippy quotes to the doctor. Watch results.
  68. ; fun, fun, fun. Entertainment for hours...
  69. ;
  70. ; written by Kayvan Aghaiepour
  71.  
  72. (defun psychoanalyze-pinhead ()
  73.   "Zippy goes to the analyst."
  74.   (interactive)
  75.   (doctor)                ; start the psychotherapy
  76.   (if (null yow-vector)
  77.       (setq yow-vector (snarf-yows)))
  78.   (message "")
  79.   (switch-to-buffer "*doctor*")
  80.   (sit-for 0)
  81.   (while (not (input-pending-p))
  82.     (insert-string (yow))
  83.     (sit-for 0)
  84.     (doctor-ret-or-read 1)
  85.     (doctor-ret-or-read 1)))
  86.  
  87.