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