[Emacs-diffs] Changes to emacs/lisp/mh-e/mh-alias.el [gnus-5_10-branch]

[Miles Bader]

Index: emacs/lisp/mh-e/mh-alias.el
diff -c /dev/null emacs/lisp/mh-e/mh-alias.el:1.6.2.1
*** /dev/null   Sat Sep  4 12:01:50 2004
--- emacs/lisp/mh-e/mh-alias.el Sat Sep  4 12:01:04 2004
***************
*** 0 ****
--- 1,670 ----
+ ;;; mh-alias.el --- MH-E mail alias completion and expansion
+ ;;
+ ;; Copyright (C) 1994, 95, 96, 1997,
+ ;;  2001, 02, 03, 2004 Free Software Foundation, Inc.
+ 
+ ;; Author: Peter S. Galbraith <address@hidden>
+ ;; Maintainer: Bill Wohler <address@hidden>
+ ;; Keywords: mail
+ ;; See: mh-e.el
+ 
+ ;; This file is part of GNU Emacs.
+ 
+ ;; GNU Emacs is free software; you can redistribute it and/or modify
+ ;; it under the terms of the GNU General Public License as published by
+ ;; the Free Software Foundation; either version 2, or (at your option)
+ ;; any later version.
+ 
+ ;; GNU Emacs is distributed in the hope that it will be useful,
+ ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ;; GNU General Public License for more details.
+ 
+ ;; You should have received a copy of the GNU General Public License
+ ;; along with GNU Emacs; see the file COPYING.  If not, write to the
+ ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+ ;; Boston, MA 02111-1307, USA.
+ 
+ ;;; Commentary:
+ 
+ ;;; Change Log:
+ 
+ ;;; Code:
+ 
+ (eval-when-compile (require 'mh-acros))
+ (mh-require-cl)
+ (require 'mh-e)
+ (load "cmr" t t)                        ; Non-fatal dependency for
+                                       ; completing-read-multiple.
+ (eval-when-compile (defvar mail-abbrev-syntax-table))
+ 
+ ;;; Autoloads
+ (eval-when (compile load eval)
+   (ignore-errors
+     (require 'mailabbrev)
+     (require 'multi-prompt)))
+ 
+ (defvar mh-alias-alist 'not-read
+   "Alist of MH aliases.")
+ (defvar mh-alias-blind-alist nil
+   "Alist of MH aliases that are blind lists.")
+ (defvar mh-alias-passwd-alist nil
+   "Alist of aliases extracted from passwd file and their expansions.")
+ (defvar mh-alias-tstamp nil
+   "Time aliases were last loaded.")
+ (defvar mh-alias-read-address-map nil)
+ (unless mh-alias-read-address-map
+   (setq mh-alias-read-address-map
+       (copy-keymap minibuffer-local-completion-map))
+   (define-key mh-alias-read-address-map
+     "," 'mh-alias-minibuffer-confirm-address)
+   (define-key mh-alias-read-address-map " " 'self-insert-command))
+ 
+ (defvar mh-alias-system-aliases
+   '("/etc/nmh/MailAliases" "/etc/mh/MailAliases"
+     "/usr/lib/mh/MailAliases" "/usr/share/mailutils/mh/MailAliases"
+     "/etc/passwd")
+   "*A list of system files which are a source of aliases.
+ If these files are modified, they are automatically reread. This list need
+ include only system aliases and the passwd file, since personal alias files
+ listed in your `Aliasfile:' MH profile component are automatically included.
+ You can update the alias list manually using \\[mh-alias-reload].")
+ 
+ 
+ ;;; Alias Loading
+ 
+ (defmacro mh-assoc-ignore-case (key alist)
+   "Search for string KEY in ALIST.
+ This is a wrapper around `assoc-string' or `assoc-ignore-case'. Avoid
+ `assoc-ignore-case' which is now an obsolete function."
+   (cond ((fboundp 'assoc-string) `(assoc-string ,key ,alist t))
+         ((fboundp 'assoc-ignore-case) `(assoc-ignore-case ,key ,alist))
+         (t (error "The macro mh-assoc-ignore-case not implemented 
properly"))))
+ 
+ (defun mh-alias-tstamp (arg)
+   "Check whether alias files have been modified.
+ Return t if any file listed in the Aliasfile MH profile component has been
+ modified since the timestamp.
+ If ARG is non-nil, set timestamp with the current time."
+   (if arg
+       (let ((time (current-time)))
+         (setq mh-alias-tstamp (list (nth 0 time) (nth 1 time))))
+     (let ((stamp))
+       (car (memq t (mapcar
+                     (function
+                      (lambda (file)
+                        (when (and file (file-exists-p file))
+                          (setq stamp (nth 5 (file-attributes file)))
+                          (or (> (car stamp) (car mh-alias-tstamp))
+                              (and (= (car stamp) (car mh-alias-tstamp))
+                                   (> (cadr stamp) (cadr mh-alias-tstamp)))))))
+                     (mh-alias-filenames t)))))))
+ 
+ (defun mh-alias-filenames (arg)
+   "Return list of filenames that contain aliases.
+ The filenames come from the Aliasfile profile component and are expanded.
+ If ARG is non-nil, filenames listed in `mh-alias-system-aliases' are 
appended."
+   (or mh-progs (mh-find-path))
+   (save-excursion
+     (let* ((filename (mh-profile-component "Aliasfile"))
+            (filelist (and filename (split-string filename "[ \t]+")))
+            (userlist
+             (mapcar
+              (function
+               (lambda (file)
+                 (if (and mh-user-path file
+                          (file-exists-p (expand-file-name file mh-user-path)))
+                     (expand-file-name file mh-user-path))))
+              filelist)))
+       (if arg
+           (if (stringp mh-alias-system-aliases)
+               (append userlist (list mh-alias-system-aliases))
+             (append userlist mh-alias-system-aliases))
+         userlist))))
+ 
+ (defun mh-alias-gecos-name (gecos-name username comma-separator)
+   "Return a usable address string from a GECOS-NAME and USERNAME.
+ Use only part of the GECOS-NAME up to the first comma if COMMA-SEPARATOR is
+ non-nil."
+   (let ((res gecos-name))
+     ;; Keep only string until first comma if COMMA-SEPARATOR is t.
+     (if (and comma-separator
+              (string-match "^\\([^,]+\\)," res))
+         (setq res (match-string 1 res)))
+     ;; Replace "&" with capitalized username
+     (if (string-match "&" res)
+         (setq res (mh-replace-in-string "&" (capitalize username) res)))
+     ;; Remove " character
+     (if (string-match "\"" res)
+         (setq res (mh-replace-in-string "\"" "" res)))
+     ;; If empty string, use username instead
+     (if (string-equal "" res)
+         (setq res username))
+     ;; Surround by quotes if doesn't consist of simple characters
+     (if (not (string-match "^[ a-zA-Z0-9-]+$" res))
+         (setq res (concat "\"" res "\"")))
+     res))
+ 
+ (defun mh-alias-local-users ()
+   "Return an alist of local users from /etc/passwd.
+ Exclude all aliases already in `mh-alias-alist' from `ali'"
+   (let (passwd-alist)
+     (save-excursion
+       (set-buffer (get-buffer-create mh-temp-buffer))
+       (erase-buffer)
+       (cond
+        ((eq mh-alias-local-users t)
+         (if (file-readable-p "/etc/passwd")
+             (insert-file-contents "/etc/passwd")))
+        ((stringp mh-alias-local-users)
+         (insert mh-alias-local-users "\n")
+         (shell-command-on-region (point-min) (point-max) mh-alias-local-users 
t)
+         (goto-char (point-min))))
+       (while  (< (point) (point-max))
+         (cond
+          ((looking-at "\\([^:]*\\):[^:]*:\\([^:]*\\):[^:]*:\\([^:]*\\):")
+           (when (> (string-to-int (match-string 2)) 200)
+             (let* ((username (match-string 1))
+                    (gecos-name (match-string 3))
+                    (realname (mh-alias-gecos-name
+                               gecos-name username
+                               mh-alias-passwd-gecos-comma-separator-flag))
+                    (alias-name (if mh-alias-local-users-prefix
+                                   (concat mh-alias-local-users-prefix
+                                           (mh-alias-suggest-alias realname t))
+                                 username))
+                    (alias-translation
+                     (if (string-equal username realname)
+                         (concat "<" username ">")
+                       (concat realname " <" username ">"))))
+               (when (not (mh-assoc-ignore-case alias-name mh-alias-alist))
+                 (setq passwd-alist (cons (list alias-name alias-translation)
+                                          passwd-alist)))))))
+         (forward-line 1)))
+     passwd-alist))
+ 
+ ;;;###mh-autoload
+ (defun mh-alias-reload ()
+   "Reload MH aliases.
+ 
+ Since aliases are updated frequently, MH-E will reload aliases automatically
+ whenever an alias lookup occurs if an alias source (a file listed in your
+ `Aliasfile:' profile component and your password file if variable
+ `mh-alias-local-users' is non-nil) has changed. However, you can reload your
+ aliases manually by calling this command directly.
+ 
+ The value of `mh-alias-reloaded-hook' is a list of functions to be called,
+ with no arguments, after the aliases have been loaded."
+   (interactive)
+   (save-excursion
+     (message "Loading MH aliases...")
+     (mh-alias-tstamp t)
+     (mh-exec-cmd-quiet t "ali" "-nolist" "-nouser")
+     (setq mh-alias-alist nil)
+     (setq mh-alias-blind-alist nil)
+     (while  (< (point) (point-max))
+       (cond
+        ((looking-at "^[ \t]"))          ;Continuation line
+        ((looking-at "\\(.+\\): .+: .*$") ; A new -blind- MH alias
+         (when (not (mh-assoc-ignore-case (match-string 1) 
mh-alias-blind-alist))
+           (setq mh-alias-blind-alist
+                 (cons (list (match-string 1)) mh-alias-blind-alist))
+           (setq mh-alias-alist (cons (list (match-string 1)) 
mh-alias-alist))))
+        ((looking-at "\\(.+\\): .*$")    ; A new MH alias
+         (when (not (mh-assoc-ignore-case (match-string 1) mh-alias-alist))
+           (setq mh-alias-alist
+                 (cons (list (match-string 1)) mh-alias-alist)))))
+       (forward-line 1)))
+   (when mh-alias-local-users
+     (setq mh-alias-passwd-alist (mh-alias-local-users))
+     ;; Update aliases with local users, but leave existing aliases alone.
+     (let ((local-users mh-alias-passwd-alist)
+           user)
+       (while local-users
+         (setq user (car local-users))
+         (if (not (mh-assoc-ignore-case (car user) mh-alias-alist))
+             (setq mh-alias-alist (append mh-alias-alist (list user))))
+         (setq local-users (cdr local-users)))))
+   (run-hooks 'mh-alias-reloaded-hook)
+   (message "Loading MH aliases...done"))
+ 
+ ;;;###mh-autoload
+ (defun mh-alias-reload-maybe ()
+   "Load new MH aliases."
+   (if (or (eq mh-alias-alist 'not-read) ; Doesn't exist?
+           (mh-alias-tstamp nil))        ; Out of date?
+       (mh-alias-reload)))
+ 
+ 
+ ;;; Alias Expansion
+ 
+ (defun mh-alias-ali (alias &optional user)
+   "Return ali expansion for ALIAS.
+ ALIAS must be a string for a single alias.
+ If USER is t, then assume ALIAS is an address and call ali -user.
+ ali returns the string unchanged if not defined.  The same is done here."
+   (condition-case err
+       (save-excursion
+         (let ((user-arg (if user "-user" "-nouser")))
+           (mh-exec-cmd-quiet t "ali" user-arg "-nolist" alias))
+         (goto-char (point-max))
+         (if (looking-at "^$") (delete-backward-char 1))
+         (buffer-substring (point-min)(point-max)))
+     (error (progn
+              (message (error-message-string err))
+              alias))))
+ 
+ (defun mh-alias-expand (alias)
+   "Return expansion for ALIAS.
+ Blind aliases or users from /etc/passwd are not expanded."
+   (cond
+    ((mh-assoc-ignore-case alias mh-alias-blind-alist)
+     alias)                              ; Don't expand a blind alias
+    ((mh-assoc-ignore-case alias mh-alias-passwd-alist)
+     (cadr (mh-assoc-ignore-case alias mh-alias-passwd-alist)))
+    (t
+     (mh-alias-ali alias))))
+ 
+ ;;;###mh-autoload
+ (defun mh-read-address (prompt)
+   "Read an address from the minibuffer with PROMPT."
+   (mh-alias-reload-maybe)
+   (if (not mh-alias-alist)            ; If still no aliases, just prompt
+       (read-string prompt)
+     (let* ((minibuffer-local-completion-map mh-alias-read-address-map)
+            (completion-ignore-case mh-alias-completion-ignore-case-flag)
+            (the-answer
+             (cond ((fboundp 'completing-read-multiple)
+                    (mh-funcall-if-exists
+                     completing-read-multiple prompt mh-alias-alist nil nil))
+                   ((featurep 'multi-prompt)
+                    (mh-funcall-if-exists
+                     multi-prompt "," nil prompt mh-alias-alist nil nil))
+                   (t (split-string
+                       (completing-read prompt mh-alias-alist nil nil) ",")))))
+       (if (not mh-alias-expand-aliases-flag)
+           (mapconcat 'identity the-answer ", ")
+         ;; Loop over all elements, checking if in passwd aliast or blind first
+         (mapconcat 'mh-alias-expand the-answer ",\n ")))))
+ 
+ ;;;###mh-autoload
+ (defun mh-alias-minibuffer-confirm-address ()
+   "Display the alias expansion if `mh-alias-flash-on-comma' is non-nil."
+   (interactive)
+   (when mh-alias-flash-on-comma
+     (save-excursion
+       (let* ((case-fold-search t)
+              (beg (mh-beginning-of-word))
+              (the-name (buffer-substring-no-properties beg (point))))
+         (if (mh-assoc-ignore-case the-name mh-alias-alist)
+             (message "%s -> %s" the-name (mh-alias-expand the-name))
+           ;; Check if if was a single word likely to be an alias
+           (if (and (equal mh-alias-flash-on-comma 1)
+                    (not (string-match " " the-name)))
+               (message "No alias for %s" the-name))))))
+   (self-insert-command 1))
+ 
+ (mh-do-in-xemacs (defvar mail-abbrevs))
+ 
+ ;;;###mh-autoload
+ (defun mh-alias-letter-expand-alias ()
+   "Expand mail alias before point."
+   (mh-alias-reload-maybe)
+   (let* ((end (point))
+          (begin (mh-beginning-of-word))
+          (input (buffer-substring-no-properties begin end)))
+     (mh-complete-word input mh-alias-alist begin end)
+     (when mh-alias-expand-aliases-flag
+       (let* ((end (point))
+              (expansion (mh-alias-expand (buffer-substring begin end))))
+         (delete-region begin end)
+         (insert expansion)))))
+ 
+ ;;; Adding addresses to alias file.
+ 
+ (defun mh-alias-suggest-alias (string &optional no-comma-swap)
+   "Suggest an alias for STRING.
+ Don't reverse the order of strings separated by a comma if NO-COMMA-SWAP is
+ non-nil."
+   (cond
+    ((string-match "^<\\(.*\\)>$" string)
+     ;; <address@hidden>  -> recurse, stripping brackets.
+     (mh-alias-suggest-alias (match-string 1 string) no-comma-swap))
+    ((string-match "^\\sw+$" string)
+     ;; One word -> downcase it.
+     (downcase string))
+    ((string-match "^\\(\\sw+\\)\\s-+\\(\\sw+\\)$" string)
+     ;; Two words -> first.last
+     (downcase
+      (format "%s.%s" (match-string 1 string) (match-string 2 string))))
+    ((string-match "^\\([-a-zA-Z0-9._]+\\)@[-a-zA-z0-9_]+\\.+[a-zA-Z0-9]+$"
+                   string)
+     ;; email only -> downcase username
+     (downcase (match-string 1 string)))
+    ((string-match "^\"\\(.*\\)\".*" string)
+     ;; "Some name" <address@hidden>  -> recurse -> "Some name"
+     (mh-alias-suggest-alias (match-string 1 string) no-comma-swap))
+    ((string-match "^\\(.*\\) +<.*>$" string)
+     ;; Some name <address@hidden>  -> recurse -> Some name
+     (mh-alias-suggest-alias (match-string 1 string) no-comma-swap))
+    ((string-match (concat mh-address-mail-regexp " +(\\(.*\\))$") string)
+     ;; address@hidden (Some name)  -> recurse -> Some name
+     (mh-alias-suggest-alias (match-string 1 string) no-comma-swap))
+    ((string-match "^\\(Dr\\|Prof\\)\\.? +\\(.*\\)" string)
+     ;; Strip out title
+     (mh-alias-suggest-alias (match-string 2 string) no-comma-swap))
+    ((string-match "^\\(.*\\), +\\(Jr\\.?\\|II+\\)$" string)
+     ;; Strip out tails with comma
+     (mh-alias-suggest-alias (match-string 1 string) no-comma-swap))
+    ((string-match "^\\(.*\\) +\\(Jr\\.?\\|II+\\)$" string)
+     ;; Strip out tails
+     (mh-alias-suggest-alias (match-string 1 string) no-comma-swap))
+    ((string-match "^\\(\\sw+\\) +[A-Z]\\.? +\\(.*\\)$" string)
+     ;; Strip out initials
+     (mh-alias-suggest-alias
+      (format "%s %s" (match-string 1 string) (match-string 2 string))
+      no-comma-swap))
+    ((and (not no-comma-swap)
+          (string-match "^\\([^,]+\\), +\\(.*\\)$" string))
+     ;; Reverse order of comma-separated fields to handle:
+     ;;  From: "Galbraith, Peter" <address@hidden>
+     ;; but don't this for a name string extracted from the passwd file
+     ;; with mh-alias-passwd-gecos-comma-separator-flag set to nil.
+     (mh-alias-suggest-alias
+      (format "%s %s" (match-string 2 string) (match-string 1 string))
+      no-comma-swap))
+    (t
+     ;; Output string, with spaces replaced by dots.
+     (mh-alias-canonicalize-suggestion string))))
+ 
+ (defun mh-alias-canonicalize-suggestion (string)
+   "Process STRING to replace spaces by periods.
+ First all spaces and commas are replaced by periods. Then every run of
+ consecutive periods are replaced with a single period. Finally the string
+ is converted to lower case."
+   (with-temp-buffer
+     (insert string)
+     ;; Replace spaces with periods
+     (goto-char (point-min))
+     (while (re-search-forward " +" nil t)
+       (replace-match "." nil nil))
+     ;; Replace commas with periods
+     (goto-char (point-min))
+     (while (re-search-forward ",+" nil t)
+       (replace-match "." nil nil))
+     ;; Replace consecutive periods with a single period
+     (goto-char (point-min))
+     (while (re-search-forward "\\.\\.+" nil t)
+       (replace-match "." nil nil))
+     ;; Convert to lower case
+     (downcase-region (point-min) (point-max))
+     ;; Whew! all done...
+     (buffer-string)))
+ 
+ (defun mh-alias-which-file-has-alias (alias file-list)
+   "Return the name of writable file which defines ALIAS from list FILE-LIST."
+   (save-excursion
+     (set-buffer (get-buffer-create mh-temp-buffer))
+     (let ((the-list file-list)
+           (found))
+       (while the-list
+         (erase-buffer)
+         (when (file-writable-p (car file-list))
+           (insert-file-contents (car file-list))
+           (if (re-search-forward (concat "^" (regexp-quote alias) ":") nil t)
+               (setq found (car file-list)
+                     the-list nil)
+             (setq the-list (cdr the-list)))))
+       found)))
+ 
+ (defun mh-alias-insert-file (&optional alias)
+   "Return filename which should be used to add ALIAS.
+ The value of the option `mh-alias-insert-file' is used if non-nil\; otherwise
+ the value of the `Aliasfile:' profile component is used.
+ If the alias already exists, try to return the name of the file that contains
+ it."
+   (cond
+    ((and mh-alias-insert-file (listp mh-alias-insert-file))
+     (if (not (elt mh-alias-insert-file 1))        ; Only one entry, use it
+         (car mh-alias-insert-file)
+       (if (or (not alias)
+               (string-equal alias (mh-alias-ali alias))) ;alias doesn't exist
+           (completing-read "Alias file: "
+                            (mapcar 'list mh-alias-insert-file) nil t)
+         (or (mh-alias-which-file-has-alias alias mh-alias-insert-file)
+             (completing-read "Alias file: "
+                              (mapcar 'list mh-alias-insert-file) nil t)))))
+    ((and mh-alias-insert-file (stringp mh-alias-insert-file))
+     mh-alias-insert-file)
+    (t
+     ;; writable ones returned from (mh-alias-filenames):
+     (let ((autolist (delq nil (mapcar (lambda (file)
+                                         (if (and (file-writable-p file)
+                                                  (not (string-equal
+                                                        file "/etc/passwd")))
+                                             file))
+                                      (mh-alias-filenames t)))))
+       (cond
+        ((not autolist)
+         (error "No writable alias file.
+ Set `mh-alias-insert-file' or the Aliasfile profile component"))
+        ((not (elt autolist 1))        ; Only one entry, use it
+         (car autolist))
+        ((or (not alias)
+             (string-equal alias (mh-alias-ali alias))) ;alias doesn't exist
+         (completing-read "Alias file: " (mapcar 'list autolist) nil t))
+        (t
+         (or (mh-alias-which-file-has-alias alias autolist)
+             (completing-read "Alias file: "
+                              (mapcar 'list autolist) nil t))))))))
+ 
+ ;;;###mh-autoload
+ (defun mh-alias-address-to-alias (address)
+   "Return the ADDRESS alias if defined, or nil."
+   (let* ((aliases (mh-alias-ali address t)))
+     (if (string-equal aliases address)
+         nil                             ; ali returned same string -> no.
+       ;; Double-check that we have an individual alias. This means that the
+       ;; alias doesn't expand into a list (of which this address is part).
+       (car (delq nil (mapcar
+                       (function
+                        (lambda (alias)
+                          (let ((recurse (mh-alias-ali alias nil)))
+                            (if (string-match ".*,.*" recurse)
+                                nil
+                              alias))))
+                       (split-string aliases ", +")))))))
+ 
+ ;;;###mh-autoload
+ (defun mh-alias-for-from-p ()
+   "Return t if sender's address has a corresponding alias."
+   (mh-alias-reload-maybe)
+   (save-excursion
+     (if (not (mh-folder-line-matches-show-buffer-p))
+         nil                             ;No corresponding show buffer
+       (if (eq major-mode 'mh-folder-mode)
+           (set-buffer mh-show-buffer))
+       (let ((from-header (mh-extract-from-header-value)))
+         (and from-header
+              (mh-alias-address-to-alias from-header))))))
+ 
+ (defun mh-alias-add-alias-to-file (alias address &optional file)
+   "Add ALIAS for ADDRESS in alias FILE without alias check or prompts.
+ Prompt for alias file if not provided and there is more than one candidate.
+ 
+ If the alias exists already, you will have the choice of inserting the new
+ alias before or after the old alias. In the former case, this alias will be
+ used when sending mail to this alias. In the latter case, the alias serves as
+ an additional folder name hint when filing messages."
+   (if (not file)
+       (setq file (mh-alias-insert-file alias)))
+   (save-excursion
+     (set-buffer (find-file-noselect file))
+     (goto-char (point-min))
+     (let ((alias-search (concat alias ":"))
+           (letter)
+           (case-fold-search t))
+       (cond
+        ;; Search for exact match (if we had the same alias before)
+        ((re-search-forward
+          (concat "^" (regexp-quote alias-search) " *\\(.*\\)") nil t)
+         (let ((answer (read-string
+                        (format (concat "Alias %s exists; insert new address "
+                                        "[b]efore or [a]fter: ")
+                                (match-string 1))))
+               (case-fold-search t))
+           (cond ((string-match "^b" answer))
+                 ((string-match "^a" answer)
+                  (forward-line 1))
+                 (t
+                  (error "Unrecognized response")))))
+        ;; No, so sort-in at the right place
+        ;; search for "^alias", then "^alia", etc.
+        ((eq mh-alias-insertion-location 'sorted)
+         (setq letter       (substring alias-search -1)
+               alias-search (substring alias-search 0 -1))
+         (while (and (not (equal alias-search ""))
+                     (not (re-search-forward
+                           (concat "^" (regexp-quote alias-search)) nil t)))
+           (setq letter       (substring alias-search -1)
+                 alias-search (substring alias-search 0 -1)))
+         ;; Next, move forward to sort alphabetically for following letters
+         (beginning-of-line)
+         (while (re-search-forward
+                 (concat "^" (regexp-quote alias-search) "[a-" letter "]")
+                 nil t)
+           (forward-line 1)))
+        ((eq mh-alias-insertion-location 'bottom)
+         (goto-char (point-max)))
+        ((eq mh-alias-insertion-location 'top)
+         (goto-char (point-min)))))
+     (beginning-of-line)
+     (insert (format "%s: %s\n" alias address))
+     (save-buffer)))
+ 
+ ;;;###mh-autoload
+ (defun mh-alias-add-alias (alias address)
+   "*Add ALIAS for ADDRESS in personal alias file.
+ This function prompts you for an alias and address. If the alias exists
+ already, you will have the choice of inserting the new alias before or after
+ the old alias. In the former case, this alias will be used when sending mail
+ to this alias. In the latter case, the alias serves as an additional folder
+ name hint when filing messages."
+   (interactive "P\nP")
+   (mh-alias-reload-maybe)
+   (setq alias (completing-read "Alias: " mh-alias-alist nil nil alias))
+   (if (and address (string-match "^<\\(.*\\)>$" address))
+       (setq address (match-string 1 address)))
+   (setq address (read-string "Address: " address))
+   (if (string-match "^<\\(.*\\)>$" address)
+       (setq address (match-string 1 address)))
+   (let ((address-alias (mh-alias-address-to-alias address))
+         (alias-address (mh-alias-expand alias)))
+     (if (string-equal alias-address alias)
+         (setq alias-address nil))
+     (cond
+      ((and (equal alias address-alias)
+            (equal address alias-address))
+       (message "Already defined as: %s" alias-address))
+      (address-alias
+       (if (y-or-n-p (format "Address has alias %s; set new one? "
+                             address-alias))
+           (mh-alias-add-alias-to-file alias address)))
+      (t
+       (mh-alias-add-alias-to-file alias address)))))
+ 
+ ;;;###mh-autoload
+ (defun mh-alias-grab-from-field ()
+   "*Add alias for the sender of the current message."
+   (interactive)
+   (mh-alias-reload-maybe)
+   (save-excursion
+     (cond
+      ((mh-folder-line-matches-show-buffer-p)
+       (set-buffer mh-show-buffer))
+      ((and (eq major-mode 'mh-folder-mode)
+            (mh-get-msg-num nil))
+       (set-buffer (get-buffer-create mh-temp-buffer))
+       (insert-file-contents (mh-msg-filename (mh-get-msg-num t))))
+      ((eq major-mode 'mh-folder-mode)
+       (error "Cursor not pointing to a message")))
+     (let* ((address (or (mh-extract-from-header-value)
+                         (error "Message has no From: header")))
+            (alias (mh-alias-suggest-alias address)))
+       (mh-alias-add-alias alias address))))
+ 
+ ;;;###mh-autoload
+ (defun mh-alias-add-address-under-point ()
+   "Insert an alias for address under point."
+   (interactive)
+   (let ((address (mh-goto-address-find-address-at-point)))
+     (if address
+         (mh-alias-add-alias nil address)
+       (message "No email address found under point"))))
+ 
+ ;;;###mh-autoload
+ (defun mh-alias-apropos (regexp)
+   "Show all aliases or addresses that match REGEXP."
+   (interactive "sAlias regexp: ")
+   (if mh-alias-local-users
+       (mh-alias-reload-maybe))
+   (let ((matches "")
+         (group-matches "")
+         (passwd-matches))
+     (save-excursion
+       (message "Reading MH aliases...")
+       (mh-exec-cmd-quiet t "ali" "-nolist" "-nouser")
+       (message "Parsing MH aliases...")
+       (while (re-search-forward regexp nil t)
+         (beginning-of-line)
+         (cond
+          ((looking-at "^[ \t]")         ;Continuation line
+           (setq group-matches
+                 (concat group-matches
+                         (buffer-substring
+                          (save-excursion
+                            (or (re-search-backward "^[^ \t]" nil t)
+                                (point)))
+                          (progn
+                            (if (re-search-forward  "^[^ \t]" nil t)
+                                (forward-char -1))
+                            (point))))))
+          (t
+           (setq matches
+                 (concat matches
+                         (buffer-substring (point)(progn (end-of-line)(point)))
+                         "\n")))))
+       (message "Parsing MH aliases...done")
+       (when mh-alias-local-users
+         (message "Making passwd aliases...")
+         (setq passwd-matches
+               (mapconcat
+                '(lambda (elem)
+                   (if (or (string-match regexp (car elem))
+                           (string-match regexp (cadr elem)))
+                       (format "%s: %s\n" (car elem) (cadr elem))))
+                mh-alias-passwd-alist ""))
+         (message "Making passwd aliases...done")))
+     (if (and (string-equal "" matches)
+              (string-equal "" group-matches)
+              (string-equal "" passwd-matches))
+         (message "No matches")
+       (with-output-to-temp-buffer mh-aliases-buffer
+         (if (not (string-equal "" matches))
+             (princ matches))
+         (when (not (string-equal group-matches ""))
+           (princ "\nGroup Aliases:\n\n")
+           (princ group-matches))
+         (when (not (string-equal passwd-matches ""))
+           (princ "\nLocal User Aliases:\n\n")
+           (princ passwd-matches))))))
+ 
+ (provide 'mh-alias)
+ 
+ ;;; Local Variables:
+ ;;; indent-tabs-mode: nil
+ ;;; sentence-end-double-space: nil
+ ;;; End:
+ 
+ ;;; arch-tag: 49879e46-5aa3-4569-bece-e5a58731d690
+ ;;; mh-alias.el ends here