Mercurial > hg > xemacs-beta

comparison lisp/games/cookie1.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 b82b59fe008d
children b9518feda344
comparison
equal deleted inserted replaced
69:804d1389bcd6 70:131b0175ea99
18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of 18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
20 ;; General Public License for more details. 20 ;; General Public License for more details.
21 21
22 ;; You should have received a copy of the GNU General Public License 22 ;; You should have received a copy of the GNU General Public License
23 ;; along with XEmacs; see the file COPYING. If not, write to the Free 23 ;; along with XEmacs; see the file COPYING. If not, write to the
24 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
25 ;; 02111-1307, USA. 25 ;; Boston, MA 02111-1307, USA.
26 26
27 ;;; Synched up with: FSF 19.34. 27 ;;; Synched up with: FSF 19.28.
28 28
29 ;;; Commentary: 29 ;;; Commentary:
30 30
31 ;; Support for random cookie fetches from phrase files, used for such 31 ;; Support for random cookie fetches from phrase files, used for such
32 ;; critical applications as emulating Zippy the Pinhead and confounding 32 ;; critical applications as emulating Zippy the Pinhead and confounding
104 " has changed. Read new contents? ")) 104 " has changed. Read new contents? "))
105 (setq sym nil)) 105 (setq sym nil))
106 (if sym 106 (if sym
107 (symbol-value sym) 107 (symbol-value sym)
108 (setq sym (intern phrase-file cookie-cache)) 108 (setq sym (intern phrase-file cookie-cache))
109 (message "%s" startmsg) 109 (message startmsg)
110 (save-excursion 110 (save-excursion
111 (let ((buf (generate-new-buffer "*cookie*")) 111 (let ((buf (generate-new-buffer "*cookie*"))
112 (result nil)) 112 (result nil))
113 (set-buffer buf) 113 (set-buffer buf)
114 (fset sym (nth 5 (file-attributes phrase-file))) 114 (fset sym (nth 5 (file-attributes phrase-file)))
115 (insert-file-contents (expand-file-name phrase-file)) 115 (insert-file-contents (expand-file-name phrase-file))
116 (re-search-forward cookie-delimiter) 116 (re-search-forward cookie-delimiter)
117 (while (progn (skip-chars-forward " \t\n\r\f") (not (eobp))) 117 (while (progn (skip-chars-forward " \t\n\r\f") (not (eobp)))
118 (let ((beg (point))) 118 (let ((beg (point)))
119 (re-search-forward cookie-delimiter) 119 (re-search-forward cookie-delimiter)
120 ;; XEmacs change
121 ;; DBC --- here's the change 120 ;; DBC --- here's the change
122 ;; This used to be (buffer-substring beg (1- (point))), 121 ;; This used to be (buffer-substring beg (1- (point))),
123 ;; which only worked if the regexp matched was one 122 ;; which only worked if the regexp matched was one
124 ;; character long 123 ;; character long
125 (setq result (cons (buffer-substring beg 124 (setq result (cons (buffer-substring beg
126 (match-beginning 0)) 125 (match-beginning 0))
127 result)))) 126 result))))
128 (kill-buffer buf) 127 (kill-buffer buf)
129 (message "%s" endmsg) 128 (message endmsg)
130 (set sym (apply 'vector result))))))) 129 (set sym (apply 'vector result)))))))
131 130
132 (defun read-cookie (prompt phrase-file startmsg endmsg &optional require-match) 131 (defun read-cookie (prompt phrase-file startmsg endmsg &optional require-match)
133 "Prompt with PROMPT and read with completion among cookies in PHRASE-FILE. 132 "Prompt with PROMPT and read with completion among cookies in PHRASE-FILE.
134 STARTMSG and ENDMSG are passed along to `cookie-snarf'. 133 STARTMSG and ENDMSG are passed along to `cookie-snarf'.