1;;; fortune.el --- use fortune to create signatures
2
3;; Copyright (C) 1999, 2001, 2002, 2003, 2004,
4;;   2005, 2006, 2007 Free Software Foundation, Inc.
5
6;; Author: Holger Schauer <Holger.Schauer@gmx.de>
7;; Keywords: games utils mail
8
9;; This file is part of GNU Emacs.
10
11;; GNU Emacs is free software; you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
13;; the Free Software Foundation; either version 2, or (at your option)
14;; any later version.
15
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
22;; along with GNU Emacs; see the file COPYING.  If not, write to the
23;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
24;; Boston, MA 02110-1301, USA.
25
26;;; Commentary:
27;; This utility allows you to automatically cut regions to a fortune
28;; file.  In case that the region stems from an article buffer (mail or
29;; news), it will try to automatically determine the author of the
30;; fortune.  It will also allow you to compile your fortune-database
31;; as well as providing a function to extract a fortune for use as your
32;; signature.
33;; Of course, it can simply display a fortune, too.
34;; Use prefix arguments to specify different fortune databases.
35
36;;; Installation:
37
38;; Please check the customize settings -- you will at least have to
39;; modify the values of `fortune-dir' and `fortune-file'.
40
41;; I then use this in my .gnus:
42;;(message "Making new signature: %s" (fortune-to-signature "~/fortunes/"))
43;; This automagically creates a new signature when starting up Gnus.
44;; Note that the call to fortune-to-signature specifies a directory in which
45;; several fortune-files and their databases are stored.
46
47;; If you like to get a new signature for every message, you can also hook
48;; it into message-mode:
49;; (add-hook 'message-setup-hook 'fortune-to-signature)
50;; This time no fortune-file is specified, so fortune-to-signature would use
51;; the default-file as specified by fortune-file.
52
53;; I have also this in my .gnus:
54;;(add-hook 'gnus-article-mode-hook
55;;	  '(lambda ()
56;;	     (define-key gnus-article-mode-map "i" 'fortune-from-region)))
57;; which allows marking a region and then pressing "i" so that the marked
58;; region will be automatically added to my favourite fortune-file.
59
60;;; Code:
61
62;;; **************
63;;; Customizable Settings
64(defgroup fortune nil
65  "Settings for fortune."
66  :link '(emacs-commentary-link "fortune.el")
67  :version "21.1"
68  :group 'games)
69(defgroup fortune-signature nil
70  "Settings for use of fortune for signatures."
71  :group 'fortune
72  :group 'mail)
73
74(defcustom fortune-dir "~/docs/ascii/misc/fortunes/"
75  "*The directory to look in for local fortune cookies files."
76  :type 'directory
77  :group 'fortune)
78(defcustom fortune-file
79  (expand-file-name "usenet" fortune-dir)
80  "*The file in which local fortune cookies will be stored."
81  :type 'file
82  :group 'fortune)
83(defcustom fortune-database-extension  ".dat"
84  "The extension of the corresponding fortune database.
85Normally you won't have a reason to change it."
86  :type 'string
87  :group 'fortune)
88(defcustom fortune-program "fortune"
89  "Program to select a fortune cookie."
90  :type 'string
91  :group 'fortune)
92(defcustom fortune-program-options ""
93  "Options to pass to the fortune program (a string)."
94  :type 'string
95  :group 'fortune)
96(defcustom fortune-strfile "strfile"
97  "Program to compute a new fortune database."
98  :type 'string
99  :group 'fortune)
100(defcustom fortune-strfile-options ""
101  "Options to pass to the strfile program (a string)."
102  :type 'string
103  :group 'fortune)
104(defcustom fortune-quiet-strfile-options "> /dev/null"
105  "Text added to the command for running `strfile'.
106By default it discards the output produced by `strfile'.
107Set this to \"\" if you would like to see the output."
108  :type 'string
109  :group 'fortune)
110
111(defcustom fortune-always-compile t
112  "*Non-nil means automatically compile fortune files.
113If nil, you must invoke `fortune-compile' manually to do that."
114  :type 'boolean
115  :group 'fortune)
116(defcustom fortune-author-line-prefix "                  -- "
117  "Prefix to put before the author name of a fortunate."
118  :type 'string
119  :group 'fortune-signature)
120(defcustom fortune-fill-column fill-column
121  "Fill column for fortune files."
122  :type 'integer
123  :group 'fortune-signature)
124(defcustom fortune-from-mail "private e-mail"
125  "String to use to characterize that the fortune comes from an e-mail.
126No need to add an `in'."
127  :type 'string
128  :group 'fortune-signature)
129(defcustom fortune-sigstart ""
130  "*Some text to insert before the fortune cookie, in a mail signature."
131  :type 'string
132  :group 'fortune-signature)
133(defcustom fortune-sigend ""
134  "*Some text to insert after the fortune cookie, in a mail signature."
135  :type 'string
136  :group 'fortune-signature)
137
138
139;; not customizable settings
140(defvar fortune-buffer-name "*fortune*")
141(defconst fortune-end-sep "\n%\n")
142
143
144;;; **************
145;;; Inserting a new fortune
146(defun fortune-append (string &optional interactive file)
147  "Appends STRING to the fortune FILE.
148
149If INTERACTIVE is non-nil, don't compile the fortune file afterwards."
150  (setq file (expand-file-name
151	      (substitute-in-file-name (or file fortune-file))))
152  (if (file-directory-p file)
153      (error "Cannot append fortune to directory %s" file))
154  (if interactive ; switch to file and return buffer
155      (find-file-other-frame file)
156    (find-file-noselect file))
157  (let ((fortune-buffer (get-file-buffer file)))
158
159    (set-buffer fortune-buffer)
160    (goto-char (point-max))
161    (setq fill-column fortune-fill-column)
162    (setq auto-fill-inhibit-regexp "^%")
163    (turn-on-auto-fill)
164    (insert string fortune-end-sep)
165    (unless interactive
166      (save-buffer)
167      (if fortune-always-compile
168	  (fortune-compile file)))))
169
170(defun fortune-ask-file ()
171  "Asks the user for a file-name."
172  (expand-file-name
173   (read-file-name
174    "Fortune file to use: "
175    fortune-dir nil nil "")))
176
177;;;###autoload
178(defun fortune-add-fortune (string file)
179  "Add STRING to a fortune file FILE.
180
181Interactively, if called with a prefix argument,
182read the file name to use.  Otherwise use the value of `fortune-file'."
183  (interactive
184   (list (read-string "Fortune: ")
185	 (if current-prefix-arg (fortune-ask-file))))
186  (fortune-append string t file))
187
188;;;###autoload
189(defun fortune-from-region (beg end file)
190  "Append the current region to a local fortune-like data file.
191
192Interactively, if called with a prefix argument,
193read the file name to use.  Otherwise use the value of `fortune-file'."
194  (interactive
195   (list (region-beginning) (region-end)
196	 (if current-prefix-arg (fortune-ask-file))))
197  (let ((string (buffer-substring beg end))
198	author newsgroup help-point)
199    ;; try to determine author ...
200    (save-excursion
201      (goto-char (point-min))
202      (setq help-point
203	    (search-forward-regexp
204	     "^From: \\(.*\\)$"
205	     (point-max) t))
206      (if help-point
207	  (setq author (buffer-substring (match-beginning 1) help-point))
208	(setq author "An unknown author")))
209    ;; ... and newsgroup
210    (save-excursion
211      (goto-char (point-min))
212      (setq help-point
213	    (search-forward-regexp
214	     "^Newsgroups: \\(.*\\)$"
215	     (point-max) t))
216      (if help-point
217	  (setq newsgroup (buffer-substring (match-beginning 1) help-point))
218	(setq newsgroup (if (or (eq major-mode 'gnus-article-mode)
219				(eq major-mode 'vm-mode)
220				(eq major-mode 'rmail-mode))
221			    fortune-from-mail
222			  "unknown"))))
223
224    ;; append entry to end of fortune file, and display result
225    (setq string (concat "\"" string "\""
226			 "\n"
227			 fortune-author-line-prefix
228			 author " in " newsgroup))
229    (fortune-append string t file)))
230
231
232;;; **************
233;;; Compile new database with strfile
234;;;###autoload
235(defun fortune-compile (&optional file)
236  "Compile fortune file.
237
238If called with a prefix asks for the FILE to compile, otherwise uses
239the value of `fortune-file'.  This currently cannot handle directories."
240  (interactive
241    (list
242     (if current-prefix-arg
243	 (fortune-ask-file)
244       fortune-file)))
245  (let* ((fortune-file (expand-file-name (substitute-in-file-name file)))
246	 (fortune-dat (expand-file-name
247		       (substitute-in-file-name
248			(concat fortune-file fortune-database-extension)))))
249  (cond ((file-exists-p fortune-file)
250	 (if (file-exists-p fortune-dat)
251	     (cond ((file-newer-than-file-p fortune-file fortune-dat)
252		    (message "Compiling new fortune database %s" fortune-dat)
253		    (shell-command
254		     (concat fortune-strfile fortune-strfile-options
255			     " " fortune-file fortune-quiet-strfile-options))))))
256	(t (error "Can't compile fortune file %s" fortune-file)))))
257
258
259;;; **************
260;;; Use fortune for signature
261;;;###autoload
262(defun fortune-to-signature (&optional file)
263  "Create signature from output of the fortune program.
264
265If called with a prefix asks for the FILE to choose the fortune from,
266otherwise uses the value of `fortune-file'.  If you want to have fortune
267choose from a set of files in a directory, call interactively with prefix
268and choose the directory as the fortune-file."
269  (interactive
270    (list
271     (if current-prefix-arg
272	 (fortune-ask-file)
273       fortune-file)))
274   (save-excursion
275    (fortune-in-buffer t file)
276    (set-buffer fortune-buffer-name)
277    (let* ((fortune (buffer-string))
278	   (signature (concat fortune-sigstart fortune fortune-sigend)))
279      (setq mail-signature signature)
280      (if (boundp 'message-signature)
281	  (setq message-signature signature)))))
282
283
284;;; **************
285;;; Display fortune
286(defun fortune-in-buffer (interactive &optional file)
287  "Put a fortune cookie in the *fortune* buffer.
288
289INTERACTIVE is ignored.  Optional argument FILE,
290when supplied, specifies the file to choose the fortune from."
291  (let ((fortune-buffer (or (get-buffer fortune-buffer-name)
292			    (generate-new-buffer fortune-buffer-name)))
293	(fort-file (expand-file-name
294		    (substitute-in-file-name
295		     (or file fortune-file)))))
296    (save-excursion
297      (set-buffer fortune-buffer)
298      (toggle-read-only 0)
299      (erase-buffer)
300
301      (if fortune-always-compile
302	  (fortune-compile fort-file))
303
304      (call-process
305        fortune-program  ;; programm to call
306	nil fortune-buffer nil ;; INFILE BUFFER DISPLAYP
307	(concat fortune-program-options fort-file)))))
308
309
310;;;###autoload
311(defun fortune (&optional file)
312  "Display a fortune cookie.
313
314If called with a prefix asks for the FILE to choose the fortune from,
315otherwise uses the value of `fortune-file'.  If you want to have fortune
316choose from a set of files in a directory, call interactively with prefix
317and choose the directory as the fortune-file."
318  (interactive
319    (list
320     (if current-prefix-arg
321	 (fortune-ask-file)
322       fortune-file)))
323  (fortune-in-buffer t file)
324  (switch-to-buffer (get-buffer fortune-buffer-name))
325  (toggle-read-only 1))
326
327
328;;; Provide ourselves.
329(provide 'fortune)
330
331;;; arch-tag: a1e4cb8a-3792-40e7-86a7-fc75ce094bcc
332;;; fortune.el ends here
333