Mercurial > hg > xemacs-beta

comparison lisp/games/cookie1.el @ 4:b82b59fe008d r19-15b3

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b3
author cvs
date Mon, 13 Aug 2007 08:46:56 +0200
parents 376386a54a3c
children 131b0175ea99
comparison
equal deleted inserted replaced
3:30df88044ec6 4:b82b59fe008d
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 Free
24 ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. 24 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
25 ;; 02111-1307, USA.
25 26
26 ;;; Synched up with: FSF 19.28. 27 ;;; Synched up with: FSF 19.34.
27 28
28 ;;; Commentary: 29 ;;; Commentary:
29 30
30 ;; Support for random cookie fetches from phrase files, used for such 31 ;; Support for random cookie fetches from phrase files, used for such
31 ;; critical applications as emulating Zippy the Pinhead and confounding 32 ;; critical applications as emulating Zippy the Pinhead and confounding
103 " has changed. Read new contents? ")) 104 " has changed. Read new contents? "))
104 (setq sym nil)) 105 (setq sym nil))
105 (if sym 106 (if sym
106 (symbol-value sym) 107 (symbol-value sym)
107 (setq sym (intern phrase-file cookie-cache)) 108 (setq sym (intern phrase-file cookie-cache))
108 (message startmsg) 109 (message "%s" startmsg)
109 (save-excursion 110 (save-excursion
110 (let ((buf (generate-new-buffer "*cookie*")) 111 (let ((buf (generate-new-buffer "*cookie*"))
111 (result nil)) 112 (result nil))
112 (set-buffer buf) 113 (set-buffer buf)
113 (fset sym (nth 5 (file-attributes phrase-file))) 114 (fset sym (nth 5 (file-attributes phrase-file)))
114 (insert-file-contents (expand-file-name phrase-file)) 115 (insert-file-contents (expand-file-name phrase-file))
115 (re-search-forward cookie-delimiter) 116 (re-search-forward cookie-delimiter)
116 (while (progn (skip-chars-forward " \t\n\r\f") (not (eobp))) 117 (while (progn (skip-chars-forward " \t\n\r\f") (not (eobp)))
117 (let ((beg (point))) 118 (let ((beg (point)))
118 (re-search-forward cookie-delimiter) 119 (re-search-forward cookie-delimiter)
120 ;; XEmacs change
119 ;; DBC --- here's the change 121 ;; DBC --- here's the change
120 ;; This used to be (buffer-substring beg (1- (point))), 122 ;; This used to be (buffer-substring beg (1- (point))),
121 ;; which only worked if the regexp matched was one 123 ;; which only worked if the regexp matched was one
122 ;; character long 124 ;; character long
123 (setq result (cons (buffer-substring beg 125 (setq result (cons (buffer-substring beg
124 (match-beginning 0)) 126 (match-beginning 0))
125 result)))) 127 result))))
126 (kill-buffer buf) 128 (kill-buffer buf)
127 (message endmsg) 129 (message "%s" endmsg)
128 (set sym (apply 'vector result))))))) 130 (set sym (apply 'vector result)))))))
129 131
130 (defun read-cookie (prompt phrase-file startmsg endmsg &optional require-match) 132 (defun read-cookie (prompt phrase-file startmsg endmsg &optional require-match)
131 "Prompt with PROMPT and read with completion among cookies in PHRASE-FILE. 133 "Prompt with PROMPT and read with completion among cookies in PHRASE-FILE.
132 STARTMSG and ENDMSG are passed along to `cookie-snarf'. 134 STARTMSG and ENDMSG are passed along to `cookie-snarf'.