1 ;;; fortune.el --- Use fortune to create signatures
2 ;; Copyright (C) 1999 Free Software Foundation, Inc.
4 ;; Author: Holger Schauer <Holger.Schauer@gmx.de>
5 ;; Keywords: games utils mail
7 ;; This file is part of Emacs.
9 ;; GNU Emacs is free software; you can redistribute it and/or modify
10 ;; it under the terms of the GNU General Public License as published by
11 ;; the Free Software Foundation; either version 2, or (at your option)
14 ;; GNU Emacs is distributed in the hope that it will be useful,
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 ;; GNU General Public License for more details.
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with GNU Emacs; see the file COPYING. If not, write to the
21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
22 ;; Boston, MA 02111-1307, USA.
25 ;; This utility allows you to automatically cut regions to a fortune
26 ;; file. In case that the region stems from an article buffer (mail or
27 ;; news), it will try to automatically determine the author of the
28 ;; fortune. It will also allow you to compile your fortune-database
29 ;; as well as providing a function to extract a fortune for use as your
31 ;; Of course, it can simply display a fortune, too.
32 ;; Use prefix arguments to specify different fortune databases.
36 ;; Please check the customize settings - you will at least have to modify the
37 ;; values of `fortune-dir' and `fortune-file'.
39 ;; I then use this in my .gnus:
40 ;;(message "Making new signature: %s" (fortune-to-signature "~/fortunes/"))
41 ;; This automagically creates a new signature when starting up Gnus.
42 ;; Note that the call to fortune-to-signature specifies a directory in which
43 ;; several fortune-files and their databases are stored.
45 ;; If you like to get a new signature for every message, you can also hook
46 ;; it into message-mode:
47 ;; (add-hook 'message-setup-hook
49 ;; (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.
53 ;; I have also this in my .gnus:
54 ;;(add-hook 'gnus-article-mode-hook
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.
63 ;;; Customizable Settings
65 "Settings for fortune."
67 (defgroup fortune-signature nil
68 "Settings for use of fortune for signatures."
72 (defcustom fortune-dir
"~/docs/ascii/misc/fortunes/"
73 "*The directory to look in for local fortune cookies files."
75 (defcustom fortune-file
76 (expand-file-name "usenet" fortune-dir
)
77 "*The file in which local fortune cookies will be stored."
79 (defcustom fortune-database-extension
".dat"
80 "The extension of the corresponding fortune database.
81 Normally you won't have a reason to change it."
83 (defcustom fortune-program
"fortune"
84 "Program to select a fortune cookie."
86 (defcustom fortune-program-options
""
87 "Options to pass to the fortune program."
89 (defcustom fortune-strfile
"strfile"
90 "Program to compute a new fortune database."
92 (defcustom fortune-strfile-options
""
93 "Options to pass to the strfile program."
95 (defcustom fortune-quiet-strfile-options
"> /dev/null"
96 "Text added to the command for running `strfile'.
97 By default it discards the output produced by `strfile'.
98 Set this to \"\" if you would like to see the output."
101 (defcustom fortune-always-compile t
102 "*Non-nil means automatically compile fortune files.
103 If nil, you must invoke `fortune-compile' manually to do that."
105 (defcustom fortune-author-line-prefix
" -- "
106 "Prefix to put before the author name of a fortunate."
107 :group
'fortune-signature
)
108 (defcustom fortune-fill-column fill-column
109 "Fill column for fortune files."
110 :group
'fortune-signature
)
111 (defcustom fortune-from-mail
"private e-mail"
112 "String to use to characterize that the fortune comes from an e-mail.
113 No need to add an `in'."
115 :group
'fortune-signature
)
116 (defcustom fortune-sigstart
""
117 "*Some text to insert before the fortune cookie, in a mail signature."
118 :group
'fortune-signature
)
119 (defcustom fortune-sigend
""
120 "*Some text to insert after the fortune cookie, in a mail signature."
121 :group
'fortune-signature
)
124 ;; not customizable settings
125 (defvar fortune-buffer-name
"*fortune*")
126 (defconst fortune-end-sep
"\n%\n")
130 ;;; Inserting a new fortune
131 (defun fortune-append (string &optional interactive file
)
132 "Appends STRING to the fortune FILE.
134 If INTERACTIVE is non-nil, don't compile the fortune file afterwards."
135 (setq file
(expand-file-name
136 (substitute-in-file-name (or file fortune-file
))))
137 (if (file-directory-p file
)
138 (error "Cannot append fortune to directory %s." file
))
139 (if interactive
; switch to file and return buffer
140 (find-file-other-frame file
)
141 (find-file-noselect file
))
142 (let ((fortune-buffer (get-file-buffer file
)))
144 (set-buffer fortune-buffer
)
145 (goto-char (point-max))
146 (setq fill-column fortune-fill-column
)
147 (setq auto-fill-inhibit-regexp
"^%")
149 (insert string fortune-end-sep
)
152 (if fortune-always-compile
153 (fortune-compile file
)))))
155 (defun fortune-ask-file ()
156 "Asks the user for a file-name."
159 "Fortune file to use: "
160 fortune-dir nil nil
"")))
163 (defun fortune-add-fortune (string file
)
164 "Add STRING to a fortune file FILE.
166 Interactively, if called with a prefix argument,
167 read the file name to use. Otherwise use the value of `fortune-file'."
169 (list (read-string "Fortune: ")
170 (if current-prefix-arg
(fortune-ask-file))))
171 (fortune-append string t file
))
174 (defun fortune-from-region (beg end file
)
175 "Appends the current region to a local fortune-like data file.
177 Interactively, if called with a prefix argument,
178 read the file name to use. Otherwise use the value of `fortune-file'."
180 (list (region-beginning) (region-end)
181 (if current-prefix-arg
(fortune-ask-file))))
182 (let ((string (buffer-substring beg end
))
183 author newsgroup help-point
)
184 ;; try to determine author ...
186 (goto-char (point-min))
188 (search-forward-regexp
192 (setq author
(buffer-substring (match-beginning 1) help-point
))
193 (setq author
"An unknown author")))
196 (goto-char (point-min))
198 (search-forward-regexp
199 "^Newsgroups: \\(.*\\)$"
202 (setq newsgroup
(buffer-substring (match-beginning 1) help-point
))
203 (setq newsgroup
(if (or (eql major-mode
'gnus-article-mode
)
204 (eql major-mode
'vm-mode
)
205 (eql major-mode
'rmail-mode
))
209 ;; append entry to end of fortune file, and display result
210 (setq string
(concat "\"" string
"\""
212 fortune-author-line-prefix
213 author
" in " newsgroup
))
214 (fortune-append string t file
)))
218 ;;; Compile new database with strfile
220 (defun fortune-compile (&optional file
)
221 "Compile fortune file.
223 If called with a prefix asks for the FILE to compile, otherwise uses
224 the value of `fortune-file'. This currently cannot handle directories."
227 (if current-prefix-arg
230 (let* ((fortune-file (expand-file-name (substitute-in-file-name file
)))
231 (fortune-dat (expand-file-name
232 (substitute-in-file-name
233 (concat fortune-file fortune-database-extension
)))))
234 (cond ((file-exists-p fortune-file
)
235 (if (file-exists-p fortune-dat
)
236 (cond ((file-newer-than-file-p fortune-file fortune-dat
)
237 (message "Compiling new fortune database %s" fortune-dat
)
239 (concat fortune-strfile fortune-strfile-options
240 " " fortune-file fortune-quiet-strfile-options
))))))
241 (t (error "Can't compile fortune file %s" fortune-file
)))))
245 ;;; Use fortune for signature
247 (defun fortune-to-signature (&optional file
)
248 "Create signature from output of the fortune program.
250 If called with a prefix asks for the FILE to choose the fortune from,
251 otherwise uses the value of `fortune-file'. If you want to have fortune
252 choose from a set of files in a directory, call interactively with prefix
253 and choose the directory as the fortune-file."
256 (if current-prefix-arg
260 (fortune-in-buffer (interactive-p) file
)
261 (set-buffer fortune-buffer-name
)
262 (let* ((fortune (buffer-string))
263 (signature (concat fortune-sigstart fortune fortune-sigend
)))
264 (setq mail-signature signature
)
265 (if (boundp 'message-signature
)
266 (setq message-signature signature
)))))
271 (defun fortune-in-buffer (interactive &optional file
)
272 "Put a fortune cookie in the *fortune* buffer.
274 When INTERACTIVE is nil, don't display it. Optional argument FILE,
275 when supplied, specifies the file to choose the fortune from."
276 (let ((fortune-buffer (or (get-buffer fortune-buffer-name
)
277 (generate-new-buffer fortune-buffer-name
)))
278 (fort-file (expand-file-name
279 (substitute-in-file-name
280 (or file fortune-file
)))))
282 (set-buffer fortune-buffer
)
286 (if fortune-always-compile
287 (fortune-compile fort-file
))
290 fortune-program
;; programm to call
291 nil fortune-buffer nil
;; INFILE BUFFER DISPLAYP
292 (concat fortune-program-options fort-file
)))))
296 (defun fortune (&optional file
)
297 "Display a fortune cookie.
299 If called with a prefix asks for the FILE to choose the fortune from,
300 otherwise uses the value of `fortune-file'. If you want to have fortune
301 choose from a set of files in a directory, call interactively with prefix
302 and choose the directory as the fortune-file."
305 (if current-prefix-arg
308 (fortune-in-buffer t file
)
309 (switch-to-buffer (get-buffer fortune-buffer-name
))
310 (toggle-read-only 1))
313 ;;; Provide ourselves.
316 ;;; fortune.el ends here