forked from wanderlust/semi
-
Notifications
You must be signed in to change notification settings - Fork 0
/
mime-signature.el
199 lines (179 loc) · 6.96 KB
/
mime-signature.el
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
;;; mime-signature.el --- signature handling module for mime-edit
;; Copyright (C) 2013 Kazuhiro Ito
;; Author: Kazuhiro Ito <[email protected]>
;; Keywords: MIME, mail, news
;; This file is part of SEMI (Showy Emacs MIME Interfaces).
;; 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.
;; You should have received a copy of the GNU General Public License
;; along with GNU XEmacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Code:
(require 'mime-edit)
(defcustom mime-edit-signature-separator "\n-- \n"
"Separator between a message text and a signature. It should start and must end with LF."
:group 'mime-edit
:type 'string)
(defcustom mime-edit-default-signature
(or (and (boundp 'signature-file-name)
signature-file-name)
(and (boundp 'mail-signature)
(cond ((stringp mail-signature)
(list (if (string-match
(concat
"^\n*"
(regexp-quote
(if (eq ?\n (string-to-char
mime-edit-signature-separator))
(substring mime-edit-signature-separator 1)
mime-edit-signature-separator)))
mail-signature)
(substring mail-signature (match-end 0))
mail-signature)))
((eq mail-signature t)
(and (boundp 'mail-signaute-file)
mail-signaute-file))
(t (list mail-signature))))
"~/.signature")
"Specify default signature.
signature is string or list of strings and functions.
When signature is string, it indicate signature file name.
When signature is list, each string and function's result are inserted. Function is called with no argument and returns string to be inserted."
:group 'mime-edit
:type '(choice (file :tag "Signature file name")
(repeat (choice
(string :tag "Inserting string")
(function :tag "Calling function")))))
(defcustom mime-edit-signature-position 'part
"Position for signature."
:group 'mime-edit
:type '(choice (const :tag "Anywhere" nil)
(const :tag "At the end of a part" part)
(const :tag "At the end of a message" message)))
(defcustom mime-edit-signature-file-prefix nil
"String containing optional prefix for the signature file names"
:group 'mime-edit
:type '(choice (const :tag "Undefine" nil) (string :tag "Define")))
(defcustom mime-edit-signature-alist nil
"Alist of the form to define inserted signature:
(((FIELDS . PATTERN) . SIGNATURE)
...)
FILEDS is a string or list of strings for searched field names.
PATTERN is a string or list of string or function. If any PATTERN's string matchs with any content of FIELDS, SIGNATURE is inserted. When PATTERN is function, it is called with two arguments, field's content and corresponding SIGNATURE.
SIGNATURE is string or list of strings and functions.
When SIGNATURE is string, it indicate signature file suffix. Actual file name is generated by concatenating with `mime-edit-signature-file-prefix'.
When SIGNATURE is list, each string and function's result is inserted. Function is called no argument and returns string to be inserted."
:group 'mime-edit
:type '(choice
(const :tag "Not define" nil)
(repeat :tag "Define"
(cons
(cons (string :tag "Field name")
(choice (function :tag "File name suffix returning function")
(regexp :tag "Single regexp")
(repeat :tag "Multiple regexp" regexp)))
(choice (string :tag "Signature file name suffix")
(repeat (choice
(string :tag "Inserting string")
(function :tag "Calling function"))))))))
(defun mime-edit-signature-guess ()
;; Guess signature from current buffer and `mime-edit-signature-alist'.
;; return signature to be inserted.
(save-excursion
(save-restriction
(std11-narrow-to-header)
(let ((alist mime-edit-signature-alist)
cell fields value field signature tmp)
(setq signature
(catch 'found
(while alist
(setq cell (car alist)
fields (caar cell)
value (cdar cell))
(when (stringp fields) (setq fields (list fields)))
(while fields
(setq field (std11-fetch-field (car fields)))
(cond
((functionp value)
(when (setq tmp (apply value field (cdr cell)))
(throw 'found tmp)))
((stringp field)
(when (stringp value) (setq value (list value)))
(setq tmp value)
(while tmp
(when (string-match (car tmp) field)
(throw 'found (cdr cell)))
(setq tmp (cdr tmp)))))
(setq fields (cdr fields)))
(setq alist (cdr alist)))))
(or (and (stringp signature)
(concat mime-edit-signature-file-prefix signature))
signature
mime-edit-default-signature)))))
(defun mime-edit-signature-insert-plain (signature)
(if (stringp signature)
(insert-file-contents signature)
(while signature
(cond
((stringp (car signature))
(insert (car signature)))
((functionp (car signature))
(insert (funcall (car signature)))))
(setq signature (cdr signature))))
(unless (eq (char-before) ?\n)
(insert ?\n)))
(defun mime-edit-insert-signature ()
"Insert a signature."
(interactive)
(let ((point (point))
(signature (mime-edit-signature-guess))
start end text-part-p plain-signature-p file-type)
(setq plain-signature-p
(or (null (stringp signature))
(let ((file-type (mime-find-file-type signature)))
(and (equal "text" (car file-type))
(equal "plain" (cadr file-type))))))
(when (eq mime-edit-signature-position 'message)
(goto-char (point-max)))
(re-search-backward mime-edit-tag-regexp nil 'move)
(setq start (point)
end (if (re-search-forward mime-edit-tag-regexp nil t)
(match-beginning 0)
(point-max)))
(when (> point end)
(setq start end
end (if (re-search-forward mime-edit-tag-regexp nil t)
(match-beginning 0)
(point-max))))
(goto-char start)
(setq text-part-p
(or (null (looking-at mime-edit-single-part-tag-regexp))
(string-match "^text/plain" (match-string 1))))
(goto-char (cond ((eq mime-edit-signature-position 'message)
(point-max))
((eq mime-edit-signature-position 'part)
end)
(t
point)))
(unless (and text-part-p plain-signature-p)
(unless (eq (char-before) ?\n) (insert ?\n))
(mime-edit-insert-tag "text" "plain"))
(if plain-signature-p
(progn
(unless (eq (char-before) ?\n) (insert ?\n))
(when (or mime-edit-signature-position
(eq end point))
(insert mime-edit-signature-separator))
(mime-edit-signature-insert-plain signature))
(mime-edit-insert-file signature))))
;;; @ end
;;;
(provide 'mime-signature)
;;; mime-signature.el ends here