Commit | Line | Data |
---|---|---|
c3d9274a BW |
1 | ;;; mh-alias.el --- MH-E mail alias completion and expansion |
2 | ;; | |
924df208 BW |
3 | ;; Copyright (C) 1994, 95, 96, 1997, |
4 | ;; 2001, 02, 2003 Free Software Foundation, Inc. | |
a1506d29 | 5 | |
c3d9274a BW |
6 | ;; Author: Peter S. Galbraith <psg@debian.org> |
7 | ;; Maintainer: Bill Wohler <wohler@newt.com> | |
8 | ;; Keywords: mail | |
9 | ;; See: mh-e.el | |
10 | ||
11 | ;; This file is part of GNU Emacs. | |
12 | ||
13 | ;; GNU Emacs is free software; you can redistribute it and/or modify | |
14 | ;; it under the terms of the GNU General Public License as published by | |
15 | ;; the Free Software Foundation; either version 2, or (at your option) | |
16 | ;; any later version. | |
17 | ||
18 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
19 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
20 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
21 | ;; GNU General Public License for more details. | |
22 | ||
23 | ;; You should have received a copy of the GNU General Public License | |
24 | ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
25 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
26 | ;; Boston, MA 02111-1307, USA. | |
27 | ||
28 | ;;; Commentary: | |
29 | ||
30 | ;; [To be deleted when documented in MH-E manual.] | |
31 | ;; | |
32 | ;; This module provides mail alias completion when entering addresses. | |
33 | ;; | |
34 | ;; Use the TAB key to complete aliases (and optionally local usernames) when | |
35 | ;; initially composing a message in the To: and Cc: minibuffer prompts. You | |
36 | ;; may enter multiple addressees separated with a comma (but do *not* add any | |
37 | ;; space after the comma). | |
38 | ;; | |
39 | ;; In the header of a message draft, use "M-TAB (mh-letter-complete)" to | |
40 | ;; complete aliases. This is useful when you want to add an addressee as an | |
41 | ;; afterthought when creating a message, or when adding an additional | |
42 | ;; addressee to a reply. | |
43 | ;; | |
44 | ;; By default, completion is case-insensitive. This can be changed by | |
45 | ;; customizing the variable `mh-alias-completion-ignore-case-flag'. This is | |
46 | ;; useful, for example, to differentiate between people aliases in lowercase | |
47 | ;; such as: | |
48 | ;; | |
49 | ;; p.galbraith: Peter Galbraith <GalbraithP@dfo-mpo.gc.ca> | |
50 | ;; | |
51 | ;; and lists in uppercase such as: | |
52 | ;; | |
53 | ;; MH-E: MH-E mailing list <mh-e-devel@lists.sourceforge.net> | |
54 | ;; | |
55 | ;; Note that this variable affects minibuffer completion only. If you have an | |
56 | ;; alias for P.Galbraith and type in p.galbraith at the prompt, it will still | |
57 | ;; be expanded in the letter buffer because MH is case-insensitive. | |
58 | ;; | |
59 | ;; When you press ", (mh-alias-minibuffer-confirm-address)" after an alias in | |
60 | ;; the minibuffer, the expansion for the previous mail alias appears briefly. | |
61 | ;; To inhibit this, customize the variable `mh-alias-flash-on-comma'. | |
62 | ;; | |
63 | ;; The addresses and aliases entered in the minibuffer are added to the | |
64 | ;; message draft. To expand the aliases before they are added to the draft, | |
65 | ;; customize the variable `mh-alias-expand-aliases-flag'. | |
66 | ;; | |
67 | ;; Completion is also performed on usernames extracted from the /etc/passwd | |
68 | ;; file. This can be a handy tool on a machine where you and co-workers | |
69 | ;; exchange messages, but should probably be disabled on a system with | |
70 | ;; thousands of users you don't know. This is done by customizing the | |
71 | ;; variable `mh-alias-local-users'. This variable also takes a string which | |
72 | ;; is executed to generate the password file. For example, you'd use "ypcat | |
73 | ;; passwd" for NIS. | |
74 | ;; | |
75 | ;; Aliases are loaded the first time you send mail and get the "To:" prompt | |
76 | ;; and whenever a source of aliases changes. Sources of system aliases are | |
77 | ;; defined in the customization variable `mh-alias-system-aliases' and | |
78 | ;; include: | |
79 | ;; | |
80 | ;; /etc/nmh/MailAliases | |
81 | ;; /usr/lib/mh/MailAliases | |
82 | ;; /etc/passwd | |
83 | ;; | |
84 | ;; Sources of personal aliases are read from the files listed in your MH | |
85 | ;; profile component Aliasfile. Multiple files are separated by white space | |
86 | ;; and are relative to your mail directory. | |
87 | ;; | |
88 | ;; Alias Insertions | |
89 | ;; ~~~~~~~~~~~~~~~~ | |
90 | ;; There are commands to insert new aliases into your alias file(s) (defined | |
91 | ;; by the `Aliasfile' component in the .mh_profile file or by the variable | |
92 | ;; `mh-alias-insert-file'). In particular, there is a tool-bar icon to grab | |
93 | ;; an alias from the From line of the current message. | |
94 | ||
3d7ca223 BW |
95 | ;;; Change Log: |
96 | ||
c3d9274a BW |
97 | ;;; Code: |
98 | ||
99 | (require 'mh-e) | |
100 | (load "cmr" t t) ; Non-fatal dependency for | |
101 | ; completing-read-multiple. | |
102 | (eval-when-compile (defvar mail-abbrev-syntax-table)) | |
103 | ||
104 | ;;; Autoloads | |
924df208 BW |
105 | (eval-when (compile load eval) |
106 | (ignore-errors | |
107 | (require 'mailabbrev) | |
108 | (require 'multi-prompt))) | |
c3d9274a | 109 | |
924df208 | 110 | (defvar mh-alias-alist 'not-read |
c3d9274a BW |
111 | "Alist of MH aliases.") |
112 | (defvar mh-alias-blind-alist nil | |
113 | "Alist of MH aliases that are blind lists.") | |
114 | (defvar mh-alias-passwd-alist nil | |
115 | "Alist of aliases extracted from passwd file and their expansions.") | |
116 | (defvar mh-alias-tstamp nil | |
117 | "Time aliases were last loaded.") | |
118 | (defvar mh-alias-read-address-map nil) | |
119 | (if mh-alias-read-address-map | |
120 | () | |
121 | (setq mh-alias-read-address-map | |
122 | (copy-keymap minibuffer-local-completion-map)) | |
123 | (if mh-alias-flash-on-comma | |
124 | (define-key mh-alias-read-address-map | |
125 | "," 'mh-alias-minibuffer-confirm-address)) | |
126 | (define-key mh-alias-read-address-map " " 'self-insert-command)) | |
127 | ||
128 | \f | |
129 | ;;; Alias Loading | |
130 | ||
131 | (defun mh-alias-tstamp (arg) | |
132 | "Check whether alias files have been modified. | |
133 | Return t if any file listed in the MH profile component Aliasfile has been | |
134 | modified since the timestamp. | |
135 | If ARG is non-nil, set timestamp with the current time." | |
136 | (if arg | |
137 | (let ((time (current-time))) | |
138 | (setq mh-alias-tstamp (list (nth 0 time) (nth 1 time)))) | |
139 | (let ((stamp)) | |
140 | (car (memq t (mapcar | |
141 | (function | |
142 | (lambda (file) | |
143 | (when (and file (file-exists-p file)) | |
144 | (setq stamp (nth 5 (file-attributes file))) | |
145 | (or (> (car stamp) (car mh-alias-tstamp)) | |
146 | (and (= (car stamp) (car mh-alias-tstamp)) | |
147 | (> (cadr stamp) (cadr mh-alias-tstamp))))))) | |
148 | (mh-alias-filenames t))))))) | |
149 | ||
150 | (defun mh-alias-filenames (arg) | |
151 | "Return list of filenames that contain aliases. | |
152 | The filenames come from the MH profile component Aliasfile and are expanded. | |
153 | If ARG is non-nil, filenames listed in `mh-alias-system-aliases' are appended." | |
154 | (or mh-progs (mh-find-path)) | |
155 | (save-excursion | |
156 | (let* ((filename (mh-profile-component "Aliasfile")) | |
157 | (filelist (and filename (split-string filename "[ \t]+"))) | |
158 | (userlist | |
159 | (mapcar | |
160 | (function | |
161 | (lambda (file) | |
162 | (if (and mh-user-path file | |
163 | (file-exists-p (expand-file-name file mh-user-path))) | |
164 | (expand-file-name file mh-user-path)))) | |
165 | filelist))) | |
166 | (if arg | |
167 | (if (stringp mh-alias-system-aliases) | |
168 | (append userlist (list mh-alias-system-aliases)) | |
169 | (append userlist mh-alias-system-aliases)) | |
170 | userlist)))) | |
171 | ||
172 | (defun mh-alias-local-users () | |
173 | "Return an alist of local users from /etc/passwd." | |
174 | (let (passwd-alist) | |
175 | (save-excursion | |
176 | (set-buffer (get-buffer-create mh-temp-buffer)) | |
177 | (erase-buffer) | |
178 | (cond | |
179 | ((eq mh-alias-local-users t) | |
180 | (if (file-readable-p "/etc/passwd") | |
181 | (insert-file-contents "/etc/passwd"))) | |
182 | ((stringp mh-alias-local-users) | |
183 | (insert mh-alias-local-users "\n") | |
924df208 | 184 | (shell-command-on-region (point-min) (point-max) mh-alias-local-users t) |
c3d9274a BW |
185 | (goto-char (point-min)))) |
186 | (while (< (point) (point-max)) | |
187 | (cond | |
188 | ((looking-at "\\([^:]*\\):[^:]*:\\([^:]*\\):[^:]*:\\([^:,]*\\)[:,]") | |
189 | (when (> (string-to-int (match-string 2)) 200) | |
190 | (let* ((username (match-string 1)) | |
191 | (gecos-name (match-string 3)) | |
192 | (realname | |
193 | (if (string-match "&" gecos-name) | |
194 | (concat | |
195 | (substring gecos-name 0 (match-beginning 0)) | |
196 | (capitalize username) | |
197 | (substring gecos-name (match-end 0))) | |
198 | gecos-name))) | |
199 | (setq passwd-alist | |
200 | (cons (list username | |
201 | (if (string-equal "" realname) | |
202 | (concat "<" username ">") | |
203 | (concat realname " <" username ">"))) | |
204 | passwd-alist)))))) | |
205 | (forward-line 1))) | |
206 | passwd-alist)) | |
207 | ||
208 | ;;;###mh-autoload | |
209 | (defun mh-alias-reload () | |
210 | "Load MH aliases into `mh-alias-alist'." | |
211 | (interactive) | |
212 | (save-excursion | |
213 | (message "Loading MH aliases...") | |
214 | (mh-alias-tstamp t) | |
215 | (mh-exec-cmd-quiet t "ali" "-nolist" "-nouser") | |
216 | (setq mh-alias-alist nil) | |
217 | (setq mh-alias-blind-alist nil) | |
218 | (while (< (point) (point-max)) | |
219 | (cond | |
220 | ((looking-at "^[ \t]")) ;Continuation line | |
221 | ((looking-at "\\(.+\\): .+: .*$") ; A new -blind- MH alias | |
222 | (when (not (assoc-ignore-case (match-string 1) mh-alias-blind-alist)) | |
223 | (setq mh-alias-blind-alist | |
224 | (cons (list (match-string 1)) mh-alias-blind-alist)) | |
225 | (setq mh-alias-alist (cons (list (match-string 1)) mh-alias-alist)))) | |
226 | ((looking-at "\\(.+\\): .*$") ; A new MH alias | |
227 | (when (not (assoc-ignore-case (match-string 1) mh-alias-alist)) | |
228 | (setq mh-alias-alist | |
229 | (cons (list (match-string 1)) mh-alias-alist))))) | |
230 | (forward-line 1))) | |
231 | (when mh-alias-local-users | |
232 | (setq mh-alias-passwd-alist (mh-alias-local-users)) | |
233 | ;; Update aliases with local users, but leave existing aliases alone. | |
234 | (let ((local-users mh-alias-passwd-alist) | |
235 | user) | |
236 | (while local-users | |
237 | (setq user (car local-users)) | |
238 | (if (not (assoc-ignore-case (car user) mh-alias-alist)) | |
239 | (setq mh-alias-alist (append mh-alias-alist (list user)))) | |
240 | (setq local-users (cdr local-users))))) | |
241 | (message "Loading MH aliases...done")) | |
242 | ||
243 | (defun mh-alias-reload-maybe () | |
244 | "Load new MH aliases." | |
924df208 | 245 | (if (or (eq mh-alias-alist 'not-read) ; Doesn't exist, so create it. |
c3d9274a BW |
246 | (mh-alias-tstamp nil)) ; Out of date, so recreate it. |
247 | (mh-alias-reload))) | |
248 | ||
249 | \f | |
250 | ;;; Alias Expansion | |
251 | ||
252 | (defun mh-alias-ali (alias &optional user) | |
253 | "Return ali expansion for ALIAS. | |
254 | ALIAS must be a string for a single alias. | |
255 | If USER is t, then assume ALIAS is an address and call ali -user. | |
256 | ali returns the string unchanged if not defined. The same is done here." | |
924df208 BW |
257 | (condition-case err |
258 | (save-excursion | |
259 | (let ((user-arg (if user "-user" "-nouser"))) | |
260 | (mh-exec-cmd-quiet t "ali" user-arg "-nolist" alias)) | |
261 | (goto-char (point-max)) | |
262 | (if (looking-at "^$") (delete-backward-char 1)) | |
263 | (buffer-substring (point-min)(point-max))) | |
264 | (error (progn | |
265 | (message (error-message-string err)) | |
266 | alias)))) | |
c3d9274a BW |
267 | |
268 | (defun mh-alias-expand (alias) | |
269 | "Return expansion for ALIAS. | |
270 | Blind aliases or users from /etc/passwd are not expanded." | |
271 | (cond | |
272 | ((assoc-ignore-case alias mh-alias-blind-alist) | |
273 | alias) ; Don't expand a blind alias | |
274 | ((assoc-ignore-case alias mh-alias-passwd-alist) | |
275 | (cadr (assoc-ignore-case alias mh-alias-passwd-alist))) | |
276 | (t | |
277 | (mh-alias-ali alias)))) | |
278 | ||
279 | ;;;###mh-autoload | |
280 | (defun mh-read-address (prompt) | |
281 | "Read an address from the minibuffer with PROMPT." | |
282 | (mh-alias-reload-maybe) | |
283 | (if (not mh-alias-alist) ; If still no aliases, just prompt | |
284 | (read-string prompt) | |
285 | (let* ((minibuffer-local-completion-map mh-alias-read-address-map) | |
286 | (completion-ignore-case mh-alias-completion-ignore-case-flag) | |
287 | (the-answer | |
924df208 BW |
288 | (cond ((fboundp 'completing-read-multiple) |
289 | (mh-funcall-if-exists | |
290 | completing-read-multiple prompt mh-alias-alist nil nil)) | |
291 | ((featurep 'multi-prompt) | |
292 | (mh-funcall-if-exists | |
293 | multi-prompt "," nil prompt mh-alias-alist nil nil)) | |
294 | (t (split-string | |
295 | (completing-read prompt mh-alias-alist nil nil) ","))))) | |
c3d9274a BW |
296 | (if (not mh-alias-expand-aliases-flag) |
297 | (mapconcat 'identity the-answer ", ") | |
298 | ;; Loop over all elements, checking if in passwd aliast or blind first | |
299 | (mapconcat 'mh-alias-expand the-answer ",\n "))))) | |
300 | ||
301 | ;;;###mh-autoload | |
302 | (defun mh-alias-minibuffer-confirm-address () | |
303 | "Display the alias expansion if `mh-alias-flash-on-comma' is non-nil." | |
304 | (interactive) | |
305 | (if (not mh-alias-flash-on-comma) | |
306 | () | |
307 | (save-excursion | |
308 | (let* ((case-fold-search t) | |
309 | (the-name (buffer-substring | |
310 | (progn (skip-chars-backward " \t")(point)) | |
311 | ;; This moves over to previous comma, if any | |
312 | (progn (or (and (not (= 0 (skip-chars-backward "^,"))) | |
313 | ;; the skips over leading whitespace | |
314 | (skip-chars-forward " ")) | |
315 | ;; no comma, then to beginning of word | |
316 | (skip-chars-backward "^ \t")) | |
317 | ;; In Emacs21, the beginning of the prompt | |
318 | ;; line is accessible, which wasn't the case | |
319 | ;; in emacs20. Skip over it. | |
320 | (if (looking-at "^[^ \t]+:") | |
321 | (skip-chars-forward "^ \t")) | |
322 | (skip-chars-forward " ") | |
323 | (point))))) | |
324 | (if (assoc-ignore-case the-name mh-alias-alist) | |
325 | (message "%s -> %s" the-name (mh-alias-expand the-name)) | |
326 | ;; Check if if was a single word likely to be an alias | |
327 | (if (and (equal mh-alias-flash-on-comma 1) | |
328 | (not (string-match " " the-name))) | |
329 | (message "No alias for %s" the-name)))))) | |
330 | (self-insert-command 1)) | |
331 | ||
924df208 BW |
332 | (mh-do-in-xemacs (defvar mail-abbrevs)) |
333 | ||
c3d9274a BW |
334 | ;;;###mh-autoload |
335 | (defun mh-alias-letter-expand-alias () | |
336 | "Expand mail alias before point." | |
337 | (mh-alias-reload-maybe) | |
338 | (let ((mail-abbrevs mh-alias-alist)) | |
924df208 | 339 | (mh-funcall-if-exists mail-abbrev-complete-alias)) |
c3d9274a BW |
340 | (when mh-alias-expand-aliases-flag |
341 | (let* ((end (point)) | |
342 | (syntax-table (syntax-table)) | |
343 | (beg (unwind-protect | |
344 | (save-excursion | |
345 | (set-syntax-table mail-abbrev-syntax-table) | |
346 | (backward-word 1) | |
347 | (point)) | |
348 | (set-syntax-table syntax-table))) | |
349 | (alias (buffer-substring beg end)) | |
350 | (expansion (mh-alias-expand alias))) | |
351 | (delete-region beg end) | |
352 | (insert expansion)))) | |
353 | \f | |
354 | ;;; Adding addresses to alias file. | |
355 | ||
356 | (defun mh-alias-suggest-alias (string) | |
357 | "Suggest an alias for STRING." | |
358 | (cond | |
924df208 BW |
359 | ((string-match "^<\\(.*\\)>$" string) |
360 | ;; <somename@foo.bar> -> recurse, stripping brackets. | |
361 | (mh-alias-suggest-alias (match-string 1 string))) | |
c3d9274a BW |
362 | ((string-match "^\\sw+$" string) |
363 | ;; One word -> downcase it. | |
364 | (downcase string)) | |
365 | ((string-match "^\\(\\sw+\\)\\s-+\\(\\sw+\\)$" string) | |
366 | ;; Two words -> first.last | |
367 | (downcase | |
368 | (format "%s.%s" (match-string 1 string) (match-string 2 string)))) | |
369 | ((string-match "^\\([-a-zA-Z0-9._]+\\)@[-a-zA-z0-9_]+\\.+[a-zA-Z0-9]+$" | |
370 | string) | |
371 | ;; email only -> downcase username | |
372 | (downcase (match-string 1 string))) | |
373 | ((string-match "^\"\\(.*\\)\".*" string) | |
374 | ;; "Some name" <somename@foo.bar> -> recurse -> "Some name" | |
375 | (mh-alias-suggest-alias (match-string 1 string))) | |
376 | ((string-match "^\\(.*\\) +<.*>$" string) | |
377 | ;; Some name <somename@foo.bar> -> recurse -> Some name | |
378 | (mh-alias-suggest-alias (match-string 1 string))) | |
379 | ((string-match (concat mh-address-mail-regexp " +(\\(.*\\))$") string) | |
380 | ;; somename@foo.bar (Some name) -> recurse -> Some name | |
381 | (mh-alias-suggest-alias (match-string 1 string))) | |
382 | ((string-match "^\\(Dr\\|Prof\\)\\.? +\\(.*\\)" string) | |
383 | ;; Strip out title | |
384 | (mh-alias-suggest-alias (match-string 2 string))) | |
385 | ((string-match "^\\(.*\\), +\\(Jr\\.?\\|II+\\)$" string) | |
386 | ;; Strip out tails with comma | |
387 | (mh-alias-suggest-alias (match-string 1 string))) | |
388 | ((string-match "^\\(.*\\) +\\(Jr\\.?\\|II+\\)$" string) | |
389 | ;; Strip out tails | |
390 | (mh-alias-suggest-alias (match-string 1 string))) | |
391 | ((string-match "^\\(\\sw+\\) +[A-Z]\\.? +\\(.*\\)$" string) | |
392 | ;; Strip out initials | |
393 | (mh-alias-suggest-alias | |
394 | (format "%s %s" (match-string 1 string) (match-string 2 string)))) | |
395 | ((string-match "^\\([^,]+\\), +\\(.*\\)$" string) | |
396 | ;; Reverse order of comma-separated fields | |
397 | (mh-alias-suggest-alias | |
398 | (format "%s %s" (match-string 2 string) (match-string 1 string)))) | |
399 | (t | |
400 | ;; Output string, with spaces replaced by dots. | |
924df208 BW |
401 | (mh-alias-canonicalize-suggestion string)))) |
402 | ||
403 | (defun mh-alias-canonicalize-suggestion (string) | |
404 | "Process STRING to replace spacess by periods. | |
405 | First all spaces are replaced by periods. Then every run of consecutive periods | |
406 | are replaced with a single period. Finally the string is converted to lower | |
407 | case." | |
408 | (with-temp-buffer | |
409 | (insert string) | |
410 | ;; Replace spaces with periods | |
411 | (goto-char (point-min)) | |
412 | (replace-regexp " +" ".") | |
413 | ;; Replace consecutive periods with a single period | |
414 | (goto-char (point-min)) | |
415 | (replace-regexp "\\.\\.+" ".") | |
416 | ;; Convert to lower case | |
417 | (downcase-region (point-min) (point-max)) | |
418 | ;; Whew! all done... | |
419 | (buffer-string))) | |
c3d9274a BW |
420 | |
421 | (defun mh-alias-which-file-has-alias (alias file-list) | |
422 | "Return the name of writable file which defines ALIAS from list FILE-LIST." | |
423 | (save-excursion | |
424 | (set-buffer (get-buffer-create mh-temp-buffer)) | |
425 | (let ((the-list file-list) | |
426 | (found)) | |
427 | (while the-list | |
428 | (erase-buffer) | |
429 | (when (file-writable-p (car file-list)) | |
430 | (insert-file-contents (car file-list)) | |
924df208 | 431 | (if (re-search-forward (concat "^" (regexp-quote alias) ":") nil t) |
c3d9274a BW |
432 | (setq found (car file-list) |
433 | the-list nil) | |
434 | (setq the-list (cdr the-list))))) | |
435 | found))) | |
436 | ||
437 | (defun mh-alias-insert-file (&optional alias) | |
438 | "Return the alias file to write a new entry for ALIAS in. | |
439 | Use variable `mh-alias-insert-file' if non-nil, else use AliasFile component | |
440 | value. | |
441 | If ALIAS is specified and it already exists, try to return the file that | |
442 | contains it." | |
443 | (cond | |
444 | ((and mh-alias-insert-file (listp mh-alias-insert-file)) | |
445 | (if (not (elt mh-alias-insert-file 1)) ; Only one entry, use it | |
446 | (car mh-alias-insert-file) | |
447 | (if (or (not alias) | |
448 | (string-equal alias (mh-alias-ali alias))) ;alias doesn't exist | |
449 | (completing-read "Alias file [press Tab]: " | |
450 | (mapcar 'list mh-alias-insert-file) nil t) | |
451 | (or (mh-alias-which-file-has-alias alias mh-alias-insert-file) | |
452 | (completing-read "Alias file [press Tab]: " | |
453 | (mapcar 'list mh-alias-insert-file) nil t))))) | |
454 | ((and mh-alias-insert-file (stringp mh-alias-insert-file)) | |
455 | mh-alias-insert-file) | |
456 | (t | |
457 | ;; writable ones returned from (mh-alias-filenames): | |
458 | (let ((autolist (delq nil (mapcar (lambda (file) | |
459 | (if (and (file-writable-p file) | |
460 | (not (string-equal | |
461 | file "/etc/passwd"))) | |
462 | file)) | |
463 | (mh-alias-filenames t))))) | |
464 | (cond | |
465 | ((not autolist) | |
466 | (error "No writable alias file. | |
467 | Set `mh-alias-insert-file' or set AliasFile in your .mh_profile file")) | |
468 | ((not (elt autolist 1)) ; Only one entry, use it | |
469 | (car autolist)) | |
470 | ((or (not alias) | |
471 | (string-equal alias (mh-alias-ali alias))) ;alias doesn't exist | |
472 | (completing-read "Alias file [press Tab]: " | |
473 | (mapcar 'list autolist) nil t)) | |
474 | (t | |
475 | (or (mh-alias-which-file-has-alias alias autolist) | |
476 | (completing-read "Alias file [press Tab]: " | |
477 | (mapcar 'list autolist) nil t)))))))) | |
478 | ||
3d7ca223 | 479 | ;;;###mh-autoload |
c3d9274a BW |
480 | (defun mh-alias-address-to-alias (address) |
481 | "Return the ADDRESS alias if defined, or nil." | |
482 | (let* ((aliases (mh-alias-ali address t))) | |
483 | (if (string-equal aliases address) | |
484 | nil ; ali returned same string -> no. | |
3d7ca223 BW |
485 | ;; Double-check that we have an individual alias. This means that the |
486 | ;; alias doesn't expand into a list (of which this address is part). | |
c3d9274a BW |
487 | (car (delq nil (mapcar |
488 | (function | |
489 | (lambda (alias) | |
490 | (let ((recurse (mh-alias-ali alias nil))) | |
491 | (if (string-match ".*,.*" recurse) | |
492 | nil | |
493 | alias)))) | |
494 | (split-string aliases ", +"))))))) | |
495 | ||
496 | ;;;###mh-autoload | |
497 | (defun mh-alias-from-has-no-alias-p () | |
924df208 BW |
498 | "Return t is From has no current alias set. |
499 | In the exceptional situation where there isn't a From header in the message the | |
500 | function returns nil." | |
c3d9274a BW |
501 | (mh-alias-reload-maybe) |
502 | (save-excursion | |
503 | (if (not (mh-folder-line-matches-show-buffer-p)) | |
504 | nil ;No corresponding show buffer | |
505 | (if (eq major-mode 'mh-folder-mode) | |
506 | (set-buffer mh-show-buffer)) | |
924df208 BW |
507 | (let ((from-header (mh-extract-from-header-value))) |
508 | (and from-header | |
509 | (not (mh-alias-address-to-alias from-header))))))) | |
c3d9274a BW |
510 | |
511 | (defun mh-alias-add-alias-to-file (alias address &optional file) | |
512 | "Add ALIAS for ADDRESS in alias FILE without alias check or prompts. | |
513 | Prompt for alias file if not provided and there is more than one candidate. | |
514 | If ALIAS matches exactly, prompt to [i]nsert before old value or [a]ppend | |
515 | after it." | |
516 | (if (not file) | |
517 | (setq file (mh-alias-insert-file alias))) | |
518 | (save-excursion | |
519 | (set-buffer (find-file-noselect file)) | |
520 | (goto-char (point-min)) | |
521 | (let ((alias-search (concat alias ":")) | |
522 | (letter) | |
c3d9274a BW |
523 | (case-fold-search t)) |
524 | (cond | |
525 | ;; Search for exact match (if we had the same alias before) | |
526 | ((re-search-forward | |
527 | (concat "^" (regexp-quote alias-search) " *\\(.*\\)") nil t) | |
528 | (let ((answer (read-string | |
529 | (format "Exists for %s; [i]nsert, [a]ppend: " | |
530 | (match-string 1)))) | |
531 | (case-fold-search t)) | |
532 | (cond ((string-match "^i" answer)) | |
533 | ((string-match "^a" answer) | |
534 | (forward-line 1)) | |
535 | (t | |
3d7ca223 | 536 | (error "Quitting"))))) |
c3d9274a BW |
537 | ;; No, so sort-in at the right place |
538 | ;; search for "^alias", then "^alia", etc. | |
539 | ((eq mh-alias-insertion-location 'sorted) | |
540 | (setq letter (substring alias-search -1) | |
541 | alias-search (substring alias-search 0 -1)) | |
542 | (while (and (not (equal alias-search "")) | |
543 | (not (re-search-forward | |
544 | (concat "^" (regexp-quote alias-search)) nil t))) | |
545 | (setq letter (substring alias-search -1) | |
546 | alias-search (substring alias-search 0 -1))) | |
547 | ;; Next, move forward to sort alphabetically for following letters | |
548 | (beginning-of-line) | |
549 | (while (re-search-forward | |
550 | (concat "^" (regexp-quote alias-search) "[a-" letter "]") | |
551 | nil t) | |
552 | (forward-line 1))) | |
553 | ((eq mh-alias-insertion-location 'bottom) | |
554 | (goto-char (point-max))) | |
555 | ((eq mh-alias-insertion-location 'top) | |
556 | (goto-char (point-min))))) | |
557 | (beginning-of-line) | |
558 | (insert (format "%s: %s\n" alias address)) | |
559 | (save-buffer))) | |
560 | ||
561 | ;;;###mh-autoload | |
562 | (defun mh-alias-add-alias (alias address) | |
563 | "*Add ALIAS for ADDRESS in personal alias file. | |
564 | Prompts for confirmation if the address already has an alias. | |
565 | If the alias is already is use, `mh-alias-add-alias-to-file' will prompt." | |
566 | (interactive "P\nP") | |
567 | (mh-alias-reload-maybe) | |
568 | (setq alias (completing-read "Alias: " mh-alias-alist nil nil alias)) | |
924df208 BW |
569 | (if (and address (string-match "^<\\(.*\\)>$" address)) |
570 | (setq address (match-string 1 address))) | |
c3d9274a | 571 | (setq address (read-string "Address: " address)) |
924df208 BW |
572 | (if (string-match "^<\\(.*\\)>$" address) |
573 | (setq address (match-string 1 address))) | |
c3d9274a BW |
574 | (let ((address-alias (mh-alias-address-to-alias address)) |
575 | (alias-address (mh-alias-expand alias))) | |
576 | (if (string-equal alias-address alias) | |
577 | (setq alias-address nil)) | |
578 | (cond | |
579 | ((and (equal alias address-alias) | |
580 | (equal address alias-address)) | |
581 | (message "Already defined as: %s" alias-address)) | |
582 | (address-alias | |
583 | (if (y-or-n-p (format "Address has alias %s; set new one? " | |
584 | address-alias)) | |
585 | (mh-alias-add-alias-to-file alias address))) | |
586 | (t | |
587 | (mh-alias-add-alias-to-file alias address))))) | |
588 | ||
589 | ;;;###mh-autoload | |
590 | (defun mh-alias-grab-from-field () | |
591 | "*Add ALIAS for ADDRESS in personal alias file. | |
592 | Prompts for confirmation if the alias is already in use or if the address | |
593 | already has an alias." | |
594 | (interactive) | |
595 | (mh-alias-reload-maybe) | |
596 | (save-excursion | |
597 | (cond | |
598 | ((mh-folder-line-matches-show-buffer-p) | |
599 | (set-buffer mh-show-buffer)) | |
600 | ((and (eq major-mode 'mh-folder-mode) | |
601 | (mh-get-msg-num nil)) | |
602 | (set-buffer (get-buffer-create mh-temp-buffer)) | |
603 | (insert-file-contents (mh-msg-filename (mh-get-msg-num t)))) | |
604 | ((eq major-mode 'mh-folder-mode) | |
605 | (error "Cursor not pointing to a message"))) | |
924df208 BW |
606 | (let* ((address (or (mh-extract-from-header-value) |
607 | (error "Message has no From: header"))) | |
c3d9274a BW |
608 | (alias (mh-alias-suggest-alias address))) |
609 | (mh-alias-add-alias alias address)))) | |
610 | ||
611 | ;;;###mh-autoload | |
612 | (defun mh-alias-add-address-under-point () | |
613 | "Insert an alias for email address under point." | |
614 | (interactive) | |
615 | (let ((address (mh-goto-address-find-address-at-point))) | |
616 | (if address | |
617 | (mh-alias-add-alias nil address) | |
618 | (message "No email address found under point.")))) | |
619 | ||
620 | (provide 'mh-alias) | |
621 | ||
622 | ;;; Local Variables: | |
623 | ;;; indent-tabs-mode: nil | |
624 | ;;; sentence-end-double-space: nil | |
625 | ;;; End: | |
626 | ||
ab5796a9 | 627 | ;;; arch-tag: 49879e46-5aa3-4569-bece-e5a58731d690 |
c3d9274a | 628 | ;;; mh-alias.el ends here |