[Emacs-diffs] trunk r113112: cookie1.el small cleanup

[Glenn Morris]

------------------------------------------------------------
revno: 113112
revision-id: address@hidden
parent: address@hidden
committer: Glenn Morris <address@hidden>
branch nick: trunk
timestamp: Fri 2013-06-21 00:35:33 -0700
message:
  cookie1.el small cleanup
  
  Make some funcs interactive, copy some functionality from yow.el.
  
  * lisp/play/cookie1.el (cookie): New custom group.
  (cookie-file): New option.
  (cookie-check-file): New function.
  (cookie): Make it interactive.  Make start and end messages optional.
  Interactively, display the result.  Default to cookie-file.
  (cookie-insert): Default to cookie-file.
  (cookie-snarf): Make start and end messages optional.
  Default to cookie-file.  Use with-temp-buffer.
  (cookie-read): Rename from read-cookie.
  Make start and end messages optional.  Default to cookie-file.
  (cookie-shuffle-vector): Rename from shuffle-vector.  Use dotimes.
  (cookie-apropos, cookie-doctor): New functions, copied from yow.el
  
  * lisp/obsolete/yow.el (read-zippyism): Use new name for read-cookie.
modified:
  lisp/ChangeLog                 changelog-20091113204419-o5vbwnq5f7feedwu-1432
  lisp/obsolete/yow.el           yow.el-20091113204419-o5vbwnq5f7feedwu-103
  lisp/play/cookie1.el           cookie1.el-20091113204419-o5vbwnq5f7feedwu-559

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2013-06-21 06:45:37 +0000
+++ b/lisp/ChangeLog    2013-06-21 07:35:33 +0000
@@ -1,3 +1,19 @@
+2013-06-21  Glenn Morris  <address@hidden>
+
+       * play/cookie1.el (cookie): New custom group.
+       (cookie-file): New option.
+       (cookie-check-file): New function.
+       (cookie): Make it interactive.  Make start and end messages optional.
+       Interactively, display the result.  Default to cookie-file.
+       (cookie-insert): Default to cookie-file.
+       (cookie-snarf): Make start and end messages optional.
+       Default to cookie-file.  Use with-temp-buffer.
+       (cookie-read): Rename from read-cookie.
+       Make start and end messages optional.  Default to cookie-file.
+       (cookie-shuffle-vector): Rename from shuffle-vector.  Use dotimes.
+       (cookie-apropos, cookie-doctor): New functions, copied from yow.el
+       * obsolete/yow.el (read-zippyism): Use new name for read-cookie.
+
 2013-06-21  Leo Liu  <address@hidden>
 
        * progmodes/octave.el (octave-mode): Backward compatibility fix.

=== modified file 'lisp/obsolete/yow.el'
--- a/lisp/obsolete/yow.el      2013-02-13 08:50:44 +0000
+++ b/lisp/obsolete/yow.el      2013-06-21 07:35:33 +0000
@@ -60,7 +60,7 @@
 (defsubst 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 yow-load-message yow-after-load-message
+  (cookie-read prompt yow-file yow-load-message yow-after-load-message
               require-match))
 
 ;;;###autoload

=== modified file 'lisp/play/cookie1.el'
--- a/lisp/play/cookie1.el      2013-01-01 09:11:05 +0000
+++ b/lisp/play/cookie1.el      2013-06-21 07:35:33 +0000
@@ -25,11 +25,10 @@
 ;;; Commentary:
 
 ;; Support for random cookie fetches from phrase files, used for such
-;; critical applications as emulating Zippy the Pinhead and confounding
-;; the NSA Trunk Trawler.
+;; critical applications as confounding the NSA Trunk Trawler.
 ;;
 ;; The two entry points are `cookie' and `cookie-insert'.  The helper
-;; function `shuffle-vector' may be of interest to programmers.
+;; function `cookie-shuffle-vector' may be of interest to programmers.
 ;;
 ;; The code expects phrase files to be in one of two formats:
 ;;
@@ -49,32 +48,62 @@
 ;; This code derives from Steve Strassmann's 1987 spook.el package, but
 ;; has been generalized so that it supports multiple simultaneous
 ;; cookie databases and fortune files.  It is intended to be called
