(read-cookie): New function.

1 files changed, 23 insertions, 3 deletions

diff --git a/lisp/play/cookie1.el b/lisp/play/cookie1.el
index a7792fb32b6..0cde6b9b703 100644
--- a/lisp/play/cookie1.el
+++ b/lisp/play/cookie1.el
@@ -91,9 +91,9 @@ is read in, display STARTMSG at beginning of load, ENDMSG at end."
 
 ;;;###autoload
 (defun cookie-snarf (phrase-file startmsg endmsg)
-  "Reads in the PHRASE-FILE, returns it as a vector of strings.  Emit
-STARTMSG and ENDMSG before and after.  Caches the result; second and
-subsequent calls on the same file won't go to disk."
+  "Reads in the PHRASE-FILE, returns it as a vector of strings.
+Emit STARTMSG and ENDMSG before and after.  Caches the result; second
+and subsequent calls on the same file won't go to disk."
   (let ((sym (intern-soft phrase-file cookie-cache)))
     (and sym (not (equal (symbol-function sym)
                          (nth 5 (file-attributes phrase-file))))
@@ -120,6 +120,26 @@ subsequent calls on the same file won't go to disk."
           (message endmsg)
           (set sym (apply 'vector result)))))))
 
+(defun read-cookie (prompt phrase-file startmsg endmsg &optional require-match)
+  "Prompt with PROMPT and read with completion among cookies in PHRASE-FILE.
+STARTMSG and ENDMSG are passed along to `cookie-snarf'.
+Optional fifth arg REQUIRE-MATCH non-nil forces a matching cookie."
+  ;; Make sure the cookies are in the cache.
+  (or (intern-soft phrase-file cookie-cache)
+      (cookie-snarf phrase-file startmsg endmsg))
+  (completing-read prompt
+                   (let ((sym (intern phrase-file cookie-cache)))
+                     ;; We cache the alist form of the cookie in a property.
+                     (or (get sym 'completion-alist)
+                         (let* ((alist nil)
+                                (vec (cookie-snarf phrase-file
+                                                   startmsg endmsg))
+                                (i (length vec)))
+                           (while (> (setq i (1- i)) 0)
+                             (setq alist (cons (list (aref vec i)) alist)))
+                           (put sym 'completion-alist alist))))
+                   nil require-match nil nil))
+
 ; Thanks to Ian G Batten <BattenIG@CS.BHAM.AC.UK>
 ; [of the University of Birmingham Computer Science Department]
 ; for the iterative version of this shuffle.