1 ;;; fortune.el --- use fortune to create signatures
3 ;; Copyright (C) 1999, 2001, 2002, 2003, 2004,
4 ;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
6 ;; Author: Holger Schauer <Holger.Schauer@gmx.de>
7 ;; Keywords: games utils mail
9 ;; This file is part of GNU Emacs.
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 3 of the License, or
14 ;; (at your option) any later version.
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.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
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
37 ;; modify the 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 'fortune-to-signature)
48 ;; This time no fortune-file is specified, so fortune-to-signature would use
49 ;; the default-file as specified by fortune-file.
51 ;; I have also this in my .gnus:
52 ;;(add-hook 'gnus-article-mode-hook
54 ;; (define-key gnus-article-mode-map "i" 'fortune-from-region)))
55 ;; which allows marking a region and then pressing "i" so that the marked
56 ;; region will be automatically added to my favourite fortune-file.
61 ;;; Customizable Settings
63 "Settings for fortune."
64 :link
'(emacs-commentary-link "fortune.el")
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."
76 (defcustom fortune-file
77 (expand-file-name "usenet" fortune-dir
)
78 "*The file in which local fortune cookies will be stored."
81 (defcustom fortune-database-extension
".dat"
82 "The extension of the corresponding fortune database.
83 Normally you won't have a reason to change it."
86 (defcustom fortune-program
"fortune"
87 "Program to select a fortune cookie."
90 (defcustom fortune-program-options
""
91 "Options to pass to the fortune program (a string)."
94 (defcustom fortune-strfile
"strfile"
95 "Program to compute a new fortune database."
98 (defcustom fortune-strfile-options
""
99 "Options to pass to the strfile program (a string)."
102 (defcustom fortune-quiet-strfile-options
"> /dev/null"
103 "Text added to the command for running `strfile'.
104 By default it discards the output produced by `strfile'.
105 Set this to \"\" if you would like to see the output."
109 (defcustom fortune-always-compile t
110 "*Non-nil means automatically compile fortune files.
111 If nil, you must invoke `fortune-compile' manually to do that."
114 (defcustom fortune-author-line-prefix
" -- "
115 "Prefix to put before the author name of a fortunate."
117 :group
'fortune-signature
)
118 (defcustom fortune-fill-column fill-column
119 "Fill column for fortune files."
121 :group
'fortune-signature
)
122 (defcustom fortune-from-mail
"private e-mail"
123 "String to use to characterize that the fortune comes from an e-mail.
124 No need to add an `in'."
126 :group
'fortune-signature
)
127 (defcustom fortune-sigstart
""
128 "*Some text to insert before the fortune cookie, in a mail signature."
130 :group
'fortune-signature
)
131 (defcustom fortune-sigend
""
132 "*Some text to insert after the fortune cookie, in a mail signature."
134 :group
'fortune-signature
)
137 ;; not customizable settings
138 (defvar fortune-buffer-name
"*fortune*")
139 (defconst fortune-end-sep
"\n%\n")
143 ;;; Inserting a new fortune
144 (defun fortune-append (string &optional interactive file
)
145 "Appends STRING to the fortune FILE.
147 If INTERACTIVE is non-nil, don't compile the fortune file afterwards."
148 (setq file
(expand-file-name
149 (substitute-in-file-name (or file fortune-file
))))
150 (if (file-directory-p file
)
151 (error "Cannot append fortune to directory %s" file
))
152 (if interactive
; switch to file and return buffer
153 (find-file-other-frame file
)
154 (find-file-noselect file
))
155 (let ((fortune-buffer (get-file-buffer file
)))
157 (set-buffer fortune-buffer
)
158 (goto-char (point-max))
159 (setq fill-column fortune-fill-column
)
160 (setq auto-fill-inhibit-regexp
"^%")
162 (insert string fortune-end-sep
)
165 (if fortune-always-compile
166 (fortune-compile file
)))))
168 (defun fortune-ask-file ()
169 "Asks the user for a file-name."
172 "Fortune file to use: "
173 fortune-dir nil nil
"")))
176 (defun fortune-add-fortune (string file
)
177 "Add STRING to a fortune file FILE.
179 Interactively, if called with a prefix argument,
180 read the file name to use. Otherwise use the value of `fortune-file'."
182 (list (read-string "Fortune: ")
183 (if current-prefix-arg
(fortune-ask-file))))
184 (fortune-append string t file
))
187 (defun fortune-from-region (beg end file
)
188 "Append the current region to a local fortune-like data file.
190 Interactively, if called with a prefix argument,
191 read the file name to use. Otherwise use the value of `fortune-file'."
193 (list (region-beginning) (region-end)
194 (if current-prefix-arg
(fortune-ask-file))))
195 (let ((string (buffer-substring beg end
))
196 author newsgroup help-point
)
197 ;; try to determine author ...
199 (goto-char (point-min))
201 (search-forward-regexp
205 (setq author
(buffer-substring (match-beginning 1) help-point
))
206 (setq author
"An unknown author")))
209 (goto-char (point-min))
211 (search-forward-regexp
212 "^Newsgroups: \\(.*\\)$"
215 (setq newsgroup
(buffer-substring (match-beginning 1) help-point
))
216 (setq newsgroup
(if (or (eq major-mode
'gnus-article-mode
)
217 (eq major-mode
'vm-mode
)
218 (eq major-mode
'rmail-mode
))
222 ;; append entry to end of fortune file, and display result
223 (setq string
(concat "\"" string
"\""
225 fortune-author-line-prefix
226 author
" in " newsgroup
))
227 (fortune-append string t file
)))
231 ;;; Compile new database with strfile
233 (defun fortune-compile (&optional file
)
234 "Compile fortune file.
236 If called with a prefix asks for the FILE to compile, otherwise uses
237 the value of `fortune-file'. This currently cannot handle directories."
240 (if current-prefix-arg
243 (let* ((fortune-file (expand-file-name (substitute-in-file-name file
)))
244 (fortune-dat (expand-file-name
245 (substitute-in-file-name
246 (concat fortune-file fortune-database-extension
)))))
247 (cond ((file-exists-p fortune-file
)
248 (if (file-exists-p fortune-dat
)
249 (cond ((file-newer-than-file-p fortune-file fortune-dat
)
250 (message "Compiling new fortune database %s" fortune-dat
)
252 (concat fortune-strfile fortune-strfile-options
253 " " fortune-file fortune-quiet-strfile-options
))))))
254 (t (error "Can't compile fortune file %s" fortune-file
)))))
258 ;;; Use fortune for signature
260 (defun fortune-to-signature (&optional file
)
261 "Create signature from output of the fortune program.
263 If called with a prefix asks for the FILE to choose the fortune from,
264 otherwise uses the value of `fortune-file'. If you want to have fortune
265 choose from a set of files in a directory, call interactively with prefix
266 and choose the directory as the fortune-file."
269 (if current-prefix-arg
273 (fortune-in-buffer t file
)
274 (set-buffer fortune-buffer-name
)
275 (let* ((fortune (buffer-string))
276 (signature (concat fortune-sigstart fortune fortune-sigend
)))
277 (setq mail-signature signature
)
278 (if (boundp 'message-signature
)
279 (setq message-signature signature
)))))
284 (defun fortune-in-buffer (interactive &optional file
)
285 "Put a fortune cookie in the *fortune* buffer.
287 INTERACTIVE is ignored. Optional argument FILE,
288 when supplied, specifies the file to choose the fortune from."
289 (let ((fortune-buffer (or (get-buffer fortune-buffer-name
)
290 (generate-new-buffer fortune-buffer-name
)))
291 (fort-file (expand-file-name
292 (substitute-in-file-name
293 (or file fortune-file
)))))
295 (set-buffer fortune-buffer
)
299 (if fortune-always-compile
300 (fortune-compile fort-file
))
303 fortune-program
;; programm to call
304 nil fortune-buffer nil
;; INFILE BUFFER DISPLAYP
305 (concat fortune-program-options fort-file
)))))
309 (defun fortune (&optional file
)
310 "Display a fortune cookie.
312 If called with a prefix asks for the FILE to choose the fortune from,
313 otherwise uses the value of `fortune-file'. If you want to have fortune
314 choose from a set of files in a directory, call interactively with prefix
315 and choose the directory as the fortune-file."
318 (if current-prefix-arg
321 (fortune-in-buffer t file
)
322 (switch-to-buffer (get-buffer fortune-buffer-name
))
323 (toggle-read-only 1))
326 ;;; Provide ourselves.
329 ;; arch-tag: a1e4cb8a-3792-40e7-86a7-fc75ce094bcc
330 ;;; fortune.el ends here