-;; from other packages such as yow.el and spook.el.
+;; from other packages such as spook.el.
 
 ;;; Code:
 
+(defgroup cookie nil
+  "Random cookies from phrase files."
+  :prefix "cookie-"
+  :group 'games)
+
+(defcustom cookie-file nil
+  "Default phrase file for cookie functions."
+  :type '(choice (const nil) file)
+  :group 'cookie
+  :version "24.4")
+
 (defconst cookie-delimiter "\n%%\n\\|\n%\n\\|\0"
   "Delimiter used to separate cookie file entries.")
 
 (defvar cookie-cache (make-vector 511 0)
   "Cache of cookie files that have already been snarfed.")
 
+(defun cookie-check-file (file)
+  "Return either FILE or `cookie-file'.
+Signal an error if the result is nil or not readable."
+  (or (setq file (or file cookie-file)) (user-error "No phrase file 
specified"))
+  (or (file-readable-p file) (user-error "Cannot read file `%s'" file))
+  file)
+
 ;;;###autoload
-(defun cookie (phrase-file startmsg endmsg)
+(defun cookie (phrase-file &optional startmsg endmsg)
   "Return a random phrase from PHRASE-FILE.
 When the phrase file is read in, display STARTMSG at the beginning
-of load, ENDMSG at the end."
-  (let ((cookie-vector (cookie-snarf phrase-file startmsg endmsg)))
-    (shuffle-vector cookie-vector)
-    (aref cookie-vector 0)))
+of load, ENDMSG at the end.
+Interactively, PHRASE-FILE defaults to `cookie-file', unless that
+is nil or a prefix argument is used."
+  (interactive (list (if (or current-prefix-arg (not cookie-file))
+                        (read-file-name "Cookie file: " nil
+                                        cookie-file t cookie-file)
+                      cookie-file) nil nil))
+  (setq phrase-file (cookie-check-file phrase-file))
+  (let ((cookie-vector (cookie-snarf phrase-file startmsg endmsg))
+       res)
+    (cookie-shuffle-vector cookie-vector)
+    (setq res (aref cookie-vector 0))
+    (if (called-interactively-p 'interactive)
+       (message "%s" res)
+      res)))
 
 ;;;###autoload
 (defun cookie-insert (phrase-file &optional count startmsg endmsg)
   "Insert random phrases from PHRASE-FILE; COUNT of them.
 When the phrase file is read in, display STARTMSG at the beginning
 of load, ENDMSG at the end."
+  (setq phrase-file (cookie-check-file phrase-file))
   (let ((cookie-vector (cookie-snarf phrase-file startmsg endmsg)))
-    (shuffle-vector cookie-vector)
+    (cookie-shuffle-vector cookie-vector)
     (let ((start (point)))
       (insert ?\n)
       (cookie1 (min (- (length cookie-vector) 1) (or count 1)) cookie-vector)
@@ -89,12 +118,11 @@
           (cookie1 (1- arg) cookie-vec))))
 
 ;;;###autoload
-(defun cookie-snarf (phrase-file startmsg endmsg)
+(defun cookie-snarf (phrase-file &optional 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."
-  (or (file-readable-p phrase-file)
-      (error "Cannot read file `%s'" phrase-file))
+  (setq phrase-file (cookie-check-file phrase-file))
   (let ((sym (intern-soft phrase-file cookie-cache)))
     (and sym (not (equal (symbol-function sym)
                         (nth 5 (file-attributes phrase-file))))
@@ -104,27 +132,25 @@
     (if sym
        (symbol-value sym)
       (setq sym (intern phrase-file cookie-cache))
-      (message "%s" startmsg)
-      (save-excursion
-       (let ((buf (generate-new-buffer "*cookie*"))
-             (result nil))
-         (set-buffer buf)
-         (fset sym (nth 5 (file-attributes phrase-file)))
+      (if startmsg (message "%s" startmsg))
+      (fset sym (nth 5 (file-attributes phrase-file)))
+      (let (result)
+       (with-temp-buffer
          (insert-file-contents (expand-file-name phrase-file))
          (re-search-forward cookie-delimiter)
          (while (progn (skip-chars-forward " \t\n\r\f") (not (eobp)))
            (let ((beg (point)))
              (re-search-forward cookie-delimiter)
              (setq result (cons (buffer-substring beg (match-beginning 0))
-                                result))))
-         (kill-buffer buf)
-         (message "%s" endmsg)
-         (set sym (apply 'vector result)))))))
+                                result)))))
+       (if endmsg (message "%s" endmsg))
+       (set sym (apply 'vector result))))))
 
-(defun read-cookie (prompt phrase-file startmsg endmsg &optional require-match)
+(defun cookie-read (prompt phrase-file &optional startmsg endmsg 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."
+Argument REQUIRE-MATCH non-nil forces a matching cookie."
+  (setq phrase-file (cookie-check-file phrase-file))
   ;; Make sure the cookies are in the cache.
   (or (intern-soft phrase-file cookie-cache)
       (cookie-snarf phrase-file startmsg endmsg))
@@ -141,24 +167,85 @@
                           (put sym 'completion-alist alist))))
                   nil require-match nil nil))
 
-; Thanks to Ian G Batten <address@hidden>
-; [of the University of Birmingham Computer Science Department]
-; for the iterative version of this shuffle.
-;
-;;;###autoload
-(defun shuffle-vector (vector)
+(define-obsolete-function-alias 'read-cookie 'cookie-read "24.4")
+
+;; Thanks to Ian G Batten <address@hidden>
+;; [of the University of Birmingham Computer Science Department]
+;; for the iterative version of this shuffle.
+(defun cookie-shuffle-vector (vector)
   "Randomly permute the elements of VECTOR (all permutations equally likely)."
-  (let ((i 0)
-       j
-       temp
-       (len (length vector)))
-    (while (< i len)
-      (setq j (+ i (random (- len i))))
-      (setq temp (aref vector i))
+  (let ((len (length vector))
+       j temp)
+    (dotimes (i len vector)
+      (setq j (+ i (random (- len i)))
+           temp (aref vector i))
       (aset vector i (aref vector j))
-      (aset vector j temp)
-      (setq i (1+ i))))
-  vector)
+      (aset vector j temp))))
+
+(define-obsolete-function-alias 'shuffle-vector 'cookie-shuffle-vector "24.4")
+
+
+(defun cookie-apropos (regexp phrase-file)
+  "Return a list of all entries matching REGEXP from PHRASE-FILE.
+Interactively, PHRASE-FILE defaults to `cookie-file', unless that
+is nil or a prefix argument is used.
+If called interactively, display a list of matches."
+  (interactive (list (read-regexp "Apropos phrase (regexp): ")
+                    (if (or current-prefix-arg (not cookie-file))
+                        (read-file-name "Cookie file: " nil
+                                        cookie-file t cookie-file)
+                      cookie-file)))
+  (setq phrase-file (cookie-check-file phrase-file))
+  ;; Make sure phrases are loaded.
+  (cookie phrase-file)
+  (let* ((case-fold-search t)
+         (cookie-table-symbol (intern phrase-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 (called-interactively-p 'interactive)
+         (cond ((null matches)
+                (message "No matches found."))
+               (t
+                (let ((l matches))
+                  (with-output-to-temp-buffer "*Cookie Apropos*"
+                    (while l
+                      (princ (car l))
+                      (setq l (cdr l))
+                      (and l (princ "\n\n")))
+                   (help-print-return-message))))))
+    matches))
+
+
+(declare-function doctor-ret-or-read "doctor" (arg))
+
+(defun cookie-doctor (phrase-file)
+  "Feed cookie phrases from PHRASE-FILE to the doctor.
+Interactively, PHRASE-FILE defaults to `cookie-file', unless that
+is nil or a prefix argument is used."
+  (interactive (list (if (or current-prefix-arg (not cookie-file))
+                        (read-file-name "Cookie file: " nil
+                                        cookie-file t cookie-file)
+                      cookie-file)))
+  (setq phrase-file (cookie-check-file phrase-file))
+  (doctor)                             ; start the psychotherapy
+  (message "")
+  (switch-to-buffer "*doctor*")
+  (sit-for 0)
+  (while (not (input-pending-p))
+    (insert (cookie phrase-file))
+    (sit-for 0)
+    (doctor-ret-or-read 1)
+    (doctor-ret-or-read 1)))
+
 
 (provide 'cookie1)