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.
This commit is contained in:
parent
62efb35e42
commit
e7a526e3be
3 changed files with 145 additions and 42 deletions
|
@ -1,3 +1,19 @@
|
||||||
|
2013-06-21 Glenn Morris <rgm@gnu.org>
|
||||||
|
|
||||||
|
* 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 <sdl.web@gmail.com>
|
2013-06-21 Leo Liu <sdl.web@gmail.com>
|
||||||
|
|
||||||
* progmodes/octave.el (octave-mode): Backward compatibility fix.
|
* progmodes/octave.el (octave-mode): Backward compatibility fix.
|
||||||
|
|
|
@ -60,7 +60,7 @@
|
||||||
(defsubst read-zippyism (prompt &optional require-match)
|
(defsubst read-zippyism (prompt &optional require-match)
|
||||||
"Read a Zippyism from the minibuffer with completion, prompting with PROMPT.
|
"Read a Zippyism from the minibuffer with completion, prompting with PROMPT.
|
||||||
If optional second arg is non-nil, require input to match a completion."
|
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))
|
require-match))
|
||||||
|
|
||||||
;;;###autoload
|
;;;###autoload
|
||||||
|
|
|
@ -25,11 +25,10 @@
|
||||||
;;; Commentary:
|
;;; Commentary:
|
||||||
|
|
||||||
;; Support for random cookie fetches from phrase files, used for such
|
;; Support for random cookie fetches from phrase files, used for such
|
||||||
;; critical applications as emulating Zippy the Pinhead and confounding
|
;; critical applications as confounding the NSA Trunk Trawler.
|
||||||
;; the NSA Trunk Trawler.
|
|
||||||
;;
|
;;
|
||||||
;; The two entry points are `cookie' and `cookie-insert'. The helper
|
;; 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:
|
;; 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
|
;; This code derives from Steve Strassmann's 1987 spook.el package, but
|
||||||
;; has been generalized so that it supports multiple simultaneous
|
;; has been generalized so that it supports multiple simultaneous
|
||||||
;; cookie databases and fortune files. It is intended to be called
|
;; 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:
|
;;; 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"
|
(defconst cookie-delimiter "\n%%\n\\|\n%\n\\|\0"
|
||||||
"Delimiter used to separate cookie file entries.")
|
"Delimiter used to separate cookie file entries.")
|
||||||
|
|
||||||
(defvar cookie-cache (make-vector 511 0)
|
(defvar cookie-cache (make-vector 511 0)
|
||||||
"Cache of cookie files that have already been snarfed.")
|
"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
|
;;;###autoload
|
||||||
(defun cookie (phrase-file startmsg endmsg)
|
(defun cookie (phrase-file &optional startmsg endmsg)
|
||||||
"Return a random phrase from PHRASE-FILE.
|
"Return a random phrase from PHRASE-FILE.
|
||||||
When the phrase file is read in, display STARTMSG at the beginning
|
When the phrase file is read in, display STARTMSG at the beginning
|
||||||
of load, ENDMSG at the end."
|
of load, ENDMSG at the end.
|
||||||
(let ((cookie-vector (cookie-snarf phrase-file startmsg endmsg)))
|
Interactively, PHRASE-FILE defaults to `cookie-file', unless that
|
||||||
(shuffle-vector cookie-vector)
|
is nil or a prefix argument is used."
|
||||||
(aref cookie-vector 0)))
|
(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
|
;;;###autoload
|
||||||
(defun cookie-insert (phrase-file &optional count startmsg endmsg)
|
(defun cookie-insert (phrase-file &optional count startmsg endmsg)
|
||||||
"Insert random phrases from PHRASE-FILE; COUNT of them.
|
"Insert random phrases from PHRASE-FILE; COUNT of them.
|
||||||
When the phrase file is read in, display STARTMSG at the beginning
|
When the phrase file is read in, display STARTMSG at the beginning
|
||||||
of load, ENDMSG at the end."
|
of load, ENDMSG at the end."
|
||||||
|
(setq phrase-file (cookie-check-file phrase-file))
|
||||||
(let ((cookie-vector (cookie-snarf phrase-file startmsg endmsg)))
|
(let ((cookie-vector (cookie-snarf phrase-file startmsg endmsg)))
|
||||||
(shuffle-vector cookie-vector)
|
(cookie-shuffle-vector cookie-vector)
|
||||||
(let ((start (point)))
|
(let ((start (point)))
|
||||||
(insert ?\n)
|
(insert ?\n)
|
||||||
(cookie1 (min (- (length cookie-vector) 1) (or count 1)) cookie-vector)
|
(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))))
|
(cookie1 (1- arg) cookie-vec))))
|
||||||
|
|
||||||
;;;###autoload
|
;;;###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.
|
"Reads in the PHRASE-FILE, returns it as a vector of strings.
|
||||||
Emit STARTMSG and ENDMSG before and after. Caches the result; second
|
Emit STARTMSG and ENDMSG before and after. Caches the result; second
|
||||||
and subsequent calls on the same file won't go to disk."
|
and subsequent calls on the same file won't go to disk."
|
||||||
(or (file-readable-p phrase-file)
|
(setq phrase-file (cookie-check-file phrase-file))
|
||||||
(error "Cannot read file `%s'" phrase-file))
|
|
||||||
(let ((sym (intern-soft phrase-file cookie-cache)))
|
(let ((sym (intern-soft phrase-file cookie-cache)))
|
||||||
(and sym (not (equal (symbol-function sym)
|
(and sym (not (equal (symbol-function sym)
|
||||||
(nth 5 (file-attributes phrase-file))))
|
(nth 5 (file-attributes phrase-file))))
|
||||||
|
@ -104,27 +132,25 @@ and subsequent calls on the same file won't go to disk."
|
||||||
(if sym
|
(if sym
|
||||||
(symbol-value sym)
|
(symbol-value sym)
|
||||||
(setq sym (intern phrase-file cookie-cache))
|
(setq sym (intern phrase-file cookie-cache))
|
||||||
(message "%s" startmsg)
|
(if startmsg (message "%s" startmsg))
|
||||||
(save-excursion
|
(fset sym (nth 5 (file-attributes phrase-file)))
|
||||||
(let ((buf (generate-new-buffer "*cookie*"))
|
(let (result)
|
||||||
(result nil))
|
(with-temp-buffer
|
||||||
(set-buffer buf)
|
|
||||||
(fset sym (nth 5 (file-attributes phrase-file)))
|
|
||||||
(insert-file-contents (expand-file-name phrase-file))
|
(insert-file-contents (expand-file-name phrase-file))
|
||||||
(re-search-forward cookie-delimiter)
|
(re-search-forward cookie-delimiter)
|
||||||
(while (progn (skip-chars-forward " \t\n\r\f") (not (eobp)))
|
(while (progn (skip-chars-forward " \t\n\r\f") (not (eobp)))
|
||||||
(let ((beg (point)))
|
(let ((beg (point)))
|
||||||
(re-search-forward cookie-delimiter)
|
(re-search-forward cookie-delimiter)
|
||||||
(setq result (cons (buffer-substring beg (match-beginning 0))
|
(setq result (cons (buffer-substring beg (match-beginning 0))
|
||||||
result))))
|
result)))))
|
||||||
(kill-buffer buf)
|
(if endmsg (message "%s" endmsg))
|
||||||
(message "%s" endmsg)
|
(set sym (apply 'vector result))))))
|
||||||
(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.
|
"Prompt with PROMPT and read with completion among cookies in PHRASE-FILE.
|
||||||
STARTMSG and ENDMSG are passed along to `cookie-snarf'.
|
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.
|
;; Make sure the cookies are in the cache.
|
||||||
(or (intern-soft phrase-file cookie-cache)
|
(or (intern-soft phrase-file cookie-cache)
|
||||||
(cookie-snarf phrase-file startmsg endmsg))
|
(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))))
|
(put sym 'completion-alist alist))))
|
||||||
nil require-match nil nil))
|
nil require-match nil nil))
|
||||||
|
|
||||||
; Thanks to Ian G Batten <BattenIG@CS.BHAM.AC.UK>
|
(define-obsolete-function-alias 'read-cookie 'cookie-read "24.4")
|
||||||
; [of the University of Birmingham Computer Science Department]
|
|
||||||
; for the iterative version of this shuffle.
|
;; Thanks to Ian G Batten <BattenIG@CS.BHAM.AC.UK>
|
||||||
;
|
;; [of the University of Birmingham Computer Science Department]
|
||||||
;;;###autoload
|
;; for the iterative version of this shuffle.
|
||||||
(defun shuffle-vector (vector)
|
(defun cookie-shuffle-vector (vector)
|
||||||
"Randomly permute the elements of VECTOR (all permutations equally likely)."
|
"Randomly permute the elements of VECTOR (all permutations equally likely)."
|
||||||
(let ((i 0)
|
(let ((len (length vector))
|
||||||
j
|
j temp)
|
||||||
temp
|
(dotimes (i len vector)
|
||||||
(len (length vector)))
|
(setq j (+ i (random (- len i)))
|
||||||
(while (< i len)
|
temp (aref vector i))
|
||||||
(setq j (+ i (random (- len i))))
|
|
||||||
(setq temp (aref vector i))
|
|
||||||
(aset vector i (aref vector j))
|
(aset vector i (aref vector j))
|
||||||
(aset vector j temp)
|
(aset vector j temp))))
|
||||||
(setq i (1+ i))))
|
|
||||||
vector)
|
(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)
|
(provide 'cookie1)
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue