diff lisp/play/fortune.el @ 25480:f33ed9540026

Initial revision

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/play/fortune.el	Wed Sep 01 23:31:57 1999 +0000
@@ -0,0 +1,317 @@
+;;; fortune.el --- Use fortune to create signatures
+;; Copyright (C) 1999 Free Software Foundation, Inc.
+
+;; Author: Holger Schauer <[e-mail]>
+;; Keywords: games utils mail
+
+;; This file is part of 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, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+;; This utility allows you to automatically cut regions to a fortune
+;; file.  In case that the region stems from an article buffer (mail or
+;; news), it will try to automatically determine the author of the
+;; fortune.  It will also allow you to compile your fortune-database
+;; as well as providing a function to extract a fortune for use as your
+;; signature.
+;; Of course, it can simply display a fortune, too.
+;; Use prefix arguments to specify different fortune databases.
+
+;;; Installation:
+
+;; Please check the customize settings - you will at least have to modify the
+;; values of `fortune-dir' and `fortune-file'.
+
+;; I then use this in my .gnus:
+;;(message "Making new signature: %s" (fortune-to-signature "~/fortunes/"))
+;; This automagically creates a new signature when starting up Gnus.
+;; Note that the call to fortune-to-signature specifies a directory in which
+;; several fortune-files and their databases are stored.
+
+;; If you like to get a new signature for every message, you can also hook
+;; it into message-mode:
+;; (add-hook 'message-setup-hook
+;;           '(lambda ()
+;;              (fortune-to-signature)))      
+;; This time no fortune-file is specified, so fortune-to-signature would use
+;; the default-file as specified by fortune-file.
+
+;; I have also this in my .gnus:
+;;(add-hook 'gnus-article-mode-hook
+;;	  '(lambda ()
+;;	     (define-key gnus-article-mode-map "i" 'fortune-from-region)))
+;; which allows marking a region and then pressing "i" so that the marked 
+;; region will be automatically added to my favourite fortune-file.
+
+;;; Code:
+
+;;; **************
+;;; Customizable Settings
+(defgroup fortune nil
+  "Settings for fortune."
+  :group 'games)
+(defgroup fortune-signature nil
+  "Settings for use of fortune for signatures."
+  :group 'fortune 
+  :group 'mail)
+
+(defcustom fortune-dir "~/docs/ascii/misc/fortunes/"
+  "*The directory to look in for local fortune cookies files."
+  :group 'fortune)
+(defcustom fortune-file 
+  (expand-file-name "usenet" fortune-dir)
+  "*The file in which local fortune cookies will be stored."
+  :group 'fortune)
+(defcustom fortune-database-extension  ".dat"
+  "The extension of the corresponding fortune database. 
+Normally you won't have a reason to change it."
+  :group 'fortune)
+(defcustom fortune-program "fortune"
+  "Program to select a fortune cookie."
+  :group 'fortune)
+(defcustom fortune-program-options ""
+  "Options to pass to the fortune program."
+  :group 'fortune)
+(defcustom fortune-strfile "strfile"
+  "Program to compute a new fortune database."
+  :group 'fortune)
+(defcustom fortune-strfile-options ""
+  "Options to pass to the strfile program."
+  :group 'fortune)
+(defcustom fortune-quiet-strfile-options "> /dev/null"
+  "Text added to the command for running `strfile'.
+By default it discards the output produced by `strfile'.
+Set this to \"\" if you would like to see the output."
+  :group 'fortune)
+
+(defcustom fortune-always-compile t
+  "*Non-nil means automatically compile fortune files.
+If nil, you must invoke `fortune-compile' manually to do that."
+  :group 'fortune)
+(defcustom fortune-author-line-prefix "                  -- "
+  "Prefix to put before the author name of a fortunate."
+  :group 'fortune-signature)
+(defcustom fortune-fill-column fill-column
+  "Fill column for fortune files."
+  :group 'fortune-signature)
+(defcustom fortune-from-mail "private e-mail"
+  "String to use to characterize that the fortune comes from an e-mail.
+No need to add an `in'."
+  :type 'string
+  :group 'fortune-signature)
+(defcustom fortune-sigstart ""
+  "*Some text to insert before the fortune cookie, in a mail signature."
+  :group 'fortune-signature)
+(defcustom fortune-sigend ""
+  "*Some text to insert after the fortune cookie, in a mail signature."
+  :group 'fortune-signature)
+
+
+;; not customizable settings
+(defvar fortune-buffer-name "*fortune*")
+(defconst fortune-end-sep "\n%\n")  
+
+
+;;; **************
+;;; Inserting a new fortune
+(defun fortune-append (string &optional interactive file)
+  "Appends STRING to the fortune FILE. 
+
+If INTERACTIVE is non-nil, don't compile the fortune file afterwards."
+  (setq file (expand-file-name 
+	      (substitute-in-file-name (or file fortune-file))))
+  (if (file-directory-p file)
+      (error "Cannot append fortune to directory %s." file))
+  (if interactive ; switch to file and return buffer
+      (find-file-other-frame file)
+    (find-file-noselect file))
+  (let ((fortune-buffer (get-file-buffer file)))
+
+    (set-buffer fortune-buffer)
+    (goto-char (point-max))
+    (setq fill-column fortune-fill-column)
+    (setq auto-fill-inhibit-regexp "^%")
+    (turn-on-auto-fill)
+    (insert string fortune-end-sep)
+    (unless interactive
+      (save-buffer)
+      (if fortune-always-compile
+	  (fortune-compile file)))))
+
+(defun fortune-ask-file ()
+  "Asks the user for a file-name."
+  (expand-file-name 
+   (read-file-name
+    "Fortune file to use: "
+    fortune-dir nil nil "")))
+
+;;; ###autoload
+(defun fortune-add-fortune (string file)
+  "Add STRING to a fortune file FILE.
+
+Interactively, if called with a prefix argument,
+read the file name to use.  Otherwise use the value of `fortune-file'."
+  (interactive
+   (list (read-string "Fortune: ")
+	 (if current-prefix-arg (fortune-ask-file))))
+  (fortune-append string t file))
+
+;;; ###autoload
+(defun fortune-from-region (beg end file)
+  "Appends the current region to a local fortune-like data file.  
+
+Interactively, if called with a prefix argument,
+read the file name to use.  Otherwise use the value of `fortune-file'."
+  (interactive 
+   (list (region-beginning) (region-end)
+	 (if current-prefix-arg (fortune-ask-file))))
+  (let ((string (buffer-substring beg end))
+	author newsgroup help-point)
+    ;; try to determine author ...
+    (save-excursion
+      (goto-char (point-min))
+      (setq help-point 
+	    (search-forward-regexp
+	     "^From: \\(.*\\)$"
+	     (point-max) t))
+      (if help-point 
+	  (setq author (buffer-substring (match-beginning 1) help-point)) 
+	(setq author "An unknown author")))
+    ;; ... and newsgroup
+    (save-excursion
+      (goto-char (point-min))
+      (setq help-point
+	    (search-forward-regexp
+	     "^Newsgroups: \\(.*\\)$"
+	     (point-max) t))
+      (if help-point 
+	  (setq newsgroup (buffer-substring (match-beginning 1) help-point))
+	(setq newsgroup (if (or (eql major-mode 'gnus-article-mode)
+				(eql major-mode 'vm-mode)
+				(eql major-mode 'rmail-mode))
+			    fortune-from-mail
+			  "unknown"))))
+
+    ;; append entry to end of fortune file, and display result
+    (setq string (concat "\"" string "\""
+			 "\n"
+			 fortune-author-line-prefix
+			 author " in " newsgroup))
+    (fortune-append string t file)))
+
+
+;;; **************
+;;; Compile new database with strfile
+;;; ###autoload
+(defun fortune-compile (&optional file)
+  "Compile fortune file.
+
+If called with a prefix asks for the FILE to compile, otherwise uses
+the value of `fortune-file'.  This currently cannot handle directories."
+  (interactive 
+    (list
+     (if current-prefix-arg
+	 (fortune-ask-file)
+       fortune-file)))
+  (let* ((fortune-file (expand-file-name (substitute-in-file-name file)))
+	 (fortune-dat (expand-file-name 
+		       (substitute-in-file-name
+			(concat fortune-file fortune-database-extension)))))
+  (cond ((file-exists-p fortune-file)
+	 (if (file-exists-p fortune-dat)
+	     (cond ((file-newer-than-file-p fortune-file fortune-dat)
+		    (message "Compiling new fortune database %s" fortune-dat)
+		    (shell-command 
+		     (concat fortune-strfile fortune-strfile-options
+			     " " fortune-file fortune-quiet-strfile-options))))))
+	(t (error "Can't compile fortune file %s" fortune-file)))))
+  
+	 
+;;; **************
+;;; Use fortune for signature
+;;; ###autoload
+(defun fortune-to-signature (&optional file)
+  "Create signature from output of the fortune program.
+
+If called with a prefix asks for the FILE to choose the fortune from,
+otherwise uses the value of `fortune-file'.  If you want to have fortune
+choose from a set of files in a directory, call interactively with prefix
+and choose the directory as the fortune-file."
+  (interactive 
+    (list
+     (if current-prefix-arg
+	 (fortune-ask-file)
+       fortune-file)))
+   (save-excursion
+    (fortune-in-buffer (interactive-p) file)
+    (set-buffer fortune-buffer-name)
+    (let* ((fortune (buffer-string))
+	   (signature (concat fortune-sigstart fortune fortune-sigend)))
+      (setq mail-signature signature)
+      (if (boundp 'message-signature)
+	  (setq message-signature signature)))))
+
+
+;;; **************
+;;; Display fortune
+(defun fortune-in-buffer (interactive &optional file)
+  "Put a fortune cookie in the *fortune* buffer.
+
+When INTERACTIVE is nil, don't display it.  Optional argument FILE,
+when supplied, specifies the file to choose the fortune from."
+  (let ((fortune-buffer (or (get-buffer fortune-buffer-name)
+			    (generate-new-buffer fortune-buffer-name)))
+	(fort-file (expand-file-name
+		    (substitute-in-file-name
+		     (or file fortune-file)))))
+    (save-excursion
+      (set-buffer fortune-buffer)
+      (toggle-read-only 0)
+      (erase-buffer)
+
+      (if fortune-always-compile
+	  (fortune-compile fort-file))
+
+      (call-process
+        fortune-program  ;; programm to call
+	nil fortune-buffer nil ;; INFILE BUFFER DISPLAYP
+	(concat fortune-program-options fort-file)))))
+
+
+;;; ###autoload
+(defun fortune (&optional file)
+  "Display a fortune cookie.
+
+If called with a prefix asks for the FILE to choose the fortune from,
+otherwise uses the value of `fortune-file'.  If you want to have fortune
+choose from a set of files in a directory, call interactively with prefix
+and choose the directory as the fortune-file."
+  (interactive 
+    (list
+     (if current-prefix-arg
+	 (fortune-ask-file)
+       fortune-file)))
+  (fortune-in-buffer t file)
+  (switch-to-buffer (get-buffer fortune-buffer-name))
+  (toggle-read-only 1))
+
+
+;;; Provide ourselves.
+(provide 'fortune)
+
+;;; fortune.el ends here
+