Don't quote lambda expressions with `quote'.
[bpt/emacs.git] / lisp / mh-e / mh-alias.el
CommitLineData
c3d9274a 1;;; mh-alias.el --- MH-E mail alias completion and expansion
dda00b2c 2
95df8112 3;; Copyright (C) 1994-1997, 2001-2011 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 ", ")
275 ;; Loop over all elements, checking if in passwd aliast or blind first
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))
319 ((lambda) (if (fboundp 'test-completion)
320 (test-completion string mh-alias-alist pred))))))))))
c3d9274a 321\f
cee9f5c6 322
dda00b2c 323;;; Alias File Updating
c3d9274a 324
a66894d8
BW
325(defun mh-alias-suggest-alias (string &optional no-comma-swap)
326 "Suggest an alias for STRING.
2dcf34f9
BW
327Don't reverse the order of strings separated by a comma if
328NO-COMMA-SWAP is non-nil."
c3d9274a 329 (cond
924df208
BW
330 ((string-match "^<\\(.*\\)>$" string)
331 ;; <somename@foo.bar> -> recurse, stripping brackets.
a66894d8 332 (mh-alias-suggest-alias (match-string 1 string) no-comma-swap))
c3d9274a
BW
333 ((string-match "^\\sw+$" string)
334 ;; One word -> downcase it.
335 (downcase string))
336 ((string-match "^\\(\\sw+\\)\\s-+\\(\\sw+\\)$" string)
337 ;; Two words -> first.last
338 (downcase
339 (format "%s.%s" (match-string 1 string) (match-string 2 string))))
340 ((string-match "^\\([-a-zA-Z0-9._]+\\)@[-a-zA-z0-9_]+\\.+[a-zA-Z0-9]+$"
341 string)
342 ;; email only -> downcase username
343 (downcase (match-string 1 string)))
344 ((string-match "^\"\\(.*\\)\".*" string)
345 ;; "Some name" <somename@foo.bar> -> recurse -> "Some name"
a66894d8 346 (mh-alias-suggest-alias (match-string 1 string) no-comma-swap))
c3d9274a
BW
347 ((string-match "^\\(.*\\) +<.*>$" string)
348 ;; Some name <somename@foo.bar> -> recurse -> Some name
a66894d8 349 (mh-alias-suggest-alias (match-string 1 string) no-comma-swap))
ae494f66 350 ((string-match (concat goto-address-mail-regexp " +(\\(.*\\))$") string)
c3d9274a 351 ;; somename@foo.bar (Some name) -> recurse -> Some name
a66894d8 352 (mh-alias-suggest-alias (match-string 1 string) no-comma-swap))
c3d9274a
BW
353 ((string-match "^\\(Dr\\|Prof\\)\\.? +\\(.*\\)" string)
354 ;; Strip out title
a66894d8 355 (mh-alias-suggest-alias (match-string 2 string) no-comma-swap))
c3d9274a
BW
356 ((string-match "^\\(.*\\), +\\(Jr\\.?\\|II+\\)$" string)
357 ;; Strip out tails with comma
a66894d8 358 (mh-alias-suggest-alias (match-string 1 string) no-comma-swap))
c3d9274a
BW
359 ((string-match "^\\(.*\\) +\\(Jr\\.?\\|II+\\)$" string)
360 ;; Strip out tails
a66894d8 361 (mh-alias-suggest-alias (match-string 1 string) no-comma-swap))
c3d9274a
BW
362 ((string-match "^\\(\\sw+\\) +[A-Z]\\.? +\\(.*\\)$" string)
363 ;; Strip out initials
364 (mh-alias-suggest-alias
a66894d8
BW
365 (format "%s %s" (match-string 1 string) (match-string 2 string))
366 no-comma-swap))
367 ((and (not no-comma-swap)
368 (string-match "^\\([^,]+\\), +\\(.*\\)$" string))
369 ;; Reverse order of comma-separated fields to handle:
370 ;; From: "Galbraith, Peter" <psg@debian.org>
371 ;; but don't this for a name string extracted from the passwd file
372 ;; with mh-alias-passwd-gecos-comma-separator-flag set to nil.
c3d9274a 373 (mh-alias-suggest-alias
a66894d8
BW
374 (format "%s %s" (match-string 2 string) (match-string 1 string))
375 no-comma-swap))
c3d9274a
BW
376 (t
377 ;; Output string, with spaces replaced by dots.
924df208
BW
378 (mh-alias-canonicalize-suggestion string))))
379
380(defun mh-alias-canonicalize-suggestion (string)
a66894d8
BW
381 "Process STRING to replace spaces by periods.
382First all spaces and commas are replaced by periods. Then every run of
2dcf34f9
BW
383consecutive periods are replaced with a single period. Finally the
384string is converted to lower case."
924df208
BW
385 (with-temp-buffer
386 (insert string)
387 ;; Replace spaces with periods
388 (goto-char (point-min))
a66894d8
BW
389 (while (re-search-forward " +" nil t)
390 (replace-match "." nil nil))
391 ;; Replace commas with periods
392 (goto-char (point-min))
393 (while (re-search-forward ",+" nil t)
394 (replace-match "." nil nil))
924df208
BW
395 ;; Replace consecutive periods with a single period
396 (goto-char (point-min))
a66894d8
BW
397 (while (re-search-forward "\\.\\.+" nil t)
398 (replace-match "." nil nil))
924df208
BW
399 ;; Convert to lower case
400 (downcase-region (point-min) (point-max))
401 ;; Whew! all done...
402 (buffer-string)))
c3d9274a
BW
403
404(defun mh-alias-which-file-has-alias (alias file-list)
405 "Return the name of writable file which defines ALIAS from list FILE-LIST."
b5553d47 406 (with-current-buffer (get-buffer-create mh-temp-buffer)
c3d9274a
BW
407 (let ((the-list file-list)
408 (found))
409 (while the-list
410 (erase-buffer)
411 (when (file-writable-p (car file-list))
412 (insert-file-contents (car file-list))
924df208 413 (if (re-search-forward (concat "^" (regexp-quote alias) ":") nil t)
c3d9274a
BW
414 (setq found (car file-list)
415 the-list nil)
416 (setq the-list (cdr the-list)))))
417 found)))
418
419(defun mh-alias-insert-file (&optional alias)
f0d73c14 420 "Return filename which should be used to add ALIAS.
2dcf34f9 421The value of the option `mh-alias-insert-file' is used if non-nil\;
5a4aad03 422otherwise the value of the \"Aliasfile:\" profile component is used.
2dcf34f9
BW
423If the alias already exists, try to return the name of the file that
424contains it."
c3d9274a
BW
425 (cond
426 ((and mh-alias-insert-file (listp mh-alias-insert-file))
427 (if (not (elt mh-alias-insert-file 1)) ; Only one entry, use it
428 (car mh-alias-insert-file)
429 (if (or (not alias)
430 (string-equal alias (mh-alias-ali alias))) ;alias doesn't exist
f0d73c14 431 (completing-read "Alias file: "
c3d9274a
BW
432 (mapcar 'list mh-alias-insert-file) nil t)
433 (or (mh-alias-which-file-has-alias alias mh-alias-insert-file)
f0d73c14 434 (completing-read "Alias file: "
c3d9274a
BW
435 (mapcar 'list mh-alias-insert-file) nil t)))))
436 ((and mh-alias-insert-file (stringp mh-alias-insert-file))
437 mh-alias-insert-file)
438 (t
439 ;; writable ones returned from (mh-alias-filenames):
440 (let ((autolist (delq nil (mapcar (lambda (file)
441 (if (and (file-writable-p file)
442 (not (string-equal
443 file "/etc/passwd")))
444 file))
445 (mh-alias-filenames t)))))
446 (cond
447 ((not autolist)
dda00b2c
BW
448 (error "No writable alias file;
449set `mh-alias-insert-file' or the \"Aliasfile:\" profile component"))
c3d9274a
BW
450 ((not (elt autolist 1)) ; Only one entry, use it
451 (car autolist))
452 ((or (not alias)
453 (string-equal alias (mh-alias-ali alias))) ;alias doesn't exist
f0d73c14 454 (completing-read "Alias file: " (mapcar 'list autolist) nil t))
c3d9274a
BW
455 (t
456 (or (mh-alias-which-file-has-alias alias autolist)
f0d73c14 457 (completing-read "Alias file: "
c3d9274a
BW
458 (mapcar 'list autolist) nil t))))))))
459
3d7ca223 460;;;###mh-autoload
c3d9274a
BW
461(defun mh-alias-address-to-alias (address)
462 "Return the ADDRESS alias if defined, or nil."
463 (let* ((aliases (mh-alias-ali address t)))
464 (if (string-equal aliases address)
465 nil ; ali returned same string -> no.
3d7ca223
BW
466 ;; Double-check that we have an individual alias. This means that the
467 ;; alias doesn't expand into a list (of which this address is part).
c3d9274a
BW
468 (car (delq nil (mapcar
469 (function
470 (lambda (alias)
471 (let ((recurse (mh-alias-ali alias nil)))
472 (if (string-match ".*,.*" recurse)
473 nil
474 alias))))
475 (split-string aliases ", +")))))))
476
477;;;###mh-autoload
f0d73c14
BW
478(defun mh-alias-for-from-p ()
479 "Return t if sender's address has a corresponding alias."
c3d9274a
BW
480 (mh-alias-reload-maybe)
481 (save-excursion
482 (if (not (mh-folder-line-matches-show-buffer-p))
483 nil ;No corresponding show buffer
484 (if (eq major-mode 'mh-folder-mode)
485 (set-buffer mh-show-buffer))
924df208
BW
486 (let ((from-header (mh-extract-from-header-value)))
487 (and from-header
f0d73c14 488 (mh-alias-address-to-alias from-header))))))
c3d9274a
BW
489
490(defun mh-alias-add-alias-to-file (alias address &optional file)
491 "Add ALIAS for ADDRESS in alias FILE without alias check or prompts.
2dcf34f9
BW
492Prompt for alias file if not provided and there is more than one
493candidate.
494
495If the alias exists already, you will have the choice of
496inserting the new alias before or after the old alias. In the
497former case, this alias will be used when sending mail to this
498alias. In the latter case, the alias serves as an additional
499folder name hint when filing messages."
c3d9274a
BW
500 (if (not file)
501 (setq file (mh-alias-insert-file alias)))
b5553d47 502 (with-current-buffer (find-file-noselect file)
c3d9274a
BW
503 (goto-char (point-min))
504 (let ((alias-search (concat alias ":"))
505 (letter)
c3d9274a
BW
506 (case-fold-search t))
507 (cond
508 ;; Search for exact match (if we had the same alias before)
509 ((re-search-forward
510 (concat "^" (regexp-quote alias-search) " *\\(.*\\)") nil t)
511 (let ((answer (read-string
f0d73c14
BW
512 (format (concat "Alias %s exists; insert new address "
513 "[b]efore or [a]fter: ")
c3d9274a
BW
514 (match-string 1))))
515 (case-fold-search t))
f0d73c14 516 (cond ((string-match "^b" answer))
c3d9274a
BW
517 ((string-match "^a" answer)
518 (forward-line 1))
519 (t
f0d73c14 520 (error "Unrecognized response")))))
c3d9274a
BW
521 ;; No, so sort-in at the right place
522 ;; search for "^alias", then "^alia", etc.
523 ((eq mh-alias-insertion-location 'sorted)
524 (setq letter (substring alias-search -1)
525 alias-search (substring alias-search 0 -1))
526 (while (and (not (equal alias-search ""))
527 (not (re-search-forward
528 (concat "^" (regexp-quote alias-search)) nil t)))
529 (setq letter (substring alias-search -1)
530 alias-search (substring alias-search 0 -1)))
531 ;; Next, move forward to sort alphabetically for following letters
532 (beginning-of-line)
533 (while (re-search-forward
534 (concat "^" (regexp-quote alias-search) "[a-" letter "]")
535 nil t)
536 (forward-line 1)))
537 ((eq mh-alias-insertion-location 'bottom)
538 (goto-char (point-max)))
539 ((eq mh-alias-insertion-location 'top)
540 (goto-char (point-min)))))
541 (beginning-of-line)
542 (insert (format "%s: %s\n" alias address))
543 (save-buffer)))
544
c3d9274a 545(defun mh-alias-add-alias (alias address)
e69d4e02
BW
546 "Add ALIAS for ADDRESS in personal alias file.
547
2dcf34f9
BW
548This function prompts you for an alias and address. If the alias
549exists already, you will have the choice of inserting the new
550alias before or after the old alias. In the former case, this
551alias will be used when sending mail to this alias. In the latter
552case, the alias serves as an additional folder name hint when
553filing messages."
c3d9274a
BW
554 (interactive "P\nP")
555 (mh-alias-reload-maybe)
556 (setq alias (completing-read "Alias: " mh-alias-alist nil nil alias))
924df208
BW
557 (if (and address (string-match "^<\\(.*\\)>$" address))
558 (setq address (match-string 1 address)))
c3d9274a 559 (setq address (read-string "Address: " address))
924df208
BW
560 (if (string-match "^<\\(.*\\)>$" address)
561 (setq address (match-string 1 address)))
c3d9274a
BW
562 (let ((address-alias (mh-alias-address-to-alias address))
563 (alias-address (mh-alias-expand alias)))
564 (if (string-equal alias-address alias)
565 (setq alias-address nil))
566 (cond
567 ((and (equal alias address-alias)
568 (equal address alias-address))
f9c53c97 569 (message "Already defined as %s" alias-address))
c3d9274a
BW
570 (address-alias
571 (if (y-or-n-p (format "Address has alias %s; set new one? "
572 address-alias))
573 (mh-alias-add-alias-to-file alias address)))
574 (t
575 (mh-alias-add-alias-to-file alias address)))))
576
577;;;###mh-autoload
578(defun mh-alias-grab-from-field ()
af435184 579 "Add alias for the sender of the current message."
c3d9274a
BW
580 (interactive)
581 (mh-alias-reload-maybe)
582 (save-excursion
583 (cond
584 ((mh-folder-line-matches-show-buffer-p)
585 (set-buffer mh-show-buffer))
586 ((and (eq major-mode 'mh-folder-mode)
587 (mh-get-msg-num nil))
588 (set-buffer (get-buffer-create mh-temp-buffer))
589 (insert-file-contents (mh-msg-filename (mh-get-msg-num t))))
590 ((eq major-mode 'mh-folder-mode)
591 (error "Cursor not pointing to a message")))
924df208
BW
592 (let* ((address (or (mh-extract-from-header-value)
593 (error "Message has no From: header")))
c3d9274a
BW
594 (alias (mh-alias-suggest-alias address)))
595 (mh-alias-add-alias alias address))))
596
c3d9274a 597(defun mh-alias-add-address-under-point ()
f0d73c14 598 "Insert an alias for address under point."
c3d9274a 599 (interactive)
ae494f66 600 (let ((address (goto-address-find-address-at-point)))
c3d9274a
BW
601 (if address
602 (mh-alias-add-alias nil address)
f0d73c14 603 (message "No email address found under point"))))
c3d9274a 604
a66894d8 605(defun mh-alias-apropos (regexp)
af435184 606 "Show all aliases or addresses that match a regular expression REGEXP."
a66894d8
BW
607 (interactive "sAlias regexp: ")
608 (if mh-alias-local-users
609 (mh-alias-reload-maybe))
f0d73c14
BW
610 (let ((matches "")
611 (group-matches "")
612 (passwd-matches))
a66894d8
BW
613 (save-excursion
614 (message "Reading MH aliases...")
615 (mh-exec-cmd-quiet t "ali" "-nolist" "-nouser")
f0d73c14 616 (message "Parsing MH aliases...")
a66894d8
BW
617 (while (re-search-forward regexp nil t)
618 (beginning-of-line)
619 (cond
620 ((looking-at "^[ \t]") ;Continuation line
621 (setq group-matches
622 (concat group-matches
623 (buffer-substring
624 (save-excursion
625 (or (re-search-backward "^[^ \t]" nil t)
626 (point)))
627 (progn
628 (if (re-search-forward "^[^ \t]" nil t)
629 (forward-char -1))
630 (point))))))
631 (t
632 (setq matches
633 (concat matches
634 (buffer-substring (point)(progn (end-of-line)(point)))
635 "\n")))))
f0d73c14 636 (message "Parsing MH aliases...done")
a66894d8 637 (when mh-alias-local-users
f0d73c14 638 (message "Making passwd aliases...")
a66894d8
BW
639 (setq passwd-matches
640 (mapconcat
4f91a816
SM
641 (lambda (elem)
642 (if (or (string-match regexp (car elem))
643 (string-match regexp (cadr elem)))
644 (format "%s: %s\n" (car elem) (cadr elem))))
a66894d8 645 mh-alias-passwd-alist ""))
f0d73c14 646 (message "Making passwd aliases...done")))
a66894d8
BW
647 (if (and (string-equal "" matches)
648 (string-equal "" group-matches)
649 (string-equal "" passwd-matches))
650 (message "No matches")
f0d73c14 651 (with-output-to-temp-buffer mh-aliases-buffer
a66894d8
BW
652 (if (not (string-equal "" matches))
653 (princ matches))
654 (when (not (string-equal group-matches ""))
655 (princ "\nGroup Aliases:\n\n")
656 (princ group-matches))
657 (when (not (string-equal passwd-matches ""))
658 (princ "\nLocal User Aliases:\n\n")
659 (princ passwd-matches))))))
660
dda00b2c
BW
661(defun mh-folder-line-matches-show-buffer-p ()
662 "Return t if the message under point in folder-mode is in the show buffer.
663Return nil in any other circumstance (no message under point, no
664show buffer, the message in the show buffer doesn't match."
665 (and (eq major-mode 'mh-folder-mode)
666 (mh-get-msg-num nil)
667 mh-show-buffer
668 (get-buffer mh-show-buffer)
669 (buffer-file-name (get-buffer mh-show-buffer))
670 (string-match ".*/\\([0-9]+\\)$"
671 (buffer-file-name (get-buffer mh-show-buffer)))
672 (string-equal
673 (match-string 1 (buffer-file-name (get-buffer mh-show-buffer)))
674 (int-to-string (mh-get-msg-num nil)))))
675
c3d9274a
BW
676(provide 'mh-alias)
677
cee9f5c6
BW
678;; Local Variables:
679;; indent-tabs-mode: nil
680;; sentence-end-double-space: nil
681;; End:
c3d9274a
BW
682
683;;; mh-alias.el ends here