cgit.sxemacs.org Git - packages/blob - xemacs-packages/cookie/yow.el

   1 ;;; yow.el --- quote random zippyisms
   2
   3 ;; Copyright (C) 1993, 1994, 1995, 2000 Free Software Foundation, Inc.
   4
   5 ;; Maintainer: FSF
   6 ;; Author: Richard Mlynarik
   7 ;; Keywords: games
   8
   9 ;; This file is part of XEmacs.
  10
  11 ;; XEmacs is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 2, or (at your option)
  14 ;; any later version.
  15
  16 ;; XEmacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with XEmacs; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  24 ;; Boston, MA 02111-1307, USA.
  25
  26 ;;; Synched up with: FSF 21.1.
  27
  28 ;;; Commentary:
  29
  30 ;; Important pinheadery for GNU Emacs.
  31 ;;
  32 ;; See cookie1.el for implementation.  Note --- the `n' argument of yow
  33 ;; from the 18.xx implementation is no longer; we only support *random*
  34 ;; random access now.
  35
  36 ;;; Code:
  37
  38 (require 'cookie1)
  39
  40 (defgroup yow nil
  41   "Quote random zippyisms."
  42   :prefix "yow-"
  43   :group 'games)
  44
  45 (defcustom yow-file (locate-data-file "yow.lines")
  46    "File containing pertinent pinhead phrases."
  47   :type 'file
  48   :group 'yow)
  49
  50 (defconst yow-load-message "Am I CONSING yet?...")
  51 (defconst yow-after-load-message "I have SEEN the CONSING!!")
  52
  53 ;;;###autoload
  54 (defun yow (&optional insert)
  55   "Return or display a random Zippy quotation.  With prefix arg, insert it."
  56   (interactive "P")
  57   (let ((yow (cookie yow-file yow-load-message yow-after-load-message)))
  58     (cond (insert
  59            (insert yow))
  60           ((not (interactive-p))
  61            yow)
  62           ((not (string-match "\n" yow))
  63            (delete-windows-on (get-buffer-create "*Help*"))
  64            (message "%s" yow))
  65           (t
  66            (message "Yow!")
  67            (with-output-to-temp-buffer "*Help*"
  68              (princ yow)
  69              (save-excursion
  70                (set-buffer standard-output)
  71                (help-mode)))))))
  72
  73 (defun read-zippyism (prompt &optional require-match)
  74   "Read a Zippyism from the minibuffer with completion, prompting with PROMPT.
  75 If optional second arg is non-nil, require input to match a completion."
  76   (read-cookie prompt yow-file yow-load-message yow-after-load-message
  77                require-match))
  78
  79 ;;;###autoload
  80 (defun insert-zippyism (&optional zippyism)
  81   "Prompt with completion for a known Zippy quotation, and insert it at point."
  82   (interactive (list (read-zippyism "Pinhead wisdom: " t)))
  83   (insert zippyism))
  84
  85 ;;;###autoload
  86 (defun apropos-zippy (regexp)
  87   "Return a list of all Zippy quotes matching REGEXP.
  88 If called interactively, display a list of matches."
  89   (interactive "sApropos Zippy (regexp): ")
  90   ;; Make sure yows are loaded
  91   (cookie yow-file yow-load-message yow-after-load-message)
  92   (let* ((case-fold-search t)
  93          (cookie-table-symbol (intern yow-file cookie-cache))
  94          (string-table (symbol-value cookie-table-symbol))
  95          (matches nil)
  96          (len (length string-table))
  97          (i 0))
  98     (save-match-data
  99       (while (< i len)
 100         (and (string-match regexp (aref string-table i))
 101              (setq matches (cons (aref string-table i) matches)))
 102         (setq i (1+ i))))
 103     (and matches
 104          (setq matches (sort matches 'string-lessp)))
 105     (and (interactive-p)
 106          (cond ((null matches)
 107                 (message "No matches found."))
 108                (t
 109                 (let ((l matches))
 110                   (with-output-to-temp-buffer "*Zippy Apropos*"
 111                     (while l
 112                       (princ (car l))
 113                       (setq l (cdr l))
 114                       (and l (princ "\n\n"))))))))
 115     matches))
 116
 117 \f
 118 ;; Yowza!! Feed zippy quotes to the doctor. Watch results.
 119 ;; fun, fun, fun. Entertainment for hours...
 120 ;;
 121 ;; written by Kayvan Aghaiepour
 122
 123 ;;;###autoload
 124 (defun psychoanalyze-pinhead ()
 125   "Zippy goes to the analyst."
 126   (interactive)
 127   (doctor)                              ; start the psychotherapy
 128   (message "")
 129   (switch-to-buffer "*doctor*")
 130   (sit-for 0)
 131   (while (not (input-pending-p))
 132     (insert-string (yow))
 133     (sit-for 0)
 134     (doctor-ret-or-read 1)
 135     (doctor-ret-or-read 1)))
 136
 137 (provide 'yow)
 138
 139 ;;; yow.el ends here