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