diff options
Diffstat (limited to 'bits/bbdb-signature.el')
| -rw-r--r-- | bits/bbdb-signature.el | 193 |
1 files changed, 193 insertions, 0 deletions
diff --git a/bits/bbdb-signature.el b/bits/bbdb-signature.el new file mode 100644 index 0000000..f229063 --- /dev/null +++ b/bits/bbdb-signature.el @@ -0,0 +1,193 @@ +;;; MAIL-SIGNATURE.EL - Add context sensitive signature +;;; Copyright (C) 1997 Kevin Davidson +;;; Copyright (C) 1985, 1986, 1992 Free Software Foundation, Inc + +;;; Maintainer: tkld@quadstone.com +;;; Keywords: mail + +;;; This program 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. + +;;; This program 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. + +;;; A copy of the GNU General Public License can be obtained from this +;;; program's author (send electronic mail to <tkld@quadstone.com>) +;;; or from the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;;; Boston, MA 02111-1307, USA. + +;;; LCD Archive Entry: +;;; mail-signature|Kevin Davidson|<tkld@quadstone.com> +;;; |Add context sensitive signature +;;; |$Date: 2001/03/01 15:38:31 $|$Revision: 1.1 $|~/packages/mail-signature.el + +;;; Commentary: + +;;; This is a reworking of the function mail-signature in sendmail.el +;;; (part of the Emacs distribution) to insert a context sensitive signature. +;;; Using regular expressions, appropriate signatures can be inserted +;;; for different audiences. +;;; Repeated calls removes the current signature from the message and cycles +;;; through all applicable signatures. +;;; Use with something like this in .emacs: +;;; (eval-after-load "sendmail" +;;; (progn +;;; (load "mail-signature") +;;; (setq mail-signature-alist +;;; (append '((bbdb) +;;; ("Newsgroups" "^sci" "-scientific") +;;; ("To" "^[^@]+$" "-local") +;;; ("To" "friend" "-friendly")) mail-signature-alist)))) +;;; And create a file called ~/.signature-friendly that has a +;;; signature appropriate for the user `friend' to receive, a +;;; ~/.signature-local for users at the same site and a +;;; ~/.signature-scientific that contains a signature suitable for sci.* +;;; newsgroups. +;;; Any users in your BBDB that have a `signature' property will get that +;;; signature. Obviously you need to have installed the Insidious Big Brother +;;; Database (BBDB) for this to work. +;;; If using message-mode (included with Emacs 19.34/GNUS 5.3 or later) +;;; (setq message-signature 'mail-signature) + +;;; Change log: +;; $Log: bbdb-signature.el,v $ +;; Revision 1.1 2001/03/01 15:38:31 waider +;; More bits, possibly incompatible with 2.00.06. Use at own risk. +;; +;; Revision 1.11 1997/11/11 11:18:29 tkld +;; Updated email address. +;; +;; Revision 1.10 1997/10/22 14:44:33 tkld +;; Remove dependency on cl. More sanity checking. Checked out on emacs +;; -q. +;; +;; Revision 1.9 1997/10/22 12:42:49 tkld +;; Use bbdb-signature if magic entry 'bbdb is present in +;; mail-signature-alist +;; +;; Revision 1.8 1997/10/21 13:16:04 tkld +;; Off by one error caused first entry in alist to be ignored. +;; +; Revision 1.7 1997/04/18 09:14:51 tkld +; Add change log. Update GPL version and FSF address. Cycle through all +; possible signatures, not just toggle between two. +; + +;;; Code: + +(defconst mail-signature-version (substring "$Revision: 1.1 $" 11 -2) + "$Id: bbdb-signature.el,v 1.1 2001/03/01 15:38:31 waider Exp $ + +Report bugs to: Kevin Davidson <tkld@quadstone.com>") + + +(defvar bbdb-signature-field 'signature + "*BBDB field used to store signature for") + +(defvar mail-signature-last-signature -1 + "Record index of last signature used for repeated calls of mail-signature +Buffer local") +(make-variable-buffer-local 'mail-signature-last-signature) + +(defvar mail-signature-base "~/.signature" + "*The base part of signature filename. +Entries from mail-signature-alist will be added to this.") + +(defvar mail-signature-alist + '(("" "" "")) + "*List of extensions to add to mail-signature-base to form name of sig file. +Format is: (HEADER REGEX EXTENSION), where REGEX is a regular expression +that should match the contents of the mail or news header HEADER. +The first to match is used. In REGEX, ^ and $ mark the beginning and end +of just the text in the header, not the whole line. +If HEADER is the symbol 'bbdb then search for a matching entry and use the +field specified by bbdb-signature-field as the suffix.") + +(defun mail-signature (&optional atpoint) + "Sign letter with context sensitive signature, based on mail-signature-alist. +Argument ATPOINT says whether to insert signature at point, or at end of +buffer." + (interactive "P") + (save-excursion + (or atpoint + (goto-char (point-max))) + ;; First search for previous signature to delete + ;; or delete trailing whitespace + (if (null (search-backward "\n-- \n" (point-min) t)) + (progn + (skip-chars-backward " \t\n") + (end-of-line)) + (skip-chars-backward " \t\n")) + (or atpoint + (delete-region (point) (point-max))) + (insert "\n\n-- \n") + (let ((sig-file (expand-file-name (mail-find-signature)))) + (if (file-exists-p sig-file) + (insert-file-contents sig-file) + (error "Signature file %s does not exist. Check mail-signature-alist." + sig-file))))) + +(defun mail-find-signature () + "Find an appropriate signature file." + (let* ((elist mail-signature-alist) + (found nil) + (sind 0) + (entry (car elist)) + (header (car entry)) + (regex (car (cdr entry))) + (file (car (cdr (cdr entry))))) + (save-excursion + (if (>= mail-signature-last-signature (length mail-signature-alist)) + (setq mail-signature-last-signature -1)) + (while (and (not found) elist) + (if (equal header 'bbdb) + (if (and (> sind mail-signature-last-signature) + (setq file (bbdb-frob-signature))) + (setq found t) + (setq elist (cdr elist) + entry (car elist) + header (car entry) + sind (1+ sind) + regex (car (cdr entry)) + file (car (cdr (cdr entry))))) + (if (and (> sind mail-signature-last-signature) + (mail-position-on-field header 'soft) + (re-search-backward (concat "^" header ":[ \t]*\\(.*\\)$") + (point-min) t) + (string-match regex (buffer-substring-no-properties + (match-beginning 1) (match-end 1)))) + (setq found t) + (setq elist (cdr elist) + entry (car elist) + header (car entry) + sind (1+ sind) + regex (car (cdr entry)) + file (car (cdr (cdr entry)))))))) + (setq mail-signature-last-signature sind) + (concat mail-signature-base file))) + +(defun bbdb-find-signature (name address) + "Look up user NAME and ADDRESS in BBDB and return the appropriate signature." + (let* ((record (bbdb-search-simple name address)) + (sig (and record + (bbdb-record-getprop record bbdb-signature-field)))) + sig)) + +(defun bbdb-frob-signature () + "Parse current message to get recipients and generate signature" + (save-restriction + (save-excursion + (message-narrow-to-headers) + (let* ((to-field (mail-fetch-field "To" nil t)) + (address (mail-extract-address-components (or to-field "")))) + (if (not (equal address '(nil nil))) + (bbdb-find-signature (car address) (car (cdr address))) + nil))))) + +(provide 'mail-signature) + +;; mail-signature.el ends here |