Mercurial > emacs
comparison lisp/play/fortune.el @ 25480:f33ed9540026
Initial revision
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Wed, 01 Sep 1999 23:31:57 +0000 |
parents | |
children | d0e5a99cbda1 |
comparison
equal
deleted
inserted
replaced
25479:dcb2b7cbddca | 25480:f33ed9540026 |
---|---|
1 ;;; fortune.el --- Use fortune to create signatures | |
2 ;; Copyright (C) 1999 Free Software Foundation, Inc. | |
3 | |
4 ;; Author: Holger Schauer <Holger.Schauer@gmx.de> | |
5 ;; Keywords: games utils mail | |
6 | |
7 ;; This file is part of Emacs. | |
8 | |
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) | |
12 ;; any later version. | |
13 | |
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. | |
18 | |
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. | |
23 | |
24 ;;; Commentary: | |
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 | |
30 ;; signature. | |
31 ;; Of course, it can simply display a fortune, too. | |
32 ;; Use prefix arguments to specify different fortune databases. | |
33 | |
34 ;;; Installation: | |
35 | |
36 ;; Please check the customize settings - you will at least have to modify the | |
37 ;; values of `fortune-dir' and `fortune-file'. | |
38 | |
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. | |
44 | |
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 | |
48 ;; '(lambda () | |
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. | |
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 :group 'games) | |
67 (defgroup fortune-signature nil | |
68 "Settings for use of fortune for signatures." | |
69 :group 'fortune | |
70 :group 'mail) | |
71 | |
72 (defcustom fortune-dir "~/docs/ascii/misc/fortunes/" | |
73 "*The directory to look in for local fortune cookies files." | |
74 :group 'fortune) | |
75 (defcustom fortune-file | |
76 (expand-file-name "usenet" fortune-dir) | |
77 "*The file in which local fortune cookies will be stored." | |
78 :group 'fortune) | |
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." | |
82 :group 'fortune) | |
83 (defcustom fortune-program "fortune" | |
84 "Program to select a fortune cookie." | |
85 :group 'fortune) | |
86 (defcustom fortune-program-options "" | |
87 "Options to pass to the fortune program." | |
88 :group 'fortune) | |
89 (defcustom fortune-strfile "strfile" | |
90 "Program to compute a new fortune database." | |
91 :group 'fortune) | |
92 (defcustom fortune-strfile-options "" | |
93 "Options to pass to the strfile program." | |
94 :group 'fortune) | |
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." | |
99 :group 'fortune) | |
100 | |
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." | |
104 :group 'fortune) | |
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'." | |
114 :type 'string | |
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) | |
122 | |
123 | |
124 ;; not customizable settings | |
125 (defvar fortune-buffer-name "*fortune*") | |
126 (defconst fortune-end-sep "\n%\n") | |
127 | |
128 | |
129 ;;; ************** | |
130 ;;; Inserting a new fortune | |
131 (defun fortune-append (string &optional interactive file) | |
132 "Appends STRING to the fortune FILE. | |
133 | |
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))) | |
143 | |
144 (set-buffer fortune-buffer) | |
145 (goto-char (point-max)) | |
146 (setq fill-column fortune-fill-column) | |
147 (setq auto-fill-inhibit-regexp "^%") | |
148 (turn-on-auto-fill) | |
149 (insert string fortune-end-sep) | |
150 (unless interactive | |
151 (save-buffer) | |
152 (if fortune-always-compile | |
153 (fortune-compile file))))) | |
154 | |
155 (defun fortune-ask-file () | |
156 "Asks the user for a file-name." | |
157 (expand-file-name | |
158 (read-file-name | |
159 "Fortune file to use: " | |
160 fortune-dir nil nil ""))) | |
161 | |
162 ;;; ###autoload | |
163 (defun fortune-add-fortune (string file) | |
164 "Add STRING to a fortune file FILE. | |
165 | |
166 Interactively, if called with a prefix argument, | |
167 read the file name to use. Otherwise use the value of `fortune-file'." | |
168 (interactive | |
169 (list (read-string "Fortune: ") | |
170 (if current-prefix-arg (fortune-ask-file)))) | |
171 (fortune-append string t file)) | |
172 | |
173 ;;; ###autoload | |
174 (defun fortune-from-region (beg end file) | |
175 "Appends the current region to a local fortune-like data file. | |
176 | |
177 Interactively, if called with a prefix argument, | |
178 read the file name to use. Otherwise use the value of `fortune-file'." | |
179 (interactive | |
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 ... | |
185 (save-excursion | |
186 (goto-char (point-min)) | |
187 (setq help-point | |
188 (search-forward-regexp | |
189 "^From: \\(.*\\)$" | |
190 (point-max) t)) | |
191 (if help-point | |
192 (setq author (buffer-substring (match-beginning 1) help-point)) | |
193 (setq author "An unknown author"))) | |
194 ;; ... and newsgroup | |
195 (save-excursion | |
196 (goto-char (point-min)) | |
197 (setq help-point | |
198 (search-forward-regexp | |
199 "^Newsgroups: \\(.*\\)$" | |
200 (point-max) t)) | |
201 (if help-point | |
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)) | |
206 fortune-from-mail | |
207 "unknown")))) | |
208 | |
209 ;; append entry to end of fortune file, and display result | |
210 (setq string (concat "\"" string "\"" | |
211 "\n" | |
212 fortune-author-line-prefix | |
213 author " in " newsgroup)) | |
214 (fortune-append string t file))) | |
215 | |
216 | |
217 ;;; ************** | |
218 ;;; Compile new database with strfile | |
219 ;;; ###autoload | |
220 (defun fortune-compile (&optional file) | |
221 "Compile fortune file. | |
222 | |
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." | |
225 (interactive | |
226 (list | |
227 (if current-prefix-arg | |
228 (fortune-ask-file) | |
229 fortune-file))) | |
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) | |
238 (shell-command | |
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))))) | |
242 | |
243 | |
244 ;;; ************** | |
245 ;;; Use fortune for signature | |
246 ;;; ###autoload | |
247 (defun fortune-to-signature (&optional file) | |
248 "Create signature from output of the fortune program. | |
249 | |
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." | |
254 (interactive | |
255 (list | |
256 (if current-prefix-arg | |
257 (fortune-ask-file) | |
258 fortune-file))) | |
259 (save-excursion | |
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))))) | |
267 | |
268 | |
269 ;;; ************** | |
270 ;;; Display fortune | |
271 (defun fortune-in-buffer (interactive &optional file) | |
272 "Put a fortune cookie in the *fortune* buffer. | |
273 | |
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))))) | |
281 (save-excursion | |
282 (set-buffer fortune-buffer) | |
283 (toggle-read-only 0) | |
284 (erase-buffer) | |
285 | |
286 (if fortune-always-compile | |
287 (fortune-compile fort-file)) | |
288 | |
289 (call-process | |
290 fortune-program ;; programm to call | |
291 nil fortune-buffer nil ;; INFILE BUFFER DISPLAYP | |
292 (concat fortune-program-options fort-file))))) | |
293 | |
294 | |
295 ;;; ###autoload | |
296 (defun fortune (&optional file) | |
297 "Display a fortune cookie. | |
298 | |
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." | |
303 (interactive | |
304 (list | |
305 (if current-prefix-arg | |
306 (fortune-ask-file) | |
307 fortune-file))) | |
308 (fortune-in-buffer t file) | |
309 (switch-to-buffer (get-buffer fortune-buffer-name)) | |
310 (toggle-read-only 1)) | |
311 | |
312 | |
313 ;;; Provide ourselves. | |
314 (provide 'fortune) | |
315 | |
316 ;;; fortune.el ends here | |
317 |