mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-12-15 09:47:20 +00:00
319 lines
11 KiB
EmacsLisp
319 lines
11 KiB
EmacsLisp
;;; fortune.el --- Use fortune to create signatures
|
|
;; Copyright (C) 1999 Free Software Foundation, Inc.
|
|
|
|
;; Author: Holger Schauer <Holger.Schauer@gmx.de>
|
|
;; Keywords: games utils mail
|
|
|
|
;; This file is part of Emacs.
|
|
|
|
;; GNU Emacs is free software; you can redistribute it and/or modify
|
|
;; it under the terms of the GNU General Public License as published by
|
|
;; the Free Software Foundation; either version 2, or (at your option)
|
|
;; any later version.
|
|
|
|
;; GNU Emacs is distributed in the hope that it will be useful,
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
;; GNU General Public License for more details.
|
|
|
|
;; You should have received a copy of the GNU General Public License
|
|
;; along with GNU Emacs; see the file COPYING. If not, write to the
|
|
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
;; Boston, MA 02111-1307, USA.
|
|
|
|
;;; Commentary:
|
|
;; This utility allows you to automatically cut regions to a fortune
|
|
;; file. In case that the region stems from an article buffer (mail or
|
|
;; news), it will try to automatically determine the author of the
|
|
;; fortune. It will also allow you to compile your fortune-database
|
|
;; as well as providing a function to extract a fortune for use as your
|
|
;; signature.
|
|
;; Of course, it can simply display a fortune, too.
|
|
;; Use prefix arguments to specify different fortune databases.
|
|
|
|
;;; Installation:
|
|
|
|
;; Please check the customize settings - you will at least have to modify the
|
|
;; values of `fortune-dir' and `fortune-file'.
|
|
|
|
;; I then use this in my .gnus:
|
|
;;(message "Making new signature: %s" (fortune-to-signature "~/fortunes/"))
|
|
;; This automagically creates a new signature when starting up Gnus.
|
|
;; Note that the call to fortune-to-signature specifies a directory in which
|
|
;; several fortune-files and their databases are stored.
|
|
|
|
;; If you like to get a new signature for every message, you can also hook
|
|
;; it into message-mode:
|
|
;; (add-hook 'message-setup-hook
|
|
;; '(lambda ()
|
|
;; (fortune-to-signature)))
|
|
;; This time no fortune-file is specified, so fortune-to-signature would use
|
|
;; the default-file as specified by fortune-file.
|
|
|
|
;; I have also this in my .gnus:
|
|
;;(add-hook 'gnus-article-mode-hook
|
|
;; '(lambda ()
|
|
;; (define-key gnus-article-mode-map "i" 'fortune-from-region)))
|
|
;; which allows marking a region and then pressing "i" so that the marked
|
|
;; region will be automatically added to my favourite fortune-file.
|
|
|
|
;;; Code:
|
|
|
|
;;; **************
|
|
;;; Customizable Settings
|
|
(defgroup fortune nil
|
|
"Settings for fortune."
|
|
:version "21.1"
|
|
:group 'games)
|
|
(defgroup fortune-signature nil
|
|
"Settings for use of fortune for signatures."
|
|
:group 'fortune
|
|
:group 'mail)
|
|
|
|
(defcustom fortune-dir "~/docs/ascii/misc/fortunes/"
|
|
"*The directory to look in for local fortune cookies files."
|
|
:group 'fortune)
|
|
(defcustom fortune-file
|
|
(expand-file-name "usenet" fortune-dir)
|
|
"*The file in which local fortune cookies will be stored."
|
|
:group 'fortune)
|
|
(defcustom fortune-database-extension ".dat"
|
|
"The extension of the corresponding fortune database.
|
|
Normally you won't have a reason to change it."
|
|
:group 'fortune)
|
|
(defcustom fortune-program "fortune"
|
|
"Program to select a fortune cookie."
|
|
:group 'fortune)
|
|
(defcustom fortune-program-options ""
|
|
"Options to pass to the fortune program."
|
|
:group 'fortune)
|
|
(defcustom fortune-strfile "strfile"
|
|
"Program to compute a new fortune database."
|
|
:group 'fortune)
|
|
(defcustom fortune-strfile-options ""
|
|
"Options to pass to the strfile program."
|
|
:group 'fortune)
|
|
(defcustom fortune-quiet-strfile-options "> /dev/null"
|
|
"Text added to the command for running `strfile'.
|
|
By default it discards the output produced by `strfile'.
|
|
Set this to \"\" if you would like to see the output."
|
|
:group 'fortune)
|
|
|
|
(defcustom fortune-always-compile t
|
|
"*Non-nil means automatically compile fortune files.
|
|
If nil, you must invoke `fortune-compile' manually to do that."
|
|
:group 'fortune)
|
|
(defcustom fortune-author-line-prefix " -- "
|
|
"Prefix to put before the author name of a fortunate."
|
|
:group 'fortune-signature)
|
|
(defcustom fortune-fill-column fill-column
|
|
"Fill column for fortune files."
|
|
:group 'fortune-signature)
|
|
(defcustom fortune-from-mail "private e-mail"
|
|
"String to use to characterize that the fortune comes from an e-mail.
|
|
No need to add an `in'."
|
|
:type 'string
|
|
:group 'fortune-signature)
|
|
(defcustom fortune-sigstart ""
|
|
"*Some text to insert before the fortune cookie, in a mail signature."
|
|
:group 'fortune-signature)
|
|
(defcustom fortune-sigend ""
|
|
"*Some text to insert after the fortune cookie, in a mail signature."
|
|
:group 'fortune-signature)
|
|
|
|
|
|
;; not customizable settings
|
|
(defvar fortune-buffer-name "*fortune*")
|
|
(defconst fortune-end-sep "\n%\n")
|
|
|
|
|
|
;;; **************
|
|
;;; Inserting a new fortune
|
|
(defun fortune-append (string &optional interactive file)
|
|
"Appends STRING to the fortune FILE.
|
|
|
|
If INTERACTIVE is non-nil, don't compile the fortune file afterwards."
|
|
(setq file (expand-file-name
|
|
(substitute-in-file-name (or file fortune-file))))
|
|
(if (file-directory-p file)
|
|
(error "Cannot append fortune to directory %s" file))
|
|
(if interactive ; switch to file and return buffer
|
|
(find-file-other-frame file)
|
|
(find-file-noselect file))
|
|
(let ((fortune-buffer (get-file-buffer file)))
|
|
|
|
(set-buffer fortune-buffer)
|
|
(goto-char (point-max))
|
|
(setq fill-column fortune-fill-column)
|
|
(setq auto-fill-inhibit-regexp "^%")
|
|
(turn-on-auto-fill)
|
|
(insert string fortune-end-sep)
|
|
(unless interactive
|
|
(save-buffer)
|
|
(if fortune-always-compile
|
|
(fortune-compile file)))))
|
|
|
|
(defun fortune-ask-file ()
|
|
"Asks the user for a file-name."
|
|
(expand-file-name
|
|
(read-file-name
|
|
"Fortune file to use: "
|
|
fortune-dir nil nil "")))
|
|
|
|
;;; ###autoload
|
|
(defun fortune-add-fortune (string file)
|
|
"Add STRING to a fortune file FILE.
|
|
|
|
Interactively, if called with a prefix argument,
|
|
read the file name to use. Otherwise use the value of `fortune-file'."
|
|
(interactive
|
|
(list (read-string "Fortune: ")
|
|
(if current-prefix-arg (fortune-ask-file))))
|
|
(fortune-append string t file))
|
|
|
|
;;; ###autoload
|
|
(defun fortune-from-region (beg end file)
|
|
"Append the current region to a local fortune-like data file.
|
|
|
|
Interactively, if called with a prefix argument,
|
|
read the file name to use. Otherwise use the value of `fortune-file'."
|
|
(interactive
|
|
(list (region-beginning) (region-end)
|
|
(if current-prefix-arg (fortune-ask-file))))
|
|
(let ((string (buffer-substring beg end))
|
|
author newsgroup help-point)
|
|
;; try to determine author ...
|
|
(save-excursion
|
|
(goto-char (point-min))
|
|
(setq help-point
|
|
(search-forward-regexp
|
|
"^From: \\(.*\\)$"
|
|
(point-max) t))
|
|
(if help-point
|
|
(setq author (buffer-substring (match-beginning 1) help-point))
|
|
(setq author "An unknown author")))
|
|
;; ... and newsgroup
|
|
(save-excursion
|
|
(goto-char (point-min))
|
|
(setq help-point
|
|
(search-forward-regexp
|
|
"^Newsgroups: \\(.*\\)$"
|
|
(point-max) t))
|
|
(if help-point
|
|
(setq newsgroup (buffer-substring (match-beginning 1) help-point))
|
|
(setq newsgroup (if (or (eql major-mode 'gnus-article-mode)
|
|
(eql major-mode 'vm-mode)
|
|
(eql major-mode 'rmail-mode))
|
|
fortune-from-mail
|
|
"unknown"))))
|
|
|
|
;; append entry to end of fortune file, and display result
|
|
(setq string (concat "\"" string "\""
|
|
"\n"
|
|
fortune-author-line-prefix
|
|
author " in " newsgroup))
|
|
(fortune-append string t file)))
|
|
|
|
|
|
;;; **************
|
|
;;; Compile new database with strfile
|
|
;;; ###autoload
|
|
(defun fortune-compile (&optional file)
|
|
"Compile fortune file.
|
|
|
|
If called with a prefix asks for the FILE to compile, otherwise uses
|
|
the value of `fortune-file'. This currently cannot handle directories."
|
|
(interactive
|
|
(list
|
|
(if current-prefix-arg
|
|
(fortune-ask-file)
|
|
fortune-file)))
|
|
(let* ((fortune-file (expand-file-name (substitute-in-file-name file)))
|
|
(fortune-dat (expand-file-name
|
|
(substitute-in-file-name
|
|
(concat fortune-file fortune-database-extension)))))
|
|
(cond ((file-exists-p fortune-file)
|
|
(if (file-exists-p fortune-dat)
|
|
(cond ((file-newer-than-file-p fortune-file fortune-dat)
|
|
(message "Compiling new fortune database %s" fortune-dat)
|
|
(shell-command
|
|
(concat fortune-strfile fortune-strfile-options
|
|
" " fortune-file fortune-quiet-strfile-options))))))
|
|
(t (error "Can't compile fortune file %s" fortune-file)))))
|
|
|
|
|
|
;;; **************
|
|
;;; Use fortune for signature
|
|
;;; ###autoload
|
|
(defun fortune-to-signature (&optional file)
|
|
"Create signature from output of the fortune program.
|
|
|
|
If called with a prefix asks for the FILE to choose the fortune from,
|
|
otherwise uses the value of `fortune-file'. If you want to have fortune
|
|
choose from a set of files in a directory, call interactively with prefix
|
|
and choose the directory as the fortune-file."
|
|
(interactive
|
|
(list
|
|
(if current-prefix-arg
|
|
(fortune-ask-file)
|
|
fortune-file)))
|
|
(save-excursion
|
|
(fortune-in-buffer (interactive-p) file)
|
|
(set-buffer fortune-buffer-name)
|
|
(let* ((fortune (buffer-string))
|
|
(signature (concat fortune-sigstart fortune fortune-sigend)))
|
|
(setq mail-signature signature)
|
|
(if (boundp 'message-signature)
|
|
(setq message-signature signature)))))
|
|
|
|
|
|
;;; **************
|
|
;;; Display fortune
|
|
(defun fortune-in-buffer (interactive &optional file)
|
|
"Put a fortune cookie in the *fortune* buffer.
|
|
|
|
When INTERACTIVE is nil, don't display it. Optional argument FILE,
|
|
when supplied, specifies the file to choose the fortune from."
|
|
(let ((fortune-buffer (or (get-buffer fortune-buffer-name)
|
|
(generate-new-buffer fortune-buffer-name)))
|
|
(fort-file (expand-file-name
|
|
(substitute-in-file-name
|
|
(or file fortune-file)))))
|
|
(save-excursion
|
|
(set-buffer fortune-buffer)
|
|
(toggle-read-only 0)
|
|
(erase-buffer)
|
|
|
|
(if fortune-always-compile
|
|
(fortune-compile fort-file))
|
|
|
|
(call-process
|
|
fortune-program ;; programm to call
|
|
nil fortune-buffer nil ;; INFILE BUFFER DISPLAYP
|
|
(concat fortune-program-options fort-file)))))
|
|
|
|
|
|
;;; ###autoload
|
|
(defun fortune (&optional file)
|
|
"Display a fortune cookie.
|
|
|
|
If called with a prefix asks for the FILE to choose the fortune from,
|
|
otherwise uses the value of `fortune-file'. If you want to have fortune
|
|
choose from a set of files in a directory, call interactively with prefix
|
|
and choose the directory as the fortune-file."
|
|
(interactive
|
|
(list
|
|
(if current-prefix-arg
|
|
(fortune-ask-file)
|
|
fortune-file)))
|
|
(fortune-in-buffer t file)
|
|
(switch-to-buffer (get-buffer fortune-buffer-name))
|
|
(toggle-read-only 1))
|
|
|
|
|
|
;;; Provide ourselves.
|
|
(provide 'fortune)
|
|
|
|
;;; fortune.el ends here
|
|
|