Mercurial > hg > xemacs-beta
diff lisp/games/yow.el @ 4:b82b59fe008d r19-15b3
Import from CVS: tag r19-15b3
author | cvs |
---|---|
date | Mon, 13 Aug 2007 08:46:56 +0200 |
parents | 376386a54a3c |
children | 0293115a14e9 |
line wrap: on
line diff
--- a/lisp/games/yow.el Mon Aug 13 08:46:35 2007 +0200 +++ b/lisp/games/yow.el Mon Aug 13 08:46:56 2007 +0200 @@ -1,6 +1,6 @@ ;;; yow.el --- quote random zippyisms -;; Copyright (C) 1985, 1993, 1994 Free Software Foundation, Inc. +;; Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Author: Richard Mlynarik @@ -22,7 +22,7 @@ ;; along with XEmacs; see the file COPYING. If not, write to the Free ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. -;;; Synched up with: FSF 19.30. +;;; Synched up with: FSF 19.34. ;;; Commentary: @@ -37,15 +37,16 @@ (require 'cookie1) (defvar yow-file (concat data-directory "yow.lines") - "File containing Pertinent Pinhead Phrases.") + "File containing pertinent Pinhead Phrases.") + +(defconst yow-load-message "Am I CONSING yet?...") +(defconst yow-after-load-message "I have SEEN the CONSING!!") ;;;###autoload (defun yow (&optional insert) "Return or display a random Zippy quotation. With prefix arg, insert it." (interactive "P") - (let ((yow (cookie - yow-file - "Am I CONSING yet?..." "I have SEEN the CONSING!!"))) + (let ((yow (cookie yow-file yow-load-message yow-after-load-message))) (cond (insert (insert yow)) ((not (interactive-p)) @@ -64,30 +65,63 @@ (defun read-zippyism (prompt &optional require-match) "Read a Zippyism from the minibuffer with completion, prompting with PROMPT. If optional second arg is non-nil, require input to match a completion." - (read-cookie prompt yow-file - "Am I CONSING yet?..." "I have SEEN the CONSING!!" + (read-cookie prompt yow-file yow-load-message yow-after-load-message require-match)) + ;;;###autoload (defun insert-zippyism (&optional zippyism) "Prompt with completion for a known Zippy quotation, and insert it at point." (interactive (list (read-zippyism "Pinhead wisdom: " t))) (insert zippyism)) + +;;;###autoload +(defun apropos-zippy (regexp) + "Return a list of all Zippy quotes matching REGEXP. +If called interactively, display a list of matches." + (interactive "sApropos Zippy (regexp): ") + ;; Make sure yows are loaded + (cookie yow-file yow-load-message yow-after-load-message) + (let* ((case-fold-search t) + (cookie-table-symbol (intern yow-file cookie-cache)) + (string-table (symbol-value cookie-table-symbol)) + (matches nil) + (len (length string-table)) + (i 0)) + (save-match-data + (while (< i len) + (and (string-match regexp (aref string-table i)) + (setq matches (cons (aref string-table i) matches))) + (setq i (1+ i)))) + (and matches + (setq matches (sort matches 'string-lessp))) + (and (interactive-p) + (cond ((null matches) + (message "No matches found.")) + (t + (let ((l matches)) + (with-output-to-temp-buffer "*Zippy Apropos*" + (while l + (princ (car l)) + (setq l (cdr l)) + (and l (princ "\n\n")))))))) + matches)) + -; Yowza!! Feed zippy quotes to the doctor. Watch results. -; fun, fun, fun. Entertainment for hours... -; -; written by Kayvan Aghaiepour +;; Yowza!! Feed zippy quotes to the doctor. Watch results. +;; fun, fun, fun. Entertainment for hours... +;; +;; written by Kayvan Aghaiepour ;;;###autoload (defun psychoanalyze-pinhead () "Zippy goes to the analyst." (interactive) (doctor) ; start the psychotherapy - (message nil) + (message "") (switch-to-buffer "*doctor*") (sit-for 0) (while (not (input-pending-p)) - (insert (yow)) + (insert-string (yow)) (sit-for 0) (doctor-ret-or-read 1) (doctor-ret-or-read 1)))