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