summaryrefslogtreecommitdiff
path: root/bits/bbdb-signature.el
diff options
context:
space:
mode:
authorBarak A. Pearlmutter <bap@debian.org>2010-04-20 15:18:13 -0400
committerBarak A. Pearlmutter <bap@debian.org>2010-04-20 15:18:13 -0400
commit0960d4900c9bc749cd72e3d928e8cfbe081712ea (patch)
treea9e6d9f90ba35dd7f1fdb68a96f08808380bfbbe /bits/bbdb-signature.el
Import bbdb_2.36.orig.tar.gz
[dgit import orig bbdb_2.36.orig.tar.gz]
Diffstat (limited to 'bits/bbdb-signature.el')
-rw-r--r--bits/bbdb-signature.el193
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