1
by Tatsuya Kinoshita
Import upstream version 4.0.65 |
1 |
;; mew-addrbook.el --- Aliases and personal information
|
2 |
||
3 |
;; Author: Kazu Yamamoto <Kazu@Mew.org>
|
|
4 |
;; Created: Mar 22, 1999
|
|
5 |
||
6 |
;;; Code:
|
|
7 |
||
8 |
(require 'mew) |
|
9 |
||
10 |
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
11 |
;;;
|
|
12 |
;;; Address book
|
|
13 |
;;;
|
|
14 |
||
15 |
(defvar mew-addrbook-mode-alias "Alias") |
|
16 |
(defvar mew-addrbook-mode-personalinfo "Personal Info") |
|
17 |
||
18 |
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
19 |
;;;
|
|
20 |
;;; Internal syntax of mew-addrbook-alist
|
|
21 |
;;;
|
|
22 |
||
23 |
;; for mew-complete
|
|
24 |
(defalias 'mew-addrbook-alias-hit 'assoc) |
|
25 |
||
26 |
;;
|
|
27 |
||
28 |
(defvar mew-addrbook-orig-alist nil |
|
29 |
"(key (addr1, addr2) nickname name) or (key addr)") |
|
30 |
||
1.1.12
by Tatsuya Kinoshita
Import upstream version 6.0.51~0.20080421 |
31 |
(defun mew-adbkorigent-by-shortname (user) |
1
by Tatsuya Kinoshita
Import upstream version 4.0.65 |
32 |
(mew-addrbook-alias-hit user mew-addrbook-orig-alist)) |
33 |
||
34 |
;;
|
|
35 |
||
36 |
(defvar mew-addrbook-alist nil ;; mew-alias-auto-alist is appended |
|
37 |
"(key addr) or (key (addr1, addr2) nickname name)") |
|
38 |
||
1.1.12
by Tatsuya Kinoshita
Import upstream version 6.0.51~0.20080421 |
39 |
(defun mew-adbkent-by-addr-with-alist (addr alist) |
1
by Tatsuya Kinoshita
Import upstream version 4.0.65 |
40 |
(mew-assoc-member-case-equal addr alist 1)) |
41 |
||
1.1.12
by Tatsuya Kinoshita
Import upstream version 6.0.51~0.20080421 |
42 |
(defun mew-adbkent-by-addr (addr) |
1
by Tatsuya Kinoshita
Import upstream version 4.0.65 |
43 |
(mew-adbkent-by-addr-with-alist addr mew-addrbook-alist)) |
44 |
||
1.1.12
by Tatsuya Kinoshita
Import upstream version 6.0.51~0.20080421 |
45 |
(defun mew-adbkent-by-addr2 (addr) |
1
by Tatsuya Kinoshita
Import upstream version 4.0.65 |
46 |
;; for nickname and name, mew-addrbook-orig-alist is enough and fast
|
47 |
(mew-adbkent-by-addr-with-alist addr mew-addrbook-orig-alist)) |
|
48 |
||
1.1.12
by Tatsuya Kinoshita
Import upstream version 6.0.51~0.20080421 |
49 |
(defun mew-adbkent-shortname (adbkent) |
1
by Tatsuya Kinoshita
Import upstream version 4.0.65 |
50 |
(nth 0 adbkent)) |
51 |
||
1.1.12
by Tatsuya Kinoshita
Import upstream version 6.0.51~0.20080421 |
52 |
(defun mew-adbkent-addrs (adbkent) |
1
by Tatsuya Kinoshita
Import upstream version 4.0.65 |
53 |
(nth 1 adbkent)) |
54 |
||
1.1.12
by Tatsuya Kinoshita
Import upstream version 6.0.51~0.20080421 |
55 |
(defun mew-adbkent-nickname (adbkent) |
1
by Tatsuya Kinoshita
Import upstream version 4.0.65 |
56 |
(nth 2 adbkent)) |
57 |
||
1.1.12
by Tatsuya Kinoshita
Import upstream version 6.0.51~0.20080421 |
58 |
(defun mew-adbkent-name (adbkent) |
1
by Tatsuya Kinoshita
Import upstream version 4.0.65 |
59 |
(nth 3 adbkent)) |
60 |
||
1.1.12
by Tatsuya Kinoshita
Import upstream version 6.0.51~0.20080421 |
61 |
(defun mew-addrbook-shortname-get (addr) |
1
by Tatsuya Kinoshita
Import upstream version 4.0.65 |
62 |
(mew-adbkent-shortname (mew-adbkent-by-addr addr))) |
63 |
||
64 |
(defun mew-addrbook-addrs-get (addr) |
|
65 |
(mew-adbkent-addrs (mew-adbkent-by-addr addr))) |
|
66 |
||
67 |
(defun mew-addrbook-nickname-get (addr) |
|
68 |
(mew-adbkent-nickname (mew-adbkent-by-addr2 addr))) |
|
69 |
||
70 |
(defun mew-addrbook-name-get (addr) |
|
71 |
(mew-adbkent-name (mew-adbkent-by-addr2 addr))) |
|
72 |
||
73 |
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
74 |
;;;
|
|
75 |
;;; Internal syntax of mew-alias-auto-alist
|
|
76 |
;;;
|
|
77 |
||
78 |
(defvar mew-alias-auto-alist nil |
|
79 |
"(key addr)") |
|
80 |
||
1.1.12
by Tatsuya Kinoshita
Import upstream version 6.0.51~0.20080421 |
81 |
(defun mew-autoent-by-shortname (user) |
1
by Tatsuya Kinoshita
Import upstream version 4.0.65 |
82 |
(assoc user mew-alias-auto-alist)) |
83 |
||
1.1.12
by Tatsuya Kinoshita
Import upstream version 6.0.51~0.20080421 |
84 |
(defun mew-autoent-shortname (autoent) |
1
by Tatsuya Kinoshita
Import upstream version 4.0.65 |
85 |
(nth 0 autoent)) |
86 |
||
1.1.12
by Tatsuya Kinoshita
Import upstream version 6.0.51~0.20080421 |
87 |
(defun mew-autoent-addr (autoent) |
1
by Tatsuya Kinoshita
Import upstream version 4.0.65 |
88 |
(nth 1 autoent)) |
89 |
||
90 |
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
91 |
;;;
|
|
92 |
;;; Setup
|
|
93 |
;;;
|
|
94 |
||
95 |
(defun mew-alias-short-to-full (alist) |
|
1.1.12
by Tatsuya Kinoshita
Import upstream version 6.0.51~0.20080421 |
96 |
(mapcar (lambda (x) (cdr x)) alist)) |
1
by Tatsuya Kinoshita
Import upstream version 4.0.65 |
97 |
|
98 |
;; duplicated?
|
|
99 |
(defun mew-alias-full-to-short (alist) |
|
1.1.12
by Tatsuya Kinoshita
Import upstream version 6.0.51~0.20080421 |
100 |
(mapcar (lambda (x) (cons (downcase (mew-addrstr-extract-user x)) x)) alist)) |
1
by Tatsuya Kinoshita
Import upstream version 4.0.65 |
101 |
|
102 |
(defun mew-addrbook-setup () |
|
103 |
(if (and mew-alias-auto-file (null mew-alias-auto-alist)) |
|
104 |
;; make auto-alist only at the initialization time
|
|
105 |
;; not at update time (auto-alist have not been saved yet)
|
|
106 |
(setq mew-alias-auto-alist (mew-lisp-load mew-alias-auto-file))) |
|
107 |
(if mew-use-full-alias |
|
108 |
(if (mew-autoent-addr (car mew-alias-auto-alist)) |
|
109 |
(setq mew-alias-auto-alist |
|
110 |
(mew-alias-short-to-full mew-alias-auto-alist))) |
|
111 |
(if (null (mew-autoent-addr (car mew-alias-auto-alist))) |
|
112 |
(setq mew-alias-auto-alist |
|
113 |
(mew-alias-full-to-short mew-alias-auto-alist)))) |
|
114 |
(setq mew-addrbook-orig-alist (mew-addrbook-make-alist)) |
|
115 |
(mew-addrbook-concat-uniq) |
|
116 |
(add-hook 'kill-emacs-hook 'mew-addrbook-clean-up)) |
|
117 |
||
118 |
(defun mew-addrbook-concat-uniq () |
|
119 |
(setq mew-addrbook-alist |
|
120 |
(append mew-addrbook-orig-alist (copy-sequence mew-alias-auto-alist))) |
|
121 |
(setq mew-addrbook-alist (mew-uniq-alist mew-addrbook-alist))) |
|
122 |
||
123 |
(defun mew-addrbook-clean-up () |
|
124 |
(remove-hook 'kill-emacs-hook 'mew-addrbook-clean-up) |
|
1.1.1
by Tatsuya Kinoshita
Import upstream version 4.2.52 |
125 |
(when mew-alias-auto-alist |
126 |
(mew-lisp-save mew-alias-auto-file mew-alias-auto-alist)) |
|
1
by Tatsuya Kinoshita
Import upstream version 4.0.65 |
127 |
(setq mew-alias-auto-alist nil)) |
128 |
||
129 |
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
130 |
;;;
|
|
131 |
;;; Due to the spec of mew-complete, alist must be passed.
|
|
132 |
;;;
|
|
133 |
||
134 |
(defvar mew-alias-expand-prefix nil |
|
135 |
"A variable to make 'mew-alias-expand' elegant.") |
|
136 |
||
137 |
;; for completion
|
|
138 |
(defun mew-addrbook-alias-get (key alist) |
|
139 |
(let* ((mew-alias-expand-prefix nil) |
|
140 |
(addrs (mew-alias-expand key alist 0)) |
|
141 |
(addrx (mapcar 'mew-addrstr-append-domain addrs)) |
|
142 |
(ret (mapconcat 'identity addrx ", "))) |
|
143 |
(if mew-alias-expand-prefix |
|
144 |
(concat mew-alias-expand-prefix ":" ret ";") |
|
145 |
ret))) |
|
146 |
||
147 |
(defun mew-alias-expand-addrs (key alist count) |
|
1.1.12
by Tatsuya Kinoshita
Import upstream version 6.0.51~0.20080421 |
148 |
(let ((keys (delete "" (mapcar 'mew-chop (mew-split key ?,)))) |
1
by Tatsuya Kinoshita
Import upstream version 4.0.65 |
149 |
ret) |
1.1.12
by Tatsuya Kinoshita
Import upstream version 6.0.51~0.20080421 |
150 |
(dolist (key keys) |
151 |
(setq ret (nconc ret (mew-alias-expand key alist count)))) |
|
152 |
ret)) |
|
1
by Tatsuya Kinoshita
Import upstream version 4.0.65 |
153 |
|
154 |
(defun mew-alias-expand (key alist count) |
|
155 |
"Expand KEY to a list of addresses according to ALIST.
|
|
156 |
Infinite loop is prevented by COUNT and 'mew-expand-max-depth'.
|
|
157 |
Before calling, 'mew-alias-expand-prefix' must be set 'nil'.
|
|
158 |
If \"prefix:a,b,c;\" is given, 'mew-alias-expand-prefix'
|
|
159 |
is set to \"prefix\", and (expanded-a expanded-b expanded-c) is
|
|
160 |
returned."
|
|
161 |
(cond |
|
162 |
((> count mew-expand-max-depth) key) |
|
163 |
((string-match "^\\([^:]+\\):\\([^;]+\\);$" key) |
|
164 |
(if mew-alias-expand-prefix (error ":; must not recurse!")) |
|
165 |
(setq mew-alias-expand-prefix (match-string 1 key)) |
|
166 |
(setq key (match-string 2 key)) |
|
167 |
(mew-alias-expand-addrs key alist (1+ count))) |
|
168 |
(t |
|
169 |
(let ((crnt (mew-adbkent-addrs (mew-addrbook-alias-hit key alist)))) |
|
170 |
(cond |
|
171 |
((null crnt) (list key)) |
|
172 |
((listp crnt) (list (car crnt))) |
|
173 |
((string-match "[^:]+:[^;]+;" crnt) |
|
174 |
(mew-alias-expand crnt alist (1+ count))) |
|
175 |
((string-match "," crnt) |
|
176 |
(mew-alias-expand-addrs crnt alist (1+ count))) |
|
177 |
(t (list crnt))))))) |
|
178 |
||
179 |
(defun mew-addrbook-alias-next (key alist) |
|
180 |
(let* ((addrs (mew-adbkent-addrs |
|
181 |
(mew-adbkent-by-addr-with-alist key alist)))) |
|
182 |
(if (and addrs (listp addrs)) |
|
183 |
(mew-get-next addrs key)))) |
|
184 |
||
185 |
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
186 |
;;;
|
|
187 |
;;; For mew-encode-learn-aliases
|
|
188 |
;;;
|
|
189 |
||
190 |
(defun mew-addrbook-alias-add (addr) |
|
191 |
;; Let's downcase user-name for .mew-alias since it is automatically
|
|
192 |
;; maintained.
|
|
193 |
(when (and (stringp addr) (string-match "@" addr) |
|
194 |
(or (null mew-addrbook-alias-not-learn-list) |
|
195 |
(not (mew-member-match addr mew-addrbook-alias-not-learn-list)))) |
|
196 |
(if mew-use-full-alias |
|
197 |
(unless (member (list addr) mew-alias-auto-alist) |
|
198 |
(mew-addrbook-alias-cons (list addr))) |
|
199 |
(let* ((user (downcase (mew-addrstr-extract-user addr))) |
|
200 |
(match-auto (mew-autoent-by-shortname user)) |
|
201 |
(match-adbk-orig (mew-adbkorigent-by-shortname user))) |
|
202 |
(cond |
|
203 |
((string= user "") |
|
204 |
;; do nothing
|
|
205 |
)
|
|
206 |
(match-adbk-orig |
|
207 |
;; do nothing
|
|
208 |
)
|
|
209 |
(match-auto |
|
210 |
(cond |
|
211 |
((string= addr (mew-autoent-addr match-auto)) |
|
212 |
;; Move the entry to the top for the recent-used-first.
|
|
213 |
(setq mew-alias-auto-alist (delq match-auto mew-alias-auto-alist)) |
|
214 |
(setq mew-alias-auto-alist (cons match-auto mew-alias-auto-alist))) |
|
215 |
(mew-addrbook-override-by-newone |
|
216 |
;; override match-auto by (user addr)
|
|
217 |
(setq mew-alias-auto-alist (delq match-auto mew-alias-auto-alist)) |
|
218 |
(setq mew-addrbook-alist (delete match-auto mew-addrbook-alist)) |
|
219 |
(mew-addrbook-alias-cons (list user addr))) |
|
220 |
(t |
|
221 |
;; the old entry remains
|
|
222 |
)))
|
|
223 |
(t |
|
224 |
(mew-addrbook-alias-cons (list user addr)))))))) |
|
225 |
||
226 |
(defun mew-addrbook-alias-cons (user-addr) |
|
227 |
(setq mew-alias-auto-alist (cons user-addr mew-alias-auto-alist)) |
|
228 |
;; Ideally, user-addr should be inserted in between
|
|
229 |
;; mew-addrbook-orig-alist and mew-alist-auto-alist.
|
|
230 |
;; But mew-alist-auto-alist is the newest-first order.
|
|
231 |
;; So, just cons user-addr to mew-addrbook-alist.
|
|
232 |
;; This produces a different alist made by mew-addrbook-setup.
|
|
233 |
;; But we do not care.
|
|
234 |
(setq mew-addrbook-alist (cons user-addr mew-addrbook-alist))) |
|
235 |
||
236 |
(defun mew-addrbook-alias-delete (addr) |
|
237 |
(when (and (stringp addr) (string-match "@" addr)) |
|
238 |
(let* ((user (downcase (mew-addrstr-extract-user addr))) |
|
239 |
(ent (mew-autoent-by-shortname user))) |
|
240 |
(when (and ent (string= addr (mew-autoent-addr addr))) |
|
241 |
(setq mew-addrbook-alist (delete ent mew-addrbook-alist)) |
|
242 |
(setq mew-alias-auto-alist (delq ent mew-alias-auto-alist)))))) |
|
243 |
||
244 |
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
245 |
;;;
|
|
246 |
;;; Loading Addrbook files
|
|
247 |
;;;
|
|
248 |
||
249 |
(defun mew-addrbook-insert-file (file cregex &optional unquote) |
|
250 |
(let* ((case-fold-search t) |
|
251 |
(pars (mew-split file ?,)) ;; parents |
|
252 |
(files pars) ;; included |
|
253 |
par chr path beg end qchar ret) |
|
254 |
;; include parents files
|
|
1.1.12
by Tatsuya Kinoshita
Import upstream version 6.0.51~0.20080421 |
255 |
(dolist (ent pars) |
256 |
(setq par (expand-file-name ent mew-conf-path)) |
|
1
by Tatsuya Kinoshita
Import upstream version 4.0.65 |
257 |
(when (file-readable-p par) |
258 |
(setq ret t) |
|
259 |
(mew-insert-file-contents par) |
|
260 |
(setq path (file-name-directory par)) |
|
261 |
;; include children files
|
|
262 |
(while (re-search-forward "^<[ \t]*\\([^ \t\n]+\\).*$" nil t) |
|
263 |
(setq chr (expand-file-name (mew-match-string 1) path)) |
|
264 |
(replace-match "" nil t) |
|
265 |
(when (and (file-readable-p chr) (not (member chr files))) |
|
266 |
(mew-insert-file-contents chr) |
|
267 |
(setq files (cons chr files)))) |
|
268 |
(goto-char (point-max)))) |
|
1.1.1
by Tatsuya Kinoshita
Import upstream version 4.2.52 |
269 |
;; remove comments
|
1
by Tatsuya Kinoshita
Import upstream version 4.0.65 |
270 |
(goto-char (point-min)) |
271 |
(while (re-search-forward cregex nil t) |
|
272 |
(setq beg (match-beginning 0)) |
|
273 |
(setq end (match-end 0)) |
|
274 |
(beginning-of-line) |
|
275 |
(if (/= (point) beg) |
|
276 |
(forward-line) |
|
277 |
(forward-line) |
|
278 |
(setq end (point))) |
|
279 |
(delete-region beg end)) |
|
280 |
;; concat continuation lines
|
|
281 |
;; "\" must locate on the end of line
|
|
282 |
(goto-char (point-min)) |
|
283 |
(while (re-search-forward "\\\\\n" nil t) |
|
284 |
(replace-match "" nil t)) |
|
285 |
;; concat separated lines by comma
|
|
286 |
(goto-char (point-min)) |
|
287 |
(while (re-search-forward ",$" nil t) |
|
288 |
(end-of-line) |
|
289 |
(forward-char 1) |
|
290 |
(delete-backward-char 1)) |
|
1.1.1
by Tatsuya Kinoshita
Import upstream version 4.2.52 |
291 |
;; replace ", " to "\0" inside/outside quote.
|
1
by Tatsuya Kinoshita
Import upstream version 4.0.65 |
292 |
(goto-char (point-min)) |
293 |
(while (re-search-forward ",[ \t]+" nil t) |
|
294 |
(replace-match ",\0" nil t)) |
|
295 |
;; unquote, replace white spaces to "\0".
|
|
296 |
(goto-char (point-min)) |
|
297 |
(if unquote |
|
298 |
(catch 'quote |
|
299 |
(while (re-search-forward "[\"']" nil t) |
|
300 |
(setq qchar (char-before (point))) |
|
301 |
;; (point) is for backward compatibility
|
|
302 |
(backward-delete-char 1) ;; delete quote |
|
303 |
(setq beg (point)) |
|
304 |
(if (not (re-search-forward (char-to-string qchar) nil t)) |
|
305 |
(throw 'quote nil) ;; error |
|
306 |
(backward-delete-char 1) ;; delete quote |
|
307 |
(save-restriction |
|
308 |
(narrow-to-region beg (point)) |
|
309 |
(goto-char (point-min)) |
|
310 |
(while (re-search-forward "[ \t]+" nil t) |
|
311 |
(replace-match "\0" nil t)) |
|
312 |
(goto-char (point-max))))))) ;; just in case |
|
313 |
;; remove optional white spaces
|
|
314 |
(goto-char (point-min)) |
|
315 |
(while (re-search-forward "[ \t]+" nil t) |
|
316 |
(replace-match " " nil t)) |
|
317 |
ret)) |
|
318 |
||
319 |
(defun mew-addrbook-strsafe (var) |
|
320 |
(if (or (string= "" var) (string= "*" var)) |
|
321 |
nil
|
|
1.1.1
by Tatsuya Kinoshita
Import upstream version 4.2.52 |
322 |
(mew-replace-character var 0 mew-sp))) |
1
by Tatsuya Kinoshita
Import upstream version 4.0.65 |
323 |
|
324 |
(defun mew-addrbook-make-alist () |
|
325 |
(let (alias colon addrs nick name alist) |
|
326 |
(with-temp-buffer |
|
327 |
(when (mew-addrbook-insert-file |
|
328 |
mew-addrbook-file mew-addrbook-comment-regex 'unquote) |
|
329 |
(goto-char (point-min)) |
|
1.1.7
by Tatsuya Kinoshita
Import upstream version 5.2.50~0.20070423 |
330 |
(while (re-search-forward "^ ?\\([^ \n:]+\\) ?\\(:?\\) ?\\([^ \t\n]+\\)" nil t) |
1
by Tatsuya Kinoshita
Import upstream version 4.0.65 |
331 |
(setq alias (mew-addrbook-strsafe (mew-match-string 1))) |
332 |
(setq colon (mew-match-string 2)) |
|
333 |
(setq addrs (mew-addrbook-strsafe (mew-match-string 3))) |
|
334 |
(if (string= colon ":") |
|
335 |
(setq alist (cons (list alias addrs) alist)) |
|
336 |
(and addrs (setq addrs (mapcar 'mew-chop (mew-split addrs ?,)))) |
|
337 |
(if (looking-at " ?\\([^ \n]*\\) ?\\([^ \n]*\\)") |
|
338 |
(progn |
|
339 |
(setq nick (mew-addrbook-strsafe (mew-match-string 1))) |
|
340 |
(setq name (mew-addrbook-strsafe (mew-match-string 2)))) |
|
341 |
(setq nick nil) |
|
342 |
(setq name nil)) |
|
343 |
(setq alist (cons (list alias addrs nick name) alist)))))) |
|
344 |
(nreverse alist))) |
|
345 |
||
346 |
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
347 |
;;;
|
|
348 |
;;; Addrbook mode
|
|
349 |
;;;
|
|
350 |
||
351 |
(defun mew-summary-addrbook-add (&optional personalinfo) |
|
352 |
"Adding the value of From: in Message mode to Addrbook. When
|
|
353 |
executed with '\\[universal-argument]', it will add personal information. Otherwise,
|
|
354 |
it will add an alias."
|
|
355 |
(interactive "P") |
|
356 |
(let ((fld (mew-summary-folder-name)) |
|
357 |
(msg (mew-summary-message-number2)) |
|
358 |
from shortname addrs name) |
|
359 |
(save-excursion |
|
1.1.1
by Tatsuya Kinoshita
Import upstream version 4.2.52 |
360 |
(mew-summary-set-message-buffer fld msg) |
361 |
(setq from (mew-header-get-value mew-from:))) |
|
362 |
(if (null from) |
|
363 |
(message "No address to be registered") |
|
364 |
;; assuming From: contains just one address
|
|
365 |
(setq addrs (mew-addrstr-parse-address from)) |
|
366 |
(if (mew-is-my-address mew-regex-my-address-list addrs) |
|
367 |
(if personalinfo |
|
368 |
(setq addrs (car (mew-header-parse-address-list |
|
369 |
(list mew-to:)))) |
|
370 |
(setq addrs (mapconcat 'identity |
|
371 |
(mew-header-parse-address-list |
|
372 |
(list mew-to: mew-cc:)) |
|
373 |
","))) |
|
374 |
(when (string-match "\\(.*\\)<.*>" from) |
|
375 |
(setq name (match-string 1 from)) |
|
376 |
(setq name (mew-chop name))) |
|
377 |
(if mew-addrbook-strip-domainpart |
|
378 |
(setq shortname (downcase (mew-addrstr-extract-user addrs))) |
|
379 |
(setq shortname (downcase addrs)))) |
|
380 |
(if (not addrs) |
|
1
by Tatsuya Kinoshita
Import upstream version 4.0.65 |
381 |
(message "No address to be registered") |
1.1.1
by Tatsuya Kinoshita
Import upstream version 4.2.52 |
382 |
(mew-addrbook-prepare-template |
383 |
personalinfo shortname addrs nil name))))) |
|
1
by Tatsuya Kinoshita
Import upstream version 4.0.65 |
384 |
|
385 |
(defun mew-addrbook-prepare-template (personalinfop shortname addrs &optional nickname name) |
|
386 |
(delete-other-windows) |
|
387 |
(switch-to-buffer (get-buffer-create mew-buffer-addrbook)) |
|
388 |
(mew-erase-buffer) |
|
389 |
(mew-insert-manual |
|
390 |
"#If you want to register this entry, type "
|
|
391 |
"'\\<mew-addrbook-mode-map>\\[mew-addrbook-register]'.\n"
|
|
392 |
"#If you want to NOT register this entry, type "
|
|
393 |
"'\\<mew-addrbook-mode-map>\\[mew-addrbook-kill]'.\n") |
|
394 |
(mew-addrbook-insert-template "Shortname" shortname) |
|
395 |
(mew-addrbook-insert-template "Addresses" addrs) |
|
396 |
(cond |
|
397 |
(personalinfop |
|
398 |
(mew-addrbook-insert-template "Nickname" nickname) |
|
399 |
(mew-addrbook-insert-template "Name" name) |
|
400 |
(mew-addrbook-mode mew-addrbook-mode-personalinfo)) |
|
401 |
(t |
|
402 |
(mew-addrbook-mode mew-addrbook-mode-alias))) |
|
403 |
(mew-addrbook-insert-template "Comments" nil) |
|
404 |
(goto-char (point-min)) |
|
405 |
(search-forward ": " nil t)) |
|
406 |
||
407 |
(defun mew-addrbook-insert-template (key val) |
|
408 |
(mew-elet |
|
409 |
(let ((beg (point))) |
|
410 |
(insert key ": ") |
|
411 |
(put-text-property beg (point) 'read-only t) |
|
412 |
(mew-rear-nonsticky beg (point)) |
|
413 |
(and val (insert val)) |
|
414 |
(insert "\n")))) |
|
415 |
||
416 |
(defun mew-addrbook-mode (mname) |
|
1.1.12
by Tatsuya Kinoshita
Import upstream version 6.0.51~0.20080421 |
417 |
"A major mode to register Addrbook.
|
1
by Tatsuya Kinoshita
Import upstream version 4.0.65 |
418 |
|
1.1.12
by Tatsuya Kinoshita
Import upstream version 6.0.51~0.20080421 |
419 |
\\{mew-addrbook-mode-map}"
|
1
by Tatsuya Kinoshita
Import upstream version 4.0.65 |
420 |
(interactive) |
421 |
(setq major-mode 'mew-addrbook-mode) |
|
422 |
(setq mode-name mname) |
|
1.2.4
by Tatsuya Kinoshita
Import upstream version 6.2.52 |
423 |
(setq mode-line-buffer-identification (mew-mode-line-id)) |
1
by Tatsuya Kinoshita
Import upstream version 4.0.65 |
424 |
(use-local-map mew-addrbook-mode-map) |
425 |
(run-hooks 'mew-addrbook-mode-hook) |
|
426 |
(setq buffer-undo-list nil)) |
|
427 |
||
428 |
(defun mew-addrbook-nconc (ent) |
|
429 |
(setq mew-addrbook-orig-alist (nconc mew-addrbook-orig-alist (list ent))) |
|
430 |
(mew-addrbook-concat-uniq)) |
|
431 |
||
432 |
(defun mew-addrbook-register () |
|
433 |
"Register information in Addrbook mode to Addrbook."
|
|
434 |
(interactive) |
|
435 |
(let ((shortname (mew-header-get-value "Shortname:")) |
|
436 |
(addrs (mew-header-get-value "Addresses:")) |
|
437 |
(nickname (mew-header-get-value "Nickname:")) |
|
438 |
(name (mew-header-get-value "Name:")) |
|
439 |
(comments (mew-header-get-value "Comments:")) |
|
440 |
(mode mode-name) |
|
441 |
(uniqp t) |
|
442 |
buf addrsl errmsg) |
|
443 |
(cond |
|
444 |
((string= mode mew-addrbook-mode-alias) |
|
445 |
(cond |
|
446 |
((and (null shortname) (null addrs)) |
|
447 |
(setq errmsg "Must fill both Shortname and Addresses")) |
|
448 |
((null shortname) |
|
449 |
(setq errmsg "Must fill Shortname")) |
|
450 |
((null addrs) |
|
451 |
(setq errmsg "Must fill Addresses")))) |
|
452 |
(t |
|
453 |
(cond |
|
454 |
((null addrs) |
|
455 |
(setq errmsg "Must fill Addresses")) |
|
456 |
((and (null shortname) (null nickname) (null name)) |
|
457 |
(setq errmsg "Must fill Shortname or Nickname or Name")) |
|
458 |
((and name (string-match "^\"[^\"]*[^\000-\177]" name)) |
|
459 |
(setq errmsg "Remove quote around non-ASCII Name"))))) |
|
460 |
(if errmsg |
|
461 |
(message "%s" errmsg) |
|
462 |
(save-excursion |
|
463 |
(setq buf (mew-find-file-noselect2 |
|
464 |
(expand-file-name mew-addrbook-file mew-conf-path))) |
|
465 |
(set-buffer buf) |
|
466 |
(goto-char (point-min)) |
|
467 |
(if (and shortname |
|
468 |
(re-search-forward |
|
469 |
(concat "^" (regexp-quote shortname) "[ \t]*:?[ \t]+") nil t)) |
|
470 |
(setq uniqp nil)) |
|
471 |
(when uniqp |
|
472 |
;; All errors are checked.
|
|
473 |
(goto-char (point-max)) |
|
474 |
(unless (bolp) (insert "\n")) |
|
475 |
(cond |
|
476 |
((string= mode mew-addrbook-mode-alias) |
|
477 |
(insert shortname ":\t" addrs) |
|
478 |
(mew-addrbook-nconc (list shortname addrs))) |
|
479 |
(t |
|
480 |
(setq addrsl (mew-addrstr-parse-address-list addrs)) |
|
481 |
;; Set mew-addrbook-orig-alist with unquoted strings.
|
|
482 |
(mew-addrbook-nconc (list shortname addrsl nickname name)) |
|
483 |
(unless shortname (setq shortname "*")) |
|
484 |
(if (and nickname (string-match "^[^\" \t]+[ \t]+.*$" nickname)) |
|
485 |
(setq nickname (concat "\"" nickname "\""))) |
|
486 |
(if (and name (string-match "^[^\" \t]+[ \t]+.*$" name)) |
|
487 |
(setq name (concat "\"" name "\""))) |
|
488 |
(if name |
|
489 |
(insert shortname "\t" addrs "\t" (or nickname "*") "\t" name) |
|
490 |
(if nickname |
|
491 |
(insert shortname "\t" addrs "\t" nickname) |
|
492 |
(insert shortname "\t" addrs))))) |
|
493 |
(if comments |
|
494 |
(insert "\t#" comments "\n") |
|
495 |
(insert "\n")) |
|
496 |
(save-buffer))) |
|
497 |
;; Addrbook buffer
|
|
498 |
(mew-remove-buffer buf) |
|
499 |
(cond |
|
500 |
(uniqp |
|
501 |
(mew-addrbook-kill 'no-msg) |
|
502 |
(message "Registered to Addrbook")) |
|
503 |
(t |
|
504 |
(message "Shortname is already used. Change Shortname")))))) |
|
505 |
||
506 |
(defun mew-addrbook-kill (&optional no-msg) |
|
507 |
"Kill Addrbook mode."
|
|
508 |
(interactive "P") |
|
509 |
(mew-remove-buffer (current-buffer)) |
|
510 |
(or no-msg (message "Not registered"))) |
|
511 |
||
512 |
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
513 |
;;;
|
|
514 |
;;; Editing auto-alist
|
|
515 |
;;;
|
|
516 |
||
517 |
(defun mew-summary-alias-read-buffer () |
|
518 |
(save-excursion |
|
519 |
(goto-char (point-min)) |
|
520 |
;; An error occurs if the expression is broken.
|
|
521 |
;; This is intentional.
|
|
522 |
(setq mew-alias-auto-alist (read (current-buffer))) |
|
523 |
(mew-addrbook-concat-uniq) |
|
524 |
nil)) ;; to write |
|
525 |
||
526 |
(defun mew-summary-alias-edit () |
|
527 |
"Editing the auto alias file which contains a list of alias-address
|
|
528 |
pairs. Remove unnecessary entries and save the file by
|
|
529 |
'\\[save-buffer]'. After saving, the modification is automatically
|
|
530 |
reflected."
|
|
531 |
(interactive) |
|
532 |
(let ((file mew-alias-auto-file)) |
|
533 |
(setq mew-alias-auto-alist |
|
534 |
(sort mew-alias-auto-alist (lambda (x y) (string< (car x) (car y))))) |
|
535 |
(mew-lisp-save mew-alias-auto-file mew-alias-auto-alist) |
|
536 |
(unless (file-name-absolute-p file) |
|
537 |
(setq file (expand-file-name file mew-conf-path))) |
|
538 |
(switch-to-buffer (mew-find-file-noselect file)) |
|
539 |
(emacs-lisp-mode) |
|
540 |
(if (boundp 'write-file-functions) |
|
541 |
(add-hook 'write-file-functions 'mew-summary-alias-read-buffer nil 'local) |
|
542 |
(add-hook 'local-write-file-hooks 'mew-summary-alias-read-buffer)))) |
|
543 |
||
544 |
(provide 'mew-addrbook) |
|
545 |
||
546 |
;;; Copyright Notice:
|
|
547 |
||
1.2.5
by Tatsuya Kinoshita
Import upstream version 7.0.50~0.20100105 |
548 |
;; Copyright (C) 1999-2010 Mew developing team.
|
1
by Tatsuya Kinoshita
Import upstream version 4.0.65 |
549 |
;; All rights reserved.
|
550 |
||
551 |
;; Redistribution and use in source and binary forms, with or without
|
|
552 |
;; modification, are permitted provided that the following conditions
|
|
553 |
;; are met:
|
|
1.1.12
by Tatsuya Kinoshita
Import upstream version 6.0.51~0.20080421 |
554 |
;;
|
1
by Tatsuya Kinoshita
Import upstream version 4.0.65 |
555 |
;; 1. Redistributions of source code must retain the above copyright
|
556 |
;; notice, this list of conditions and the following disclaimer.
|
|
557 |
;; 2. Redistributions in binary form must reproduce the above copyright
|
|
558 |
;; notice, this list of conditions and the following disclaimer in the
|
|
559 |
;; documentation and/or other materials provided with the distribution.
|
|
560 |
;; 3. Neither the name of the team nor the names of its contributors
|
|
561 |
;; may be used to endorse or promote products derived from this software
|
|
562 |
;; without specific prior written permission.
|
|
1.1.12
by Tatsuya Kinoshita
Import upstream version 6.0.51~0.20080421 |
563 |
;;
|
1
by Tatsuya Kinoshita
Import upstream version 4.0.65 |
564 |
;; THIS SOFTWARE IS PROVIDED BY THE TEAM AND CONTRIBUTORS ``AS IS'' AND
|
565 |
;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
|
566 |
;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
|
|
567 |
;; PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE TEAM OR CONTRIBUTORS BE
|
|
568 |
;; LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
|
|
569 |
;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
|
|
570 |
;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
|
|
571 |
;; BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
|
|
572 |
;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
|
|
573 |
;; OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
|
|
574 |
;; IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
|
575 |
||
576 |
;;; mew-addrbook.el ends here
|