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 ;;; Copyright (C) 1996 KOBAYASHI Shuhei
   9 ;;;
  10 ;;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
  11 ;;;         OKABE Yasuo <okabe@kudpc.kyoto-u.ac.jp>
  12 ;;;         Artur Pioro <artur@flugor.if.uj.edu.pl>
  13 ;;;         KOBAYASHI Shuhei <shuhei-k@jaist.ac.jp>
  14 ;;; Maintainer: KOBAYASHI Shuhei <shuhei-k@jaist.ac.jp>
  15 ;;; Created: 1994/7/11
  16 ;;; Version:
  17 ;;;     $Id: signature.el,v 7.9 1996/04/19 18:12:43 morioka Exp $
  18 ;;; Keywords: mail, news, signature
  19 ;;;
  20 ;;; This file is part of tm (Tools for MIME).
  21 ;;;
  22 ;;; This program is free software; you can redistribute it and/or
  23 ;;; modify it under the terms of the GNU General Public License as
  24 ;;; published by the Free Software Foundation; either version 2, or
  25 ;;; (at your option) any later version.
  26 ;;;
  27 ;;; This program is distributed in the hope that it will be useful,
  28 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  29 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  30 ;;; General Public License for more details.
  31 ;;;
  32 ;;; You should have received a copy of the GNU General Public License
  33 ;;; along with This program.  If not, write to the Free Software
  34 ;;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  35 ;;;
  36 ;;; Code:
  37
  38 (require 'tl-822)
  39
  40 ;;; @ valiables
  41 ;;;
  42
  43 (defvar signature-insert-at-eof nil
  44   "*Insert signature at the end of file if non-nil.")
  45
  46 (defvar signature-delete-blank-lines-at-eof nil
  47   "*If non-nil, signature-insert-at-eof deletes blank lines at the end
  48 of file.")
  49
  50 (defvar signature-load-hook nil
  51   "*List of functions called after signature.el is loaded.")
  52
  53 (defvar signature-file-name "~/.signature"
  54   "*Name of file containing the user's signature.")
  55
  56 (defvar signature-file-alist nil)
  57
  58 (defvar signature-file-prefix nil
  59   "*String containing optional prefix for the signature file names")
  60
  61 (defvar signature-insert-hook nil
  62   "*List of functions called before inserting a signature.")
  63
  64 (defvar signature-use-bbdb nil
  65   "*If non-nil, Register sigtype to BBDB.")
  66
  67 ;;;
  68 ;;; Example:
  69 ;;;
  70 ;;; (setq signature-file-alist
  71 ;;;       '((("Newsgroups" . "zxr")   . "~/.signature-sun")
  72 ;;;         (("To" . "uramimi")       . "~/.signature-sun")
  73 ;;;         (("Newsgroups" . "jokes") . "~/.signature-jokes")
  74 ;;;         (("To" . "tea")           . "~/.signature-jokes")
  75 ;;;         (("To" . ("sim" "oku"))   . "~/.signature-formal")
  76 ;;;         ))
  77
  78 (autoload 'signature/get-sigtype-from-bbdb "tm-bbdb")
  79
  80 (defun signature/get-sigtype-interactively (&optional default)
  81   (read-file-name "Insert your signature: "
  82                   (or default (concat signature-file-name "-"))
  83                   (or default signature-file-name)
  84                   nil))
  85
  86 (defun signature/get-signature-file-name ()
  87   (save-excursion
  88     (save-restriction
  89       (narrow-to-region
  90        (goto-char (point-min))
  91        (if (re-search-forward
  92             (concat "^" (regexp-quote mail-header-separator) "$")
  93             nil t)
  94            (match-beginning 0)
  95          (point-max)
  96          ))
  97       (catch 'found
  98         (let ((alist signature-file-alist) cell field value)
  99           (while alist
 100             (setq cell  (car alist)
 101                   field (rfc822/get-field-body (car (car cell)))
 102                   value (cdr (car cell)))
 103             (cond ((functionp value)
 104                    (let ((name (apply value field (cdr cell))))
 105                      (if name
 106                          (throw 'found
 107                                 (concat signature-file-prefix name))
 108                        )))
 109                   ((stringp field)
 110                    (cond ((consp value)
 111                           (while value
 112                             (if (string-match (car value) field)
 113                                 (throw 'found
 114                                        (concat
 115                                         signature-file-prefix (cdr cell)))
 116                               (setq value (cdr value))
 117                               )))
 118                          ((stringp value)
 119                           (if (string-match value field)
 120                               (throw 'found
 121                                      (concat
 122                                       signature-file-prefix (cdr cell)))
 123                             )))))
 124             (setq alist (cdr alist))
 125             ))
 126         signature-file-name))))
 127
 128 (defun insert-signature (&optional arg)
 129   "Insert the file named by signature-file-name.
 130 It is inserted at the end of file if signature-insert-at-eof in non-nil,
 131 and otherwise at the current point.  A prefix argument enables user to
 132 specify a file named <signature-file-name>-DISTRIBUTION interactively."
 133   (interactive "P")
 134   (let ((signature
 135          (expand-file-name
 136           (or (and signature-use-bbdb
 137                    (signature/get-sigtype-from-bbdb arg))
 138               (and arg
 139                    (signature/get-sigtype-interactively))
 140               (signature/get-signature-file-name))
 141           )))
 142     (or (file-readable-p signature)
 143         (error "Cannot open signature file: %s" signature))
 144     (if signature-insert-at-eof
 145         (progn
 146           (goto-char (point-max))
 147           (or (bolp) (insert "\n"))
 148           (or signature-delete-blank-lines-at-eof (delete-blank-lines))
 149           ))
 150     (run-hooks 'signature-insert-hook)
 151     (insert-file-contents signature)
 152     (force-mode-line-update)
 153     signature))
 154
 155
 156 ;;; @ end
 157 ;;;
 158
 159 (provide 'signature)
 160
 161 (run-hooks 'signature-load-hook)
 162
 163 ;;; signature.el ends here