Merge from emacs-23
[bpt/emacs.git] / lisp / mh-e / mh-alias.el
CommitLineData
c3d9274a 1;;; mh-alias.el --- MH-E mail alias completion and expansion
dda00b2c 2
e495eaec 3;; Copyright (C) 1994, 1995, 1996, 1997,
5df4f04c 4;; 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
dcf71371 5;; Free Software Foundation, Inc.
a1506d29 6
c3d9274a
BW
7;; Author: Peter S. Galbraith <psg@debian.org>
8;; Maintainer: Bill Wohler <wohler@newt.com>
9;; Keywords: mail
10;; See: mh-e.el
11
12;; This file is part of GNU Emacs.
13
5e809f55 14;; GNU Emacs is free software: you can redistribute it and/or modify
c3d9274a 15;; it under the terms of the GNU General Public License as published by
5e809f55
GM
16;; the Free Software Foundation, either version 3 of the License, or
17;; (at your option) any later version.
c3d9274a
BW
18
19;; GNU Emacs is distributed in the hope that it will be useful,
20;; but WITHOUT ANY WARRANTY; without even the implied warranty of
21;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22;; GNU General Public License for more details.
23
24;; You should have received a copy of the GNU General Public License
5e809f55 25;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
c3d9274a
BW
26
27;;; Commentary:
28
3d7ca223
BW
29;;; Change Log:
30
c3d9274a
BW
31;;; Code:
32
33(require 'mh-e)
cee9f5c6 34
dda00b2c 35(mh-require-cl)
c3d9274a 36
ae494f66
BW
37(require 'goto-addr)
38
924df208 39(defvar mh-alias-alist 'not-read
c3d9274a
BW
40 "Alist of MH aliases.")
41(defvar mh-alias-blind-alist nil
42 "Alist of MH aliases that are blind lists.")
43(defvar mh-alias-passwd-alist nil
44 "Alist of aliases extracted from passwd file and their expansions.")
45(defvar mh-alias-tstamp nil
46 "Time aliases were last loaded.")
6b4093c0
JPW
47(defvar mh-alias-read-address-map
48 (let ((map (copy-keymap minibuffer-local-completion-map)))
49 (define-key map "," 'mh-alias-minibuffer-confirm-address)
50 (define-key map " " 'self-insert-command)
51 map))
c3d9274a 52
f0d73c14
BW
53(defvar mh-alias-system-aliases
54 '("/etc/nmh/MailAliases" "/etc/mh/MailAliases"
55 "/usr/lib/mh/MailAliases" "/usr/share/mailutils/mh/MailAliases"
56 "/etc/passwd")
57 "*A list of system files which are a source of aliases.
2dcf34f9
BW
58If these files are modified, they are automatically reread. This list
59need include only system aliases and the passwd file, since personal
5a4aad03 60alias files listed in your \"Aliasfile:\" MH profile component are
2dcf34f9
BW
61automatically included. You can update the alias list manually using
62\\[mh-alias-reload].")
f0d73c14 63
c3d9274a 64\f
cee9f5c6 65
c3d9274a
BW
66;;; Alias Loading
67
68(defun mh-alias-tstamp (arg)
69 "Check whether alias files have been modified.
2dcf34f9
BW
70Return t if any file listed in the Aliasfile MH profile component has
71been modified since the timestamp.
c3d9274a
BW
72If ARG is non-nil, set timestamp with the current time."
73 (if arg
74 (let ((time (current-time)))
75 (setq mh-alias-tstamp (list (nth 0 time) (nth 1 time))))
76 (let ((stamp))
77 (car (memq t (mapcar
78 (function
79 (lambda (file)
80 (when (and file (file-exists-p file))
81 (setq stamp (nth 5 (file-attributes file)))
82 (or (> (car stamp) (car mh-alias-tstamp))
83 (and (= (car stamp) (car mh-alias-tstamp))
84 (> (cadr stamp) (cadr mh-alias-tstamp)))))))
85 (mh-alias-filenames t)))))))
86
87(defun mh-alias-filenames (arg)
88 "Return list of filenames that contain aliases.
2dcf34f9
BW
89The filenames come from the Aliasfile profile component and are
90expanded.
91If ARG is non-nil, filenames listed in `mh-alias-system-aliases' are
92appended."
c3d9274a
BW
93 (or mh-progs (mh-find-path))
94 (save-excursion
95 (let* ((filename (mh-profile-component "Aliasfile"))
96 (filelist (and filename (split-string filename "[ \t]+")))
97 (userlist
98 (mapcar
99 (function
100 (lambda (file)
101 (if (and mh-user-path file
102 (file-exists-p (expand-file-name file mh-user-path)))
103 (expand-file-name file mh-user-path))))
104 filelist)))
105 (if arg
106 (if (stringp mh-alias-system-aliases)
107 (append userlist (list mh-alias-system-aliases))
108 (append userlist mh-alias-system-aliases))
109 userlist))))
110
a66894d8
BW
111(defun mh-alias-gecos-name (gecos-name username comma-separator)
112 "Return a usable address string from a GECOS-NAME and USERNAME.
2dcf34f9
BW
113Use only part of the GECOS-NAME up to the first comma if
114COMMA-SEPARATOR is non-nil."
a66894d8
BW
115 (let ((res gecos-name))
116 ;; Keep only string until first comma if COMMA-SEPARATOR is t.
117 (if (and comma-separator
118 (string-match "^\\([^,]+\\)," res))
119 (setq res (match-string 1 res)))
120 ;; Replace "&" with capitalized username
121 (if (string-match "&" res)
d5dc8c56 122 (setq res (mh-replace-regexp-in-string "&" (capitalize username) res)))
a66894d8
BW
123 ;; Remove " character
124 (if (string-match "\"" res)
d5dc8c56 125 (setq res (mh-replace-regexp-in-string "\"" "" res)))
a66894d8
BW
126 ;; If empty string, use username instead
127 (if (string-equal "" res)
128 (setq res username))
129 ;; Surround by quotes if doesn't consist of simple characters
130 (if (not (string-match "^[ a-zA-Z0-9-]+$" res))
131 (setq res (concat "\"" res "\"")))
132 res))
133
c3d9274a 134(defun mh-alias-local-users ()
f0d73c14 135 "Return an alist of local users from /etc/passwd.
5a4aad03 136Exclude all aliases already in `mh-alias-alist' from \"ali\""
c3d9274a 137 (let (passwd-alist)
b5553d47 138 (with-current-buffer (get-buffer-create mh-temp-buffer)
c3d9274a
BW
139 (erase-buffer)
140 (cond
141 ((eq mh-alias-local-users t)
142 (if (file-readable-p "/etc/passwd")
143 (insert-file-contents "/etc/passwd")))
144 ((stringp mh-alias-local-users)
145 (insert mh-alias-local-users "\n")
924df208 146 (shell-command-on-region (point-min) (point-max) mh-alias-local-users t)
c3d9274a
BW
147 (goto-char (point-min))))
148 (while (< (point) (point-max))
149 (cond
a66894d8 150 ((looking-at "\\([^:]*\\):[^:]*:\\([^:]*\\):[^:]*:\\([^:]*\\):")
e495eaec 151 (when (> (string-to-number (match-string 2)) 200)
c3d9274a
BW
152 (let* ((username (match-string 1))
153 (gecos-name (match-string 3))
a66894d8
BW
154 (realname (mh-alias-gecos-name
155 gecos-name username
f0d73c14
BW
156 mh-alias-passwd-gecos-comma-separator-flag))
157 (alias-name (if mh-alias-local-users-prefix
e495eaec
BW
158 (concat mh-alias-local-users-prefix
159 (mh-alias-suggest-alias realname t))
160 username))
f0d73c14
BW
161 (alias-translation
162 (if (string-equal username realname)
163 (concat "<" username ">")
164 (concat realname " <" username ">"))))
06e7028b 165 (when (not (mh-assoc-string alias-name mh-alias-alist t))
f0d73c14
BW
166 (setq passwd-alist (cons (list alias-name alias-translation)
167 passwd-alist)))))))
c3d9274a
BW
168 (forward-line 1)))
169 passwd-alist))
170
c3d9274a 171(defun mh-alias-reload ()
f0d73c14
BW
172 "Reload MH aliases.
173
2dcf34f9
BW
174Since aliases are updated frequently, MH-E reloads aliases
175automatically whenever an alias lookup occurs if an alias source has
5a4aad03 176changed. Sources include files listed in your \"Aliasfile:\" profile
2dcf34f9
BW
177component and your password file if option `mh-alias-local-users' is
178turned on. However, you can reload your aliases manually by calling
179this command directly.
d1699462 180
2dcf34f9
BW
181This function runs `mh-alias-reloaded-hook' after the aliases have
182been loaded."
c3d9274a
BW
183 (interactive)
184 (save-excursion
185 (message "Loading MH aliases...")
186 (mh-alias-tstamp t)
187 (mh-exec-cmd-quiet t "ali" "-nolist" "-nouser")
188 (setq mh-alias-alist nil)
189 (setq mh-alias-blind-alist nil)
190 (while (< (point) (point-max))
191 (cond
192 ((looking-at "^[ \t]")) ;Continuation line
193 ((looking-at "\\(.+\\): .+: .*$") ; A new -blind- MH alias
06e7028b 194 (when (not (mh-assoc-string (match-string 1) mh-alias-blind-alist t))
c3d9274a
BW
195 (setq mh-alias-blind-alist
196 (cons (list (match-string 1)) mh-alias-blind-alist))
197 (setq mh-alias-alist (cons (list (match-string 1)) mh-alias-alist))))
198 ((looking-at "\\(.+\\): .*$") ; A new MH alias
06e7028b 199 (when (not (mh-assoc-string (match-string 1) mh-alias-alist t))
c3d9274a
BW
200 (setq mh-alias-alist
201 (cons (list (match-string 1)) mh-alias-alist)))))
202 (forward-line 1)))
203 (when mh-alias-local-users
204 (setq mh-alias-passwd-alist (mh-alias-local-users))
205 ;; Update aliases with local users, but leave existing aliases alone.
206 (let ((local-users mh-alias-passwd-alist)
207 user)
208 (while local-users
209 (setq user (car local-users))
06e7028b 210 (if (not (mh-assoc-string (car user) mh-alias-alist t))
c3d9274a
BW
211 (setq mh-alias-alist (append mh-alias-alist (list user))))
212 (setq local-users (cdr local-users)))))
f0d73c14 213 (run-hooks 'mh-alias-reloaded-hook)
c3d9274a
BW
214 (message "Loading MH aliases...done"))
215
a66894d8 216;;;###mh-autoload
c3d9274a
BW
217(defun mh-alias-reload-maybe ()
218 "Load new MH aliases."
f0d73c14
BW
219 (if (or (eq mh-alias-alist 'not-read) ; Doesn't exist?
220 (mh-alias-tstamp nil)) ; Out of date?
c3d9274a
BW
221 (mh-alias-reload)))
222
223\f
cee9f5c6 224
c3d9274a
BW
225;;; Alias Expansion
226
227(defun mh-alias-ali (alias &optional user)
228 "Return ali expansion for ALIAS.
229ALIAS must be a string for a single alias.
2dcf34f9
BW
230If USER is t, then assume ALIAS is an address and call ali -user. ali
231returns the string unchanged if not defined. The same is done here."
924df208
BW
232 (condition-case err
233 (save-excursion
234 (let ((user-arg (if user "-user" "-nouser")))
235 (mh-exec-cmd-quiet t "ali" user-arg "-nolist" alias))
236 (goto-char (point-max))
d355a0b7 237 (if (looking-at "^$") (delete-char -1))
924df208
BW
238 (buffer-substring (point-min)(point-max)))
239 (error (progn
47570699 240 (message "%s" (error-message-string err))
924df208 241 alias))))
c3d9274a 242
11b2dd64 243;;;###mh-autoload
c3d9274a
BW
244(defun mh-alias-expand (alias)
245 "Return expansion for ALIAS.
246Blind aliases or users from /etc/passwd are not expanded."
247 (cond
06e7028b 248 ((mh-assoc-string alias mh-alias-blind-alist t)
c3d9274a 249 alias) ; Don't expand a blind alias
06e7028b
BW
250 ((mh-assoc-string alias mh-alias-passwd-alist t)
251 (cadr (mh-assoc-string alias mh-alias-passwd-alist t)))
c3d9274a
BW
252 (t
253 (mh-alias-ali alias))))
254
d5dc8c56
BW
255(mh-require 'crm nil t) ; completing-read-multiple
256(mh-require 'multi-prompt nil t)
dda00b2c 257
c3d9274a
BW
258;;;###mh-autoload
259(defun mh-read-address (prompt)
260 "Read an address from the minibuffer with PROMPT."
261 (mh-alias-reload-maybe)
dda00b2c 262 (if (not mh-alias-alist) ; If still no aliases, just prompt
c3d9274a
BW
263 (read-string prompt)
264 (let* ((minibuffer-local-completion-map mh-alias-read-address-map)
265 (completion-ignore-case mh-alias-completion-ignore-case-flag)
266 (the-answer
924df208
BW
267 (cond ((fboundp 'completing-read-multiple)
268 (mh-funcall-if-exists
269 completing-read-multiple prompt mh-alias-alist nil nil))
270 ((featurep 'multi-prompt)
271 (mh-funcall-if-exists
272 multi-prompt "," nil prompt mh-alias-alist nil nil))
273 (t (split-string
274 (completing-read prompt mh-alias-alist nil nil) ",")))))
c3d9274a
BW
275 (if (not mh-alias-expand-aliases-flag)
276 (mapconcat 'identity the-answer ", ")
277 ;; Loop over all elements, checking if in passwd aliast or blind first
278 (mapconcat 'mh-alias-expand the-answer ",\n ")))))
279
280;;;###mh-autoload
281(defun mh-alias-minibuffer-confirm-address ()
282 "Display the alias expansion if `mh-alias-flash-on-comma' is non-nil."
283 (interactive)
a66894d8 284 (when mh-alias-flash-on-comma
c3d9274a
BW
285 (save-excursion
286 (let* ((case-fold-search t)
a66894d8
BW
287 (beg (mh-beginning-of-word))
288 (the-name (buffer-substring-no-properties beg (point))))
06e7028b 289 (if (mh-assoc-string the-name mh-alias-alist t)
c3d9274a
BW
290 (message "%s -> %s" the-name (mh-alias-expand the-name))
291 ;; Check if if was a single word likely to be an alias
292 (if (and (equal mh-alias-flash-on-comma 1)
293 (not (string-match " " the-name)))
294 (message "No alias for %s" the-name))))))
295 (self-insert-command 1))
296
297;;;###mh-autoload
298(defun mh-alias-letter-expand-alias ()
299 "Expand mail alias before point."
300 (mh-alias-reload-maybe)
a66894d8
BW
301 (let* ((end (point))
302 (begin (mh-beginning-of-word))
303 (input (buffer-substring-no-properties begin end)))
304 (mh-complete-word input mh-alias-alist begin end)
305 (when mh-alias-expand-aliases-flag
306 (let* ((end (point))
307 (expansion (mh-alias-expand (buffer-substring begin end))))
308 (delete-region begin end)
309 (insert expansion)))))
dda00b2c 310
c3d9274a 311\f
cee9f5c6 312
dda00b2c 313;;; Alias File Updating
c3d9274a 314
a66894d8
BW
315(defun mh-alias-suggest-alias (string &optional no-comma-swap)
316 "Suggest an alias for STRING.
2dcf34f9
BW
317Don't reverse the order of strings separated by a comma if
318NO-COMMA-SWAP is non-nil."
c3d9274a 319 (cond
924df208
BW
320 ((string-match "^<\\(.*\\)>$" string)
321 ;; <somename@foo.bar> -> recurse, stripping brackets.
a66894d8 322 (mh-alias-suggest-alias (match-string 1 string) no-comma-swap))
c3d9274a
BW
323 ((string-match "^\\sw+$" string)
324 ;; One word -> downcase it.
325 (downcase string))
326 ((string-match "^\\(\\sw+\\)\\s-+\\(\\sw+\\)$" string)
327 ;; Two words -> first.last
328 (downcase
329 (format "%s.%s" (match-string 1 string) (match-string 2 string))))
330 ((string-match "^\\([-a-zA-Z0-9._]+\\)@[-a-zA-z0-9_]+\\.+[a-zA-Z0-9]+$"
331 string)
332 ;; email only -> downcase username
333 (downcase (match-string 1 string)))
334 ((string-match "^\"\\(.*\\)\".*" string)
335 ;; "Some name" <somename@foo.bar> -> recurse -> "Some name"
a66894d8 336 (mh-alias-suggest-alias (match-string 1 string) no-comma-swap))
c3d9274a
BW
337 ((string-match "^\\(.*\\) +<.*>$" string)
338 ;; Some name <somename@foo.bar> -> recurse -> Some name
a66894d8 339 (mh-alias-suggest-alias (match-string 1 string) no-comma-swap))
ae494f66 340 ((string-match (concat goto-address-mail-regexp " +(\\(.*\\))$") string)
c3d9274a 341 ;; somename@foo.bar (Some name) -> recurse -> Some name
a66894d8 342 (mh-alias-suggest-alias (match-string 1 string) no-comma-swap))
c3d9274a
BW
343 ((string-match "^\\(Dr\\|Prof\\)\\.? +\\(.*\\)" string)
344 ;; Strip out title
a66894d8 345 (mh-alias-suggest-alias (match-string 2 string) no-comma-swap))
c3d9274a
BW
346 ((string-match "^\\(.*\\), +\\(Jr\\.?\\|II+\\)$" string)
347 ;; Strip out tails with comma
a66894d8 348 (mh-alias-suggest-alias (match-string 1 string) no-comma-swap))
c3d9274a
BW
349 ((string-match "^\\(.*\\) +\\(Jr\\.?\\|II+\\)$" string)
350 ;; Strip out tails
a66894d8 351 (mh-alias-suggest-alias (match-string 1 string) no-comma-swap))
c3d9274a
BW
352 ((string-match "^\\(\\sw+\\) +[A-Z]\\.? +\\(.*\\)$" string)
353 ;; Strip out initials
354 (mh-alias-suggest-alias
a66894d8
BW
355 (format "%s %s" (match-string 1 string) (match-string 2 string))
356 no-comma-swap))
357 ((and (not no-comma-swap)
358 (string-match "^\\([^,]+\\), +\\(.*\\)$" string))
359 ;; Reverse order of comma-separated fields to handle:
360 ;; From: "Galbraith, Peter" <psg@debian.org>
361 ;; but don't this for a name string extracted from the passwd file
362 ;; with mh-alias-passwd-gecos-comma-separator-flag set to nil.
c3d9274a 363 (mh-alias-suggest-alias
a66894d8
BW
364 (format "%s %s" (match-string 2 string) (match-string 1 string))
365 no-comma-swap))
c3d9274a
BW
366 (t
367 ;; Output string, with spaces replaced by dots.
924df208
BW
368 (mh-alias-canonicalize-suggestion string))))
369
370(defun mh-alias-canonicalize-suggestion (string)
a66894d8
BW
371 "Process STRING to replace spaces by periods.
372First all spaces and commas are replaced by periods. Then every run of
2dcf34f9
BW
373consecutive periods are replaced with a single period. Finally the
374string is converted to lower case."
924df208
BW
375 (with-temp-buffer
376 (insert string)
377 ;; Replace spaces with periods
378 (goto-char (point-min))
a66894d8
BW
379 (while (re-search-forward " +" nil t)
380 (replace-match "." nil nil))
381 ;; Replace commas with periods
382 (goto-char (point-min))
383 (while (re-search-forward ",+" nil t)
384 (replace-match "." nil nil))
924df208
BW
385 ;; Replace consecutive periods with a single period
386 (goto-char (point-min))
a66894d8
BW
387 (while (re-search-forward "\\.\\.+" nil t)
388 (replace-match "." nil nil))
924df208
BW
389 ;; Convert to lower case
390 (downcase-region (point-min) (point-max))
391 ;; Whew! all done...
392 (buffer-string)))
c3d9274a
BW
393
394(defun mh-alias-which-file-has-alias (alias file-list)
395 "Return the name of writable file which defines ALIAS from list FILE-LIST."
b5553d47 396 (with-current-buffer (get-buffer-create mh-temp-buffer)
c3d9274a
BW
397 (let ((the-list file-list)
398 (found))
399 (while the-list
400 (erase-buffer)
401 (when (file-writable-p (car file-list))
402 (insert-file-contents (car file-list))
924df208 403 (if (re-search-forward (concat "^" (regexp-quote alias) ":") nil t)
c3d9274a
BW
404 (setq found (car file-list)
405 the-list nil)
406 (setq the-list (cdr the-list)))))
407 found)))
408
409(defun mh-alias-insert-file (&optional alias)
f0d73c14 410 "Return filename which should be used to add ALIAS.
2dcf34f9 411The value of the option `mh-alias-insert-file' is used if non-nil\;
5a4aad03 412otherwise the value of the \"Aliasfile:\" profile component is used.
2dcf34f9
BW
413If the alias already exists, try to return the name of the file that
414contains it."
c3d9274a
BW
415 (cond
416 ((and mh-alias-insert-file (listp mh-alias-insert-file))
417 (if (not (elt mh-alias-insert-file 1)) ; Only one entry, use it
418 (car mh-alias-insert-file)
419 (if (or (not alias)
420 (string-equal alias (mh-alias-ali alias))) ;alias doesn't exist
f0d73c14 421 (completing-read "Alias file: "
c3d9274a
BW
422 (mapcar 'list mh-alias-insert-file) nil t)
423 (or (mh-alias-which-file-has-alias alias mh-alias-insert-file)
f0d73c14 424 (completing-read "Alias file: "
c3d9274a
BW
425 (mapcar 'list mh-alias-insert-file) nil t)))))
426 ((and mh-alias-insert-file (stringp mh-alias-insert-file))
427 mh-alias-insert-file)
428 (t
429 ;; writable ones returned from (mh-alias-filenames):
430 (let ((autolist (delq nil (mapcar (lambda (file)
431 (if (and (file-writable-p file)
432 (not (string-equal
433 file "/etc/passwd")))
434 file))
435 (mh-alias-filenames t)))))
436 (cond
437 ((not autolist)
dda00b2c
BW
438 (error "No writable alias file;
439set `mh-alias-insert-file' or the \"Aliasfile:\" profile component"))
c3d9274a
BW
440 ((not (elt autolist 1)) ; Only one entry, use it
441 (car autolist))
442 ((or (not alias)
443 (string-equal alias (mh-alias-ali alias))) ;alias doesn't exist
f0d73c14 444 (completing-read "Alias file: " (mapcar 'list autolist) nil t))
c3d9274a
BW
445 (t
446 (or (mh-alias-which-file-has-alias alias autolist)
f0d73c14 447 (completing-read "Alias file: "
c3d9274a
BW
448 (mapcar 'list autolist) nil t))))))))
449
3d7ca223 450;;;###mh-autoload
c3d9274a
BW
451(defun mh-alias-address-to-alias (address)
452 "Return the ADDRESS alias if defined, or nil."
453 (let* ((aliases (mh-alias-ali address t)))
454 (if (string-equal aliases address)
455 nil ; ali returned same string -> no.
3d7ca223
BW
456 ;; Double-check that we have an individual alias. This means that the
457 ;; alias doesn't expand into a list (of which this address is part).
c3d9274a
BW
458 (car (delq nil (mapcar
459 (function
460 (lambda (alias)
461 (let ((recurse (mh-alias-ali alias nil)))
462 (if (string-match ".*,.*" recurse)
463 nil
464 alias))))
465 (split-string aliases ", +")))))))
466
467;;;###mh-autoload
f0d73c14
BW
468(defun mh-alias-for-from-p ()
469 "Return t if sender's address has a corresponding alias."
c3d9274a
BW
470 (mh-alias-reload-maybe)
471 (save-excursion
472 (if (not (mh-folder-line-matches-show-buffer-p))
473 nil ;No corresponding show buffer
474 (if (eq major-mode 'mh-folder-mode)
475 (set-buffer mh-show-buffer))
924df208
BW
476 (let ((from-header (mh-extract-from-header-value)))
477 (and from-header
f0d73c14 478 (mh-alias-address-to-alias from-header))))))
c3d9274a
BW
479
480(defun mh-alias-add-alias-to-file (alias address &optional file)
481 "Add ALIAS for ADDRESS in alias FILE without alias check or prompts.
2dcf34f9
BW
482Prompt for alias file if not provided and there is more than one
483candidate.
484
485If the alias exists already, you will have the choice of
486inserting the new alias before or after the old alias. In the
487former case, this alias will be used when sending mail to this
488alias. In the latter case, the alias serves as an additional
489folder name hint when filing messages."
c3d9274a
BW
490 (if (not file)
491 (setq file (mh-alias-insert-file alias)))
b5553d47 492 (with-current-buffer (find-file-noselect file)
c3d9274a
BW
493 (goto-char (point-min))
494 (let ((alias-search (concat alias ":"))
495 (letter)
c3d9274a
BW
496 (case-fold-search t))
497 (cond
498 ;; Search for exact match (if we had the same alias before)
499 ((re-search-forward
500 (concat "^" (regexp-quote alias-search) " *\\(.*\\)") nil t)
501 (let ((answer (read-string
f0d73c14
BW
502 (format (concat "Alias %s exists; insert new address "
503 "[b]efore or [a]fter: ")
c3d9274a
BW
504 (match-string 1))))
505 (case-fold-search t))
f0d73c14 506 (cond ((string-match "^b" answer))
c3d9274a
BW
507 ((string-match "^a" answer)
508 (forward-line 1))
509 (t
f0d73c14 510 (error "Unrecognized response")))))
c3d9274a
BW
511 ;; No, so sort-in at the right place
512 ;; search for "^alias", then "^alia", etc.
513 ((eq mh-alias-insertion-location 'sorted)
514 (setq letter (substring alias-search -1)
515 alias-search (substring alias-search 0 -1))
516 (while (and (not (equal alias-search ""))
517 (not (re-search-forward
518 (concat "^" (regexp-quote alias-search)) nil t)))
519 (setq letter (substring alias-search -1)
520 alias-search (substring alias-search 0 -1)))
521 ;; Next, move forward to sort alphabetically for following letters
522 (beginning-of-line)
523 (while (re-search-forward
524 (concat "^" (regexp-quote alias-search) "[a-" letter "]")
525 nil t)
526 (forward-line 1)))
527 ((eq mh-alias-insertion-location 'bottom)
528 (goto-char (point-max)))
529 ((eq mh-alias-insertion-location 'top)
530 (goto-char (point-min)))))
531 (beginning-of-line)
532 (insert (format "%s: %s\n" alias address))
533 (save-buffer)))
534
c3d9274a 535(defun mh-alias-add-alias (alias address)
e69d4e02
BW
536 "Add ALIAS for ADDRESS in personal alias file.
537
2dcf34f9
BW
538This function prompts you for an alias and address. If the alias
539exists already, you will have the choice of inserting the new
540alias before or after the old alias. In the former case, this
541alias will be used when sending mail to this alias. In the latter
542case, the alias serves as an additional folder name hint when
543filing messages."
c3d9274a
BW
544 (interactive "P\nP")
545 (mh-alias-reload-maybe)
546 (setq alias (completing-read "Alias: " mh-alias-alist nil nil alias))
924df208
BW
547 (if (and address (string-match "^<\\(.*\\)>$" address))
548 (setq address (match-string 1 address)))
c3d9274a 549 (setq address (read-string "Address: " address))
924df208
BW
550 (if (string-match "^<\\(.*\\)>$" address)
551 (setq address (match-string 1 address)))
c3d9274a
BW
552 (let ((address-alias (mh-alias-address-to-alias address))
553 (alias-address (mh-alias-expand alias)))
554 (if (string-equal alias-address alias)
555 (setq alias-address nil))
556 (cond
557 ((and (equal alias address-alias)
558 (equal address alias-address))
f9c53c97 559 (message "Already defined as %s" alias-address))
c3d9274a
BW
560 (address-alias
561 (if (y-or-n-p (format "Address has alias %s; set new one? "
562 address-alias))
563 (mh-alias-add-alias-to-file alias address)))
564 (t
565 (mh-alias-add-alias-to-file alias address)))))
566
567;;;###mh-autoload
568(defun mh-alias-grab-from-field ()
af435184 569 "Add alias for the sender of the current message."
c3d9274a
BW
570 (interactive)
571 (mh-alias-reload-maybe)
572 (save-excursion
573 (cond
574 ((mh-folder-line-matches-show-buffer-p)
575 (set-buffer mh-show-buffer))
576 ((and (eq major-mode 'mh-folder-mode)
577 (mh-get-msg-num nil))
578 (set-buffer (get-buffer-create mh-temp-buffer))
579 (insert-file-contents (mh-msg-filename (mh-get-msg-num t))))
580 ((eq major-mode 'mh-folder-mode)
581 (error "Cursor not pointing to a message")))
924df208
BW
582 (let* ((address (or (mh-extract-from-header-value)
583 (error "Message has no From: header")))
c3d9274a
BW
584 (alias (mh-alias-suggest-alias address)))
585 (mh-alias-add-alias alias address))))
586
c3d9274a 587(defun mh-alias-add-address-under-point ()
f0d73c14 588 "Insert an alias for address under point."
c3d9274a 589 (interactive)
ae494f66 590 (let ((address (goto-address-find-address-at-point)))
c3d9274a
BW
591 (if address
592 (mh-alias-add-alias nil address)
f0d73c14 593 (message "No email address found under point"))))
c3d9274a 594
a66894d8 595(defun mh-alias-apropos (regexp)
af435184 596 "Show all aliases or addresses that match a regular expression REGEXP."
a66894d8
BW
597 (interactive "sAlias regexp: ")
598 (if mh-alias-local-users
599 (mh-alias-reload-maybe))
f0d73c14
BW
600 (let ((matches "")
601 (group-matches "")
602 (passwd-matches))
a66894d8
BW
603 (save-excursion
604 (message "Reading MH aliases...")
605 (mh-exec-cmd-quiet t "ali" "-nolist" "-nouser")
f0d73c14 606 (message "Parsing MH aliases...")
a66894d8
BW
607 (while (re-search-forward regexp nil t)
608 (beginning-of-line)
609 (cond
610 ((looking-at "^[ \t]") ;Continuation line
611 (setq group-matches
612 (concat group-matches
613 (buffer-substring
614 (save-excursion
615 (or (re-search-backward "^[^ \t]" nil t)
616 (point)))
617 (progn
618 (if (re-search-forward "^[^ \t]" nil t)
619 (forward-char -1))
620 (point))))))
621 (t
622 (setq matches
623 (concat matches
624 (buffer-substring (point)(progn (end-of-line)(point)))
625 "\n")))))
f0d73c14 626 (message "Parsing MH aliases...done")
a66894d8 627 (when mh-alias-local-users
f0d73c14 628 (message "Making passwd aliases...")
a66894d8
BW
629 (setq passwd-matches
630 (mapconcat
631 '(lambda (elem)
632 (if (or (string-match regexp (car elem))
633 (string-match regexp (cadr elem)))
634 (format "%s: %s\n" (car elem) (cadr elem))))
635 mh-alias-passwd-alist ""))
f0d73c14 636 (message "Making passwd aliases...done")))
a66894d8
BW
637 (if (and (string-equal "" matches)
638 (string-equal "" group-matches)
639 (string-equal "" passwd-matches))
640 (message "No matches")
f0d73c14 641 (with-output-to-temp-buffer mh-aliases-buffer
a66894d8
BW
642 (if (not (string-equal "" matches))
643 (princ matches))
644 (when (not (string-equal group-matches ""))
645 (princ "\nGroup Aliases:\n\n")
646 (princ group-matches))
647 (when (not (string-equal passwd-matches ""))
648 (princ "\nLocal User Aliases:\n\n")
649 (princ passwd-matches))))))
650
dda00b2c
BW
651(defun mh-folder-line-matches-show-buffer-p ()
652 "Return t if the message under point in folder-mode is in the show buffer.
653Return nil in any other circumstance (no message under point, no
654show buffer, the message in the show buffer doesn't match."
655 (and (eq major-mode 'mh-folder-mode)
656 (mh-get-msg-num nil)
657 mh-show-buffer
658 (get-buffer mh-show-buffer)
659 (buffer-file-name (get-buffer mh-show-buffer))
660 (string-match ".*/\\([0-9]+\\)$"
661 (buffer-file-name (get-buffer mh-show-buffer)))
662 (string-equal
663 (match-string 1 (buffer-file-name (get-buffer mh-show-buffer)))
664 (int-to-string (mh-get-msg-num nil)))))
665
c3d9274a
BW
666(provide 'mh-alias)
667
cee9f5c6
BW
668;; Local Variables:
669;; indent-tabs-mode: nil
670;; sentence-end-double-space: nil
671;; End:
c3d9274a 672
cee9f5c6 673;; arch-tag: 49879e46-5aa3-4569-bece-e5a58731d690
c3d9274a 674;;; mh-alias.el ends here