signature.el

   1 ;;;
   2 ;;; signature.el --- a signature utility for GNU Emacs
   3 ;;;
   4 ;;; Copyright (C) 1995 Free Software Foundation, Inc.
   5 ;;; Copyright (C) 1994 .. 1996 MORIOKA Tomohiko
   6 ;;; Copyright (C) 1994 OKABE Yasuo
   7 ;;; Copyright (C) 1996 Artur Pioro
   8 ;;;
   9 ;;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
  10 ;;;         OKABE Yasuo <okabe@kudpc.kyoto-u.ac.jp>
  11 ;;;         Artur Pioro <artur@flugor.if.uj.edu.pl>
  12 ;;; Created: 1994/7/11
  13 ;;; Version:
  14 ;;;     $Id: signature.el,v 7.6 1996/03/13 17:30:16 morioka Exp $
  15 ;;; Keywords: mail, news, signature
  16 ;;;
  17 ;;; This file is part of tm (Tools for MIME).
  18 ;;;
  19 ;;; This program is free software; you can redistribute it and/or
  20 ;;; modify it under the terms of the GNU General Public License as
  21 ;;; published by the Free Software Foundation; either version 2, or
  22 ;;; (at your option) any later version.
  23 ;;;
  24 ;;; This program is distributed in the hope that it will be useful,
  25 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  26 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  27 ;;; General Public License for more details.
  28 ;;;
  29 ;;; You should have received a copy of the GNU General Public License
  30 ;;; along with This program.  If not, write to the Free Software
  31 ;;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  32 ;;;
  33 ;;; Code:
  34
  35 (require 'tl-822)
  36
  37 (defvar signature-insert-at-eof nil
  38   "*Insert signature at the end of file if non-nil. [signature.el]")
  39
  40 (defvar signature-delete-blank-lines-at-eof nil
  41   "*Signature-insert-at-eof deletes blank lines at the end of file
  42 if non-nil. [signature.el]")
  43
  44 (defvar signature-file-name "~/.signature"
  45   "*Name of file containing the user's signature. [signature.el]")
  46
  47 (defvar signature-file-alist nil)
  48
  49 (defvar signature-file-prefix nil
  50   "*String containing optional prefix for the signature file names")
  51
  52 ;;;
  53 ;;; Example:
  54 ;;;
  55 ;;; (setq signature-file-alist
  56 ;;;       '((("To" . signature-check-in-bbdb) . nil)
  57 ;;;         (("Newsgroups" . "zxr")   . "~/.signature-sun")
  58 ;;;         (("To" . "uramimi")       . "~/.signature-sun")
  59 ;;;         (("Newsgroups" . "jokes") . "~/.signature-jokes")
  60 ;;;         (("To" . "tea")           . "~/.signature-jokes")
  61 ;;;         (("To" . ("sim" "oku"))   . "~/.signature-formal")
  62 ;;;         ))
  63
  64 (defun signature/get-signature-file-name ()
  65   (catch 'tag
  66     (let ((r signature-file-alist) cell b f)
  67       (save-excursion
  68         (save-restriction
  69           (narrow-to-region
  70            (point-min)
  71            (progn
  72              (goto-char (point-min))
  73              (if (re-search-forward
  74                   (concat "^" (regexp-quote mail-header-separator) "$")
  75                   nil t)
  76                  (match-beginning 0)
  77                (point-max)
  78                )))
  79           (while r
  80             (setq cell (car r))
  81             (setq b (car cell))
  82             (if (setq f (rfc822/get-field-body (car b)))
  83                 (cond ((listp (cdr b))
  84                        (let ((r (cdr b)))
  85                          (while r
  86                            (if (string-match (car r) f)
  87                                (throw 'tag
  88                                       (concat
  89                                        signature-file-prefix (cdr cell)))
  90                              )
  91                            (setq r (cdr r))
  92                            ))
  93                        )
  94                       ((stringp (cdr b))
  95                        (if (string-match (cdr b) f)
  96                            (throw 'tag
  97                                   (concat
  98                                    signature-file-prefix (cdr cell)))
  99                          ))
 100                       ((functionp (cdr b))
 101                        (let ((name (apply (cdr b) f (cdr cell))))
 102                          (if name
 103                              (throw 'tag
 104                                     (concat signature-file-prefix name))
 105                            )))
 106                       ))
 107             (setq r (cdr r))
 108             ))
 109         signature-file-name))))
 110
 111 (defun signature/insert-signature-at-point (&optional arg)
 112   "Insert the file named by signature-file-name at the current point."
 113   (interactive "P")
 114   (let ((signature
 115          (expand-file-name
 116           (if arg
 117               (read-file-name "Insert your signature: "
 118                               (concat signature-file-name "-")
 119                               signature-file-name
 120                               nil)
 121             (signature/get-signature-file-name)))))
 122     (insert-file-contents signature)
 123     (set-buffer-modified-p (buffer-modified-p)) ; force mode line update
 124     signature))
 125
 126 (defun signature/insert-signature-at-eof (&optional arg)
 127   "Insert the file named by signature-file-name at the end of file."
 128   (interactive "P")
 129   (let ((signature
 130          (expand-file-name
 131           (if arg
 132               (read-file-name "Insert your signature: "
 133                               (concat signature-file-name "-")
 134                               signature-file-name
 135                               nil)
 136             (signature/get-signature-file-name)))))
 137     (if (file-readable-p signature)
 138         (progn
 139           (goto-char (point-max))
 140           (if (not (bolp))
 141               (insert "\n"))
 142           (if signature-delete-blank-lines-at-eof (delete-blank-lines))
 143           (insert-file-contents signature)
 144           (set-buffer-modified-p (buffer-modified-p))
 145                                         ; force mode line update
 146           ))
 147     signature))
 148
 149 (defun insert-signature (&optional arg)
 150   "Insert the file named by signature-file-name.  It is inserted at the
 151 end of file if signature-insert-at-eof in non-nil, and otherwise at
 152 the current point.  A prefix argument enables user to specify a file
 153 named <signature-file-name>-DISTRIBUTION interactively."
 154   (interactive "P")
 155   (if signature-insert-at-eof
 156         (call-interactively 'signature/insert-signature-at-eof)
 157     (call-interactively 'signature/insert-signature-at-point)))
 158
 159 (defun signature-check-in-bbdb (address)
 160   "Returns 'sigtype field from BBDB for user specified by ADDRESS"
 161   (require 'bbdb)
 162   (require 'bbdb-com)
 163   (let ((addr-comp (mail-extract-address-components address))
 164         full-name net-name records record sigtype)
 165     (setq full-name (car addr-comp))
 166     (setq net-name (mapconcat (lambda (x) x) (cdr addr-comp) "\\|"))
 167     (setq records
 168           (or
 169            (and full-name
 170                 (bbdb-search (bbdb-records) full-name))
 171            (and net-name
 172                 (bbdb-search (bbdb-records) nil nil net-name))))
 173     (setq record (car records))
 174     (setq records (cdr records))
 175     (setq sigtype (and record (bbdb-record-getprop record 'sigtype)))
 176     (while (and (not sigtype) records)
 177       (setq record (car records))
 178       (setq records (cdr records))
 179       (setq sigtype (bbdb-record-getprop record 'sigtype)))
 180     (if sigtype
 181         (message (concat "Using signature for: "
 182                          (bbdb-record-firstname record) " "
 183                          (bbdb-record-lastname record)
 184                          (and (bbdb-record-aka record)
 185                               (concat " (AKA: "
 186                                       (car (bbdb-record-aka record))
 187                                       ")"))
 188                          " <" (car (bbdb-record-net record)) ">")))
 189     sigtype))
 190
 191
 192 ;;; @ end
 193 ;;;
 194
 195 (provide 'signature)
 196
 197 ;;; signature.el ends here