From: Glenn Morris Date: Fri, 21 Jun 2013 07:35:33 +0000 (-0700) Subject: cookie1.el small cleanup X-Git-Tag: emacs-24.3.90~173^2^2~42^2~45^2~387^2~2016^2~10 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=e7a526e3beb2ddadaad24ccd26d75fb55f7965bd;p=emacs.git 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. --- diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 7c6a59c75f7..99072b43f61 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,19 @@ +2013-06-21 Glenn Morris + + * 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 * progmodes/octave.el (octave-mode): Backward compatibility fix. diff --git a/lisp/obsolete/yow.el b/lisp/obsolete/yow.el index 42bb0a0b354..abada670d6c 100644 --- a/lisp/obsolete/yow.el +++ b/lisp/obsolete/yow.el @@ -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 diff --git a/lisp/play/cookie1.el b/lisp/play/cookie1.el index d060c31aebc..69cf4d538b2 100644 --- a/lisp/play/cookie1.el +++ b/lisp/play/cookie1.el @@ -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 @@ of load, ENDMSG at the end." (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 @@ and subsequent calls on the same file won't go to disk." (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 @@ Optional fifth arg REQUIRE-MATCH non-nil forces a matching cookie." (put sym 'completion-alist alist)))) nil require-match nil nil)) -; Thanks to Ian G Batten -; [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 +;; [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)