Mercurial > emacs
annotate lisp/play/fortune.el @ 96849:d049ef97c446
* print.c (print_object): Check print_depth before searching for
circularities.
author | Chong Yidong <cyd@stupidchicken.com> |
---|---|
date | Mon, 21 Jul 2008 05:02:31 +0000 |
parents | 949bd6ad1ba4 |
children | c4f6098c0914 |
rev | line source |
---|---|
38425
c6e12c6b1498
Some fixes to follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents:
38397
diff
changeset
|
1 ;;; fortune.el --- use fortune to create signatures |
38524 | 2 |
64701
34bd8e434dd7
Update years in copyright notice; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
64085
diff
changeset
|
3 ;; Copyright (C) 1999, 2001, 2002, 2003, 2004, |
79716 | 4 ;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. |
25480 | 5 |
6 ;; Author: Holger Schauer <Holger.Schauer@gmx.de> | |
7 ;; Keywords: games utils mail | |
8 | |
38425
c6e12c6b1498
Some fixes to follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents:
38397
diff
changeset
|
9 ;; This file is part of GNU Emacs. |
25480 | 10 |
94675
949bd6ad1ba4
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
11 ;; GNU Emacs is free software: you can redistribute it and/or modify |
25480 | 12 ;; it under the terms of the GNU General Public License as published by |
94675
949bd6ad1ba4
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
13 ;; the Free Software Foundation, either version 3 of the License, or |
949bd6ad1ba4
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
14 ;; (at your option) any later version. |
25480 | 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 | |
94675
949bd6ad1ba4
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
25480 | 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 | |
38524 | 36 ;; Please check the customize settings -- you will at least have to |
37 ;; modify the values of `fortune-dir' and `fortune-file'. | |
25480 | 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: | |
38524 | 47 ;; (add-hook 'message-setup-hook 'fortune-to-signature) |
25480 | 48 ;; This time no fortune-file is specified, so fortune-to-signature would use |
49 ;; the default-file as specified by fortune-file. | |
50 | |
51 ;; I have also this in my .gnus: | |
52 ;;(add-hook 'gnus-article-mode-hook | |
53 ;; '(lambda () | |
54 ;; (define-key gnus-article-mode-map "i" 'fortune-from-region))) | |
30860
d0e5a99cbda1
(fortune) <defgroup>: Add :version.
Dave Love <fx@gnu.org>
parents:
25480
diff
changeset
|
55 ;; which allows marking a region and then pressing "i" so that the marked |
25480 | 56 ;; region will be automatically added to my favourite fortune-file. |
57 | |
58 ;;; Code: | |
59 | |
60 ;;; ************** | |
61 ;;; Customizable Settings | |
62 (defgroup fortune nil | |
63 "Settings for fortune." | |
38524 | 64 :link '(emacs-commentary-link "fortune.el") |
30860
d0e5a99cbda1
(fortune) <defgroup>: Add :version.
Dave Love <fx@gnu.org>
parents:
25480
diff
changeset
|
65 :version "21.1" |
25480 | 66 :group 'games) |
67 (defgroup fortune-signature nil | |
68 "Settings for use of fortune for signatures." | |
30860
d0e5a99cbda1
(fortune) <defgroup>: Add :version.
Dave Love <fx@gnu.org>
parents:
25480
diff
changeset
|
69 :group 'fortune |
25480 | 70 :group 'mail) |
71 | |
72 (defcustom fortune-dir "~/docs/ascii/misc/fortunes/" | |
73 "*The directory to look in for local fortune cookies files." | |
38524 | 74 :type 'directory |
75 :group 'fortune) | |
76 (defcustom fortune-file | |
77 (expand-file-name "usenet" fortune-dir) | |
25480 | 78 "*The file in which local fortune cookies will be stored." |
38524 | 79 :type 'file |
80 :group 'fortune) | |
25480 | 81 (defcustom fortune-database-extension ".dat" |
30860
d0e5a99cbda1
(fortune) <defgroup>: Add :version.
Dave Love <fx@gnu.org>
parents:
25480
diff
changeset
|
82 "The extension of the corresponding fortune database. |
25480 | 83 Normally you won't have a reason to change it." |
38524 | 84 :type 'string |
85 :group 'fortune) | |
25480 | 86 (defcustom fortune-program "fortune" |
87 "Program to select a fortune cookie." | |
38524 | 88 :type 'string |
89 :group 'fortune) | |
25480 | 90 (defcustom fortune-program-options "" |
38524 | 91 "Options to pass to the fortune program (a string)." |
92 :type 'string | |
93 :group 'fortune) | |
25480 | 94 (defcustom fortune-strfile "strfile" |
95 "Program to compute a new fortune database." | |
38524 | 96 :type 'string |
97 :group 'fortune) | |
25480 | 98 (defcustom fortune-strfile-options "" |
38524 | 99 "Options to pass to the strfile program (a string)." |
100 :type 'string | |
101 :group 'fortune) | |
25480 | 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." | |
38524 | 106 :type 'string |
107 :group 'fortune) | |
25480 | 108 |
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." | |
38524 | 112 :type 'boolean |
113 :group 'fortune) | |
25480 | 114 (defcustom fortune-author-line-prefix " -- " |
115 "Prefix to put before the author name of a fortunate." | |
38524 | 116 :type 'string |
117 :group 'fortune-signature) | |
25480 | 118 (defcustom fortune-fill-column fill-column |
119 "Fill column for fortune files." | |
38524 | 120 :type 'integer |
121 :group 'fortune-signature) | |
25480 | 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'." | |
125 :type 'string | |
126 :group 'fortune-signature) | |
127 (defcustom fortune-sigstart "" | |
128 "*Some text to insert before the fortune cookie, in a mail signature." | |
38524 | 129 :type 'string |
130 :group 'fortune-signature) | |
25480 | 131 (defcustom fortune-sigend "" |
132 "*Some text to insert after the fortune cookie, in a mail signature." | |
38524 | 133 :type 'string |
134 :group 'fortune-signature) | |
25480 | 135 |
136 | |
137 ;; not customizable settings | |
138 (defvar fortune-buffer-name "*fortune*") | |
30860
d0e5a99cbda1
(fortune) <defgroup>: Add :version.
Dave Love <fx@gnu.org>
parents:
25480
diff
changeset
|
139 (defconst fortune-end-sep "\n%\n") |
25480 | 140 |
141 | |
142 ;;; ************** | |
143 ;;; Inserting a new fortune | |
144 (defun fortune-append (string &optional interactive file) | |
30860
d0e5a99cbda1
(fortune) <defgroup>: Add :version.
Dave Love <fx@gnu.org>
parents:
25480
diff
changeset
|
145 "Appends STRING to the fortune FILE. |
25480 | 146 |
147 If INTERACTIVE is non-nil, don't compile the fortune file afterwards." | |
30860
d0e5a99cbda1
(fortune) <defgroup>: Add :version.
Dave Love <fx@gnu.org>
parents:
25480
diff
changeset
|
148 (setq file (expand-file-name |
25480 | 149 (substitute-in-file-name (or file fortune-file)))) |
150 (if (file-directory-p file) | |
30860
d0e5a99cbda1
(fortune) <defgroup>: Add :version.
Dave Love <fx@gnu.org>
parents:
25480
diff
changeset
|
151 (error "Cannot append fortune to directory %s" file)) |
25480 | 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))) | |
156 | |
157 (set-buffer fortune-buffer) | |
158 (goto-char (point-max)) | |
159 (setq fill-column fortune-fill-column) | |
160 (setq auto-fill-inhibit-regexp "^%") | |
161 (turn-on-auto-fill) | |
162 (insert string fortune-end-sep) | |
163 (unless interactive | |
164 (save-buffer) | |
165 (if fortune-always-compile | |
166 (fortune-compile file))))) | |
167 | |
168 (defun fortune-ask-file () | |
169 "Asks the user for a file-name." | |
30860
d0e5a99cbda1
(fortune) <defgroup>: Add :version.
Dave Love <fx@gnu.org>
parents:
25480
diff
changeset
|
170 (expand-file-name |
25480 | 171 (read-file-name |
172 "Fortune file to use: " | |
173 fortune-dir nil nil ""))) | |
174 | |
37426 | 175 ;;;###autoload |
25480 | 176 (defun fortune-add-fortune (string file) |
177 "Add STRING to a fortune file FILE. | |
178 | |
179 Interactively, if called with a prefix argument, | |
180 read the file name to use. Otherwise use the value of `fortune-file'." | |
181 (interactive | |
182 (list (read-string "Fortune: ") | |
183 (if current-prefix-arg (fortune-ask-file)))) | |
184 (fortune-append string t file)) | |
185 | |
37426 | 186 ;;;###autoload |
25480 | 187 (defun fortune-from-region (beg end file) |
30860
d0e5a99cbda1
(fortune) <defgroup>: Add :version.
Dave Love <fx@gnu.org>
parents:
25480
diff
changeset
|
188 "Append the current region to a local fortune-like data file. |
25480 | 189 |
190 Interactively, if called with a prefix argument, | |
191 read the file name to use. Otherwise use the value of `fortune-file'." | |
30860
d0e5a99cbda1
(fortune) <defgroup>: Add :version.
Dave Love <fx@gnu.org>
parents:
25480
diff
changeset
|
192 (interactive |
25480 | 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 ... | |
198 (save-excursion | |
199 (goto-char (point-min)) | |
30860
d0e5a99cbda1
(fortune) <defgroup>: Add :version.
Dave Love <fx@gnu.org>
parents:
25480
diff
changeset
|
200 (setq help-point |
25480 | 201 (search-forward-regexp |
202 "^From: \\(.*\\)$" | |
203 (point-max) t)) | |
30860
d0e5a99cbda1
(fortune) <defgroup>: Add :version.
Dave Love <fx@gnu.org>
parents:
25480
diff
changeset
|
204 (if help-point |
d0e5a99cbda1
(fortune) <defgroup>: Add :version.
Dave Love <fx@gnu.org>
parents:
25480
diff
changeset
|
205 (setq author (buffer-substring (match-beginning 1) help-point)) |
25480 | 206 (setq author "An unknown author"))) |
207 ;; ... and newsgroup | |
208 (save-excursion | |
209 (goto-char (point-min)) | |
210 (setq help-point | |
211 (search-forward-regexp | |
212 "^Newsgroups: \\(.*\\)$" | |
213 (point-max) t)) | |
30860
d0e5a99cbda1
(fortune) <defgroup>: Add :version.
Dave Love <fx@gnu.org>
parents:
25480
diff
changeset
|
214 (if help-point |
25480 | 215 (setq newsgroup (buffer-substring (match-beginning 1) help-point)) |
37428
6586c75e5eda
(fortune-from-region): Use `eq' instead of `eql'.
Gerd Moellmann <gerd@gnu.org>
parents:
37426
diff
changeset
|
216 (setq newsgroup (if (or (eq major-mode 'gnus-article-mode) |
6586c75e5eda
(fortune-from-region): Use `eq' instead of `eql'.
Gerd Moellmann <gerd@gnu.org>
parents:
37426
diff
changeset
|
217 (eq major-mode 'vm-mode) |
6586c75e5eda
(fortune-from-region): Use `eq' instead of `eql'.
Gerd Moellmann <gerd@gnu.org>
parents:
37426
diff
changeset
|
218 (eq major-mode 'rmail-mode)) |
25480 | 219 fortune-from-mail |
220 "unknown")))) | |
221 | |
222 ;; append entry to end of fortune file, and display result | |
223 (setq string (concat "\"" string "\"" | |
224 "\n" | |
225 fortune-author-line-prefix | |
226 author " in " newsgroup)) | |
227 (fortune-append string t file))) | |
228 | |
229 | |
230 ;;; ************** | |
231 ;;; Compile new database with strfile | |
37426 | 232 ;;;###autoload |
25480 | 233 (defun fortune-compile (&optional file) |
234 "Compile fortune file. | |
235 | |
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." | |
30860
d0e5a99cbda1
(fortune) <defgroup>: Add :version.
Dave Love <fx@gnu.org>
parents:
25480
diff
changeset
|
238 (interactive |
25480 | 239 (list |
240 (if current-prefix-arg | |
241 (fortune-ask-file) | |
242 fortune-file))) | |
243 (let* ((fortune-file (expand-file-name (substitute-in-file-name file))) | |
30860
d0e5a99cbda1
(fortune) <defgroup>: Add :version.
Dave Love <fx@gnu.org>
parents:
25480
diff
changeset
|
244 (fortune-dat (expand-file-name |
25480 | 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) | |
30860
d0e5a99cbda1
(fortune) <defgroup>: Add :version.
Dave Love <fx@gnu.org>
parents:
25480
diff
changeset
|
251 (shell-command |
25480 | 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))))) | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
38524
diff
changeset
|
255 |
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
38524
diff
changeset
|
256 |
25480 | 257 ;;; ************** |
258 ;;; Use fortune for signature | |
37426 | 259 ;;;###autoload |
25480 | 260 (defun fortune-to-signature (&optional file) |
261 "Create signature from output of the fortune program. | |
262 | |
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." | |
30860
d0e5a99cbda1
(fortune) <defgroup>: Add :version.
Dave Love <fx@gnu.org>
parents:
25480
diff
changeset
|
267 (interactive |
25480 | 268 (list |
269 (if current-prefix-arg | |
270 (fortune-ask-file) | |
271 fortune-file))) | |
272 (save-excursion | |
57825
627816ec9a05
(fortune-to-signature): Don't use interactive-p.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
273 (fortune-in-buffer t file) |
25480 | 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))))) | |
280 | |
281 | |
282 ;;; ************** | |
283 ;;; Display fortune | |
284 (defun fortune-in-buffer (interactive &optional file) | |
285 "Put a fortune cookie in the *fortune* buffer. | |
286 | |
57825
627816ec9a05
(fortune-to-signature): Don't use interactive-p.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
287 INTERACTIVE is ignored. Optional argument FILE, |
25480 | 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))))) | |
294 (save-excursion | |
295 (set-buffer fortune-buffer) | |
296 (toggle-read-only 0) | |
297 (erase-buffer) | |
298 | |
299 (if fortune-always-compile | |
300 (fortune-compile fort-file)) | |
301 | |
302 (call-process | |
303 fortune-program ;; programm to call | |
304 nil fortune-buffer nil ;; INFILE BUFFER DISPLAYP | |
305 (concat fortune-program-options fort-file))))) | |
306 | |
307 | |
37426 | 308 ;;;###autoload |
25480 | 309 (defun fortune (&optional file) |
310 "Display a fortune cookie. | |
311 | |
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." | |
30860
d0e5a99cbda1
(fortune) <defgroup>: Add :version.
Dave Love <fx@gnu.org>
parents:
25480
diff
changeset
|
316 (interactive |
25480 | 317 (list |
318 (if current-prefix-arg | |
319 (fortune-ask-file) | |
320 fortune-file))) | |
321 (fortune-in-buffer t file) | |
322 (switch-to-buffer (get-buffer fortune-buffer-name)) | |
323 (toggle-read-only 1)) | |
324 | |
325 | |
326 ;;; Provide ourselves. | |
327 (provide 'fortune) | |
328 | |
93975
1e3a407766b9
Fix up comment convention on the arch-tag lines.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
79716
diff
changeset
|
329 ;; arch-tag: a1e4cb8a-3792-40e7-86a7-fc75ce094bcc |
25480 | 330 ;;; fortune.el ends here |