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