tm 7.48.1.
[elisp/semi.git] / 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.7 1996/03/14 13:39:57 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 (autoload 'signature-check-in-bbdb "tm-bbdb")
65
66 (defun signature/get-signature-file-name ()
67   (catch 'tag
68     (let ((r signature-file-alist) cell b f)
69       (save-excursion
70         (save-restriction
71           (narrow-to-region
72            (point-min)
73            (progn
74              (goto-char (point-min))
75              (if (re-search-forward
76                   (concat "^" (regexp-quote mail-header-separator) "$")
77                   nil t)
78                  (match-beginning 0)
79                (point-max)
80                )))
81           (while r
82             (setq cell (car r))
83             (setq b (car cell))
84             (if (setq f (rfc822/get-field-body (car b)))
85                 (cond ((listp (cdr b))
86                        (let ((r (cdr b)))
87                          (while r
88                            (if (string-match (car r) f)
89                                (throw 'tag
90                                       (concat
91                                        signature-file-prefix (cdr cell)))
92                              )
93                            (setq r (cdr r))
94                            ))
95                        )
96                       ((stringp (cdr b))
97                        (if (string-match (cdr b) f)
98                            (throw 'tag
99                                   (concat
100                                    signature-file-prefix (cdr cell)))
101                          ))
102                       ((functionp (cdr b))
103                        (let ((name (apply (cdr b) f (cdr cell))))
104                          (if name
105                              (throw 'tag
106                                     (concat signature-file-prefix name))
107                            )))
108                       ))
109             (setq r (cdr r))
110             ))
111         signature-file-name))))
112
113 (defun signature/insert-signature-at-point (&optional arg)
114   "Insert the file named by signature-file-name at the current point."
115   (interactive "P")
116   (let ((signature
117          (expand-file-name
118           (if arg
119               (read-file-name "Insert your signature: "
120                               (concat signature-file-name "-")
121                               signature-file-name
122                               nil)
123             (signature/get-signature-file-name)))))
124     (insert-file-contents signature)
125     (set-buffer-modified-p (buffer-modified-p)) ; force mode line update
126     signature))
127
128 (defun signature/insert-signature-at-eof (&optional arg)
129   "Insert the file named by signature-file-name at the end of file."
130   (interactive "P")
131   (let ((signature
132          (expand-file-name
133           (if arg
134               (read-file-name "Insert your signature: "
135                               (concat signature-file-name "-")
136                               signature-file-name
137                               nil)
138             (signature/get-signature-file-name)))))
139     (if (file-readable-p signature)
140         (progn
141           (goto-char (point-max))
142           (if (not (bolp))
143               (insert "\n"))
144           (if signature-delete-blank-lines-at-eof (delete-blank-lines))
145           (insert-file-contents signature)
146           (set-buffer-modified-p (buffer-modified-p))
147                                         ; force mode line update
148           ))
149     signature))
150
151 (defun insert-signature (&optional arg)
152   "Insert the file named by signature-file-name.  It is inserted at the
153 end of file if signature-insert-at-eof in non-nil, and otherwise at
154 the current point.  A prefix argument enables user to specify a file
155 named <signature-file-name>-DISTRIBUTION interactively."
156   (interactive "P")
157   (if signature-insert-at-eof
158         (call-interactively 'signature/insert-signature-at-eof)
159     (call-interactively 'signature/insert-signature-at-point)))
160
161
162 ;;; @ end
163 ;;;
164
165 (provide 'signature)
166
167 ;;; signature.el ends here