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