code.delx.au - gnu-emacs/blob - lisp/mh-e/mh-alias.el

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