Mercurial > hg > xemacs-beta

comparison lisp/games/yow.el @ 70:131b0175ea99 r20-0b30

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents 0293115a14e9
children b9518feda344
comparison
equal deleted inserted replaced
69:804d1389bcd6 70:131b0175ea99
1 ;;; yow.el --- quote random zippyisms 1 ;;; yow.el --- quote random zippyisms
2 2
3 ;; Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc. 3 ;; Copyright (C) 1985, 1993, 1994 Free Software Foundation, Inc.
4 4
5 ;; Maintainer: FSF 5 ;; Maintainer: FSF
6 ;; Author: Richard Mlynarik 6 ;; Author: Richard Mlynarik
7 ;; Keywords: games 7 ;; Keywords: games
8 8
21 ;; You should have received a copy of the GNU General Public License 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 22 ;; along with XEmacs; see the file COPYING. If not, write to the
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, 23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
24 ;; Boston, MA 02111-1307, USA. 24 ;; Boston, MA 02111-1307, USA.
25 25
26 ;;; Synched up with: FSF 19.34. 26 ;;; Synched up with: FSF 19.30.
27 27
28 ;;; Commentary: 28 ;;; Commentary:
29 29
30 ;; Important pinheadery for GNU Emacs. 30 ;; Important pinheadery for GNU Emacs.
31 ;; 31 ;;
36 ;;; Code: 36 ;;; Code:
37 37
38 (require 'cookie1) 38 (require 'cookie1)
39 39
40 (defvar yow-file (concat data-directory "yow.lines") 40 (defvar yow-file (concat data-directory "yow.lines")
41 "File containing pertinent Pinhead Phrases.") 41 "File containing Pertinent Pinhead Phrases.")
42
43 (defconst yow-load-message "Am I CONSING yet?...")
44 (defconst yow-after-load-message "I have SEEN the CONSING!!")
45 42
46 ;;;###autoload 43 ;;;###autoload
47 (defun yow (&optional insert) 44 (defun yow (&optional insert)
48 "Return or display a random Zippy quotation. With prefix arg, insert it." 45 "Return or display a random Zippy quotation. With prefix arg, insert it."
49 (interactive "P") 46 (interactive "P")
50 (let ((yow (cookie yow-file yow-load-message yow-after-load-message))) 47 (let ((yow (cookie
48 yow-file
49 "Am I CONSING yet?..." "I have SEEN the CONSING!!")))
51 (cond (insert 50 (cond (insert
52 (insert yow)) 51 (insert yow))
53 ((not (interactive-p)) 52 ((not (interactive-p))
54 yow) 53 yow)
55 ((not (string-match "\n" yow)) 54 ((not (string-match "\n" yow))
64 (help-mode))))))) 63 (help-mode)))))))
65 64
66 (defun read-zippyism (prompt &optional require-match) 65 (defun read-zippyism (prompt &optional require-match)
67 "Read a Zippyism from the minibuffer with completion, prompting with PROMPT. 66 "Read a Zippyism from the minibuffer with completion, prompting with PROMPT.
68 If optional second arg is non-nil, require input to match a completion." 67 If optional second arg is non-nil, require input to match a completion."
69 (read-cookie prompt yow-file yow-load-message yow-after-load-message 68 (read-cookie prompt yow-file
69 "Am I CONSING yet?..." "I have SEEN the CONSING!!"
70 require-match)) 70 require-match))
71
72 ;;;###autoload 71 ;;;###autoload
73 (defun insert-zippyism (&optional zippyism) 72 (defun insert-zippyism (&optional zippyism)
74 "Prompt with completion for a known Zippy quotation, and insert it at point." 73 "Prompt with completion for a known Zippy quotation, and insert it at point."
75 (interactive (list (read-zippyism "Pinhead wisdom: " t))) 74 (interactive (list (read-zippyism "Pinhead wisdom: " t)))
76 (insert zippyism)) 75 (insert zippyism))
77
78 ;;;###autoload
79 (defun apropos-zippy (regexp)
80 "Return a list of all Zippy quotes matching REGEXP.
81 If called interactively, display a list of matches."
82 (interactive "sApropos Zippy (regexp): ")
83 ;; Make sure yows are loaded
84 (cookie yow-file yow-load-message yow-after-load-message)
85 (let* ((case-fold-search t)
86 (cookie-table-symbol (intern yow-file cookie-cache))
87 (string-table (symbol-value cookie-table-symbol))
88 (matches nil)
89 (len (length string-table))
90 (i 0))
91 (save-match-data
92 (while (< i len)
93 (and (string-match regexp (aref string-table i))
94 (setq matches (cons (aref string-table i) matches)))
95 (setq i (1+ i))))
96 (and matches
97 (setq matches (sort matches 'string-lessp)))
98 (and (interactive-p)
99 (cond ((null matches)
100 (message "No matches found."))
101 (t
102 (let ((l matches))
103 (with-output-to-temp-buffer "*Zippy Apropos*"
104 (while l
105 (princ (car l))
106 (setq l (cdr l))
107 (and l (princ "\n\n"))))))))
108 matches))
109
110 76
111 ;; Yowza!! Feed zippy quotes to the doctor. Watch results. 77 ; Yowza!! Feed zippy quotes to the doctor. Watch results.
112 ;; fun, fun, fun. Entertainment for hours... 78 ; fun, fun, fun. Entertainment for hours...
113 ;; 79 ;
114 ;; written by Kayvan Aghaiepour 80 ; written by Kayvan Aghaiepour
115 81
116 ;;;###autoload 82 ;;;###autoload
117 (defun psychoanalyze-pinhead () 83 (defun psychoanalyze-pinhead ()
118 "Zippy goes to the analyst." 84 "Zippy goes to the analyst."
119 (interactive) 85 (interactive)
120 (doctor) ; start the psychotherapy 86 (doctor) ; start the psychotherapy
121 (message "") 87 (message nil)
122 (switch-to-buffer "*doctor*") 88 (switch-to-buffer "*doctor*")
123 (sit-for 0) 89 (sit-for 0)
124 (while (not (input-pending-p)) 90 (while (not (input-pending-p))
125 (insert-string (yow)) 91 (insert (yow))
126 (sit-for 0) 92 (sit-for 0)
127 (doctor-ret-or-read 1) 93 (doctor-ret-or-read 1)
128 (doctor-ret-or-read 1))) 94 (doctor-ret-or-read 1)))
129 95
130 (provide 'yow) 96 (provide 'yow)