view lisp/play/cookie1.el @ 9704:39b34bbe59c9

(x_catch_errors, x_check_errors, x_had_errors_p) (x_uncatch_errors): Make the argument a display, not a frame. (XTread_socket_fake_io_error): New variable. (XTread_socket): Obey XTread_socket_fake_io_error. (x_initialize): Init x_noop_count, x_focus_frame and x_highlight_frame here. (x_term_init): Not here. (x_term_init): Open the connection first thing; if that fails, don't allocate dpyinfo. (x_delete_display): New function. (x_connection_closed): New args dpyinfo and error_message. Delete all frames on the dead display and all frames using them for minibuffers. Call x_delete_display. Maybe signal a Lisp error. (x_term_init): Don't report error here--just return 0. (x_scroll_bar_report_motion): Store proper value in *bar_window (the Emacs window, not the X window number). (x_scroll_bar_report_motion): Don't clear *fp. (x_wm_set_icon_pixmap): Use x_bitmap_pixmap. (show_mouse_face): New arg dpyinfo. All callers changed. (clear_mouse_face): New arg dpyinfo. All callers changed. (scratch_cursor_gc): Variable deleted. (dumpglyphs): Use scratch_cursor_gc in x_display_info. (syms_of_xterm): Don't staticpro mouse_face_window. (expose_all_windows, expose_all_icons): Variables deleted. (BLOCK_INPUT_mask): Variable deleted. (x_term_init): Set up x_id_name field. (x_id_name): Variable deleted. (x_font_table, x_font_table_size, x_n_fonts): Vars deleted. (x_new_font): Use new fields. (warp_mouse_on_deiconify): Unused variable deleted. (x_term_init): Set up dpyinfo->xrdb. Set up dpyinfo->vertical_scroll_bar_cursor. (x_scroll_bar_create): Use vertical_scroll_bar_cursor slot. (x_vertical_scroll_bar_cursor): Variable deleted. (x_term_init): Really return dpyinfo. (x_term_init): Call add_keyboard_wait_descriptor, not change_keyboard_wait_descriptor. (x_term_init): Pass new arg to init_sigio. Don't set old_fcntl_owner. Don't call change_input_fd. (XTread_socket): Loop over displays and process input from each. (x_display_name_list): New variable. (syms_of_xterm): staticpro it. Don't staticpro slots in the_x_screen. (x_term_init): Update x_display_name_list along with x_display_list. Actually malloc the x_display_info. (the_x_screen): Variable deleted.

;;; cookie1.el --- retrieve random phrases from fortune cookie files

;; Copyright (C) 1993 Free Software Foundation, Inc.

;; Author: Eric S. Raymond <[e-mail]>
;; Maintainer: FSF
;; Keywords: games
;; Created: Mon Mar 22 17:06:26 1993

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.

;;; 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.
;;
;; The two entry points are `cookie' and `cookie-insert'.  The helper
;; function `shuffle-vector' may be of interest to programmers.
;;
;; The code expects phrase files to be in one of two formats:
;;
;; * ITS-style LINS format (strings terminated by ASCII 0 characters,
;; leading whitespace ignored).
;;
;; * UNIX fortune file format (quotes terminated by %% on a line by itself).
;;
;; Everything up to the first delimiter is treated as a comment.  Other
;; formats could be supported by adding alternates to the regexp
;; `cookie-delimiter'.
;;
;; This code derives from Steve Strassman'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.
;;
;; TO DO: teach cookie-snarf to auto-detect ITS PINS or UNIX fortune(6)
;; format and do the right thing.

;;; Code:

; Randomize the seed in the random number generator.
(random t)

(defconst cookie-delimiter "\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.")

;;;###autoload
(defun cookie (phrase-file startmsg endmsg)
  "Return a random phrase from PHRASE-FILE.  When the phrase file
is read in, display STARTMSG at beginning of load, ENDMSG at end."
  (let ((cookie-vector (cookie-snarf phrase-file startmsg endmsg)))
    (shuffle-vector cookie-vector)
    (aref cookie-vector 1)))

;;;###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 beginning of load, ENDMSG at end."
  (let ((cookie-vector (cookie-snarf phrase-file startmsg endmsg)))
    (shuffle-vector cookie-vector)
    (let ((start (point)))
      (insert ?\n)
      (cookie1 (min (- (length cookie-vector) 1) (or count 1)) cookie-vector)
      (insert ?\n)
      (fill-region-as-paragraph start (point) nil))))

(defun cookie1 (arg cookie-vec)
  "Inserts a cookie phrase ARG times."
  (cond ((zerop arg) t)
	(t (insert (aref cookie-vec arg))
	   (insert " ")
	   (cookie1 (1- arg) cookie-vec))))

;;;###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."
  (let ((sym (intern-soft phrase-file cookie-cache)))
    (and sym (not (equal (symbol-function sym)
			 (nth 5 (file-attributes phrase-file))))
	 (yes-or-no-p (concat phrase-file
			      " has changed.  Read new contents? "))
	 (setq sym nil))
    (if sym
	(symbol-value sym)
      (setq sym (intern phrase-file cookie-cache))
      (message startmsg)
      (save-excursion
	(let ((buf (generate-new-buffer "*cookie*"))
	      (result nil))
	  (set-buffer buf)
	  (fset sym (nth 5 (file-attributes phrase-file)))
	  (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 (1- (point)))
				 result))))
	  (kill-buffer buf)
	  (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 <[e-mail]>
; [of the University of Birmingham Computer Science Department]
; for the iterative version of this shuffle.
;
;;;###autoload
(defun 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))
      (aset vector i (aref vector j))
      (aset vector j temp)
      (setq i (1+ i))))
  vector)

(provide 'cookie1)

;;; cookie1.el ends here