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