code.delx.au - gnu-emacs/blob - lisp/play/yow.el

   1 ;;; yow.el --- quote random zippyisms
   2
   3 ;; Copyright (C) 1993-1995, 2000-2013 Free Software Foundation, Inc.
   4
   5 ;; Maintainer: FSF
   6 ;; Author: Richard Mlynarik
   7 ;; Keywords: games
   8
   9 ;; This file is part of GNU Emacs.
  10
  11 ;; GNU Emacs 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 3 of the License, or
  14 ;; (at your option) any later version.
  15
  16 ;; GNU Emacs 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 GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  23
  24 ;;; Commentary:
  25
  26 ;; Important pinheadery for GNU Emacs.
  27
  28 ;;; Code:
  29
  30 (require 'cookie1)
  31
  32 (defgroup yow nil
  33   "Quote random zippyisms."
  34   :prefix "yow-"
  35   :group 'games)
  36
  37 (defcustom yow-file (expand-file-name "yow.lines" data-directory)
  38    "File containing pertinent pinhead phrases."
  39   :type 'file
  40   :group 'yow)
  41
  42 (defconst yow-load-message "Am I CONSING yet?...")
  43 (defconst yow-after-load-message "I have SEEN the CONSING!!")
  44
  45 ;;;###autoload
  46 (defun yow (&optional insert display)
  47   "Return or display a random Zippy quotation.  With prefix arg, insert it."
  48   (interactive "P\np")
  49   (let ((yow (cookie yow-file yow-load-message yow-after-load-message)))
  50     (cond (insert
  51            (insert yow))
  52           ((not display)
  53            yow)
  54           (t
  55            (message "%s" yow)))))
  56
  57 (defsubst read-zippyism (prompt &optional require-match)
  58   "Read a Zippyism from the minibuffer with completion, prompting with PROMPT.
  59 If optional second arg is non-nil, require input to match a completion."
  60   (read-cookie prompt yow-file yow-load-message yow-after-load-message
  61                require-match))
  62
  63 ;;;###autoload
  64 (defun insert-zippyism (&optional zippyism)
  65   "Prompt with completion for a known Zippy quotation, and insert it at point."
  66   (interactive (list (read-zippyism "Pinhead wisdom: " t)))
  67   (insert zippyism))
  68
  69 ;;;###autoload
  70 (defun apropos-zippy (regexp)
  71   "Return a list of all Zippy quotes matching REGEXP.
  72 If called interactively, display a list of matches."
  73   (interactive "sApropos Zippy (regexp): ")
  74   ;; Make sure yows are loaded
  75   (cookie yow-file yow-load-message yow-after-load-message)
  76   (let* ((case-fold-search t)
  77          (cookie-table-symbol (intern yow-file cookie-cache))
  78          (string-table (symbol-value cookie-table-symbol))
  79          (matches nil)
  80          (len (length string-table))
  81          (i 0))
  82     (save-match-data
  83       (while (< i len)
  84         (and (string-match regexp (aref string-table i))
  85              (setq matches (cons (aref string-table i) matches)))
  86         (setq i (1+ i))))
  87     (and matches
  88          (setq matches (sort matches 'string-lessp)))
  89     (and (called-interactively-p 'interactive)
  90          (cond ((null matches)
  91                 (message "No matches found."))
  92                (t
  93                 (let ((l matches))
  94                   (with-output-to-temp-buffer "*Zippy Apropos*"
  95                     (while l
  96                       (princ (car l))
  97                       (setq l (cdr l))
  98                       (and l (princ "\n\n")))
  99                     (help-print-return-message))))))
 100     matches))
 101
 102 \f
 103 ;; Yowza!! Feed zippy quotes to the doctor. Watch results.
 104 ;; fun, fun, fun. Entertainment for hours...
 105 ;;
 106 ;; written by Kayvan Aghaiepour
 107
 108 (declare-function doctor-ret-or-read "doctor" (arg))
 109
 110 ;;;###autoload
 111 (defun psychoanalyze-pinhead ()
 112   "Zippy goes to the analyst."
 113   (interactive)
 114   (doctor)                              ; start the psychotherapy
 115   (message "")
 116   (switch-to-buffer "*doctor*")
 117   (sit-for 0)
 118   (while (not (input-pending-p))
 119     (insert (yow))
 120     (sit-for 0)
 121     (doctor-ret-or-read 1)
 122     (doctor-ret-or-read 1)))
 123
 124 (provide 'yow)
 125
 126 ;;; yow.el ends here