mh-alias.el 28 KB
Newer Older
Bill Wohler's avatar
Bill Wohler committed
1
;;; mh-alias.el --- MH-E mail alias completion and expansion
Bill Wohler's avatar
Bill Wohler committed
2

Bill Wohler's avatar
Bill Wohler committed
3
;; Copyright (C) 1994, 1995, 1996, 1997,
4
;;  2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
5

Bill Wohler's avatar
Bill Wohler committed
6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24
;; Author: Peter S. Galbraith <psg@debian.org>
;; Maintainer: Bill Wohler <wohler@newt.com>
;; 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
Lute Kamstra's avatar
Lute Kamstra committed
25 26
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
Bill Wohler's avatar
Bill Wohler committed
27 28 29

;;; Commentary:

Bill Wohler's avatar
Bill Wohler committed
30 31
;;; Change Log:

Bill Wohler's avatar
Bill Wohler committed
32 33 34
;;; Code:

(require 'mh-e)
Bill Wohler's avatar
Bill Wohler committed
35

Bill Wohler's avatar
Bill Wohler committed
36
(mh-require-cl)
Bill Wohler's avatar
Bill Wohler committed
37

Bill Wohler's avatar
Bill Wohler committed
38
(defvar mh-alias-alist 'not-read
Bill Wohler's avatar
Bill Wohler committed
39 40 41 42 43 44 45 46
  "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)
Bill Wohler's avatar
Bill Wohler committed
47
(unless mh-alias-read-address-map
Bill Wohler's avatar
Bill Wohler committed
48
  (setq mh-alias-read-address-map
Bill Wohler's avatar
Bill Wohler committed
49
        (copy-keymap minibuffer-local-completion-map))
Bill Wohler's avatar
Bill Wohler committed
50 51
  (define-key mh-alias-read-address-map
    "," 'mh-alias-minibuffer-confirm-address)
Bill Wohler's avatar
Bill Wohler committed
52 53
  (define-key mh-alias-read-address-map " " 'self-insert-command))

Bill Wohler's avatar
Bill Wohler committed
54 55 56 57 58
(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.
59 60
If these files are modified, they are automatically reread. This list
need include only system aliases and the passwd file, since personal
61
alias files listed in your \"Aliasfile:\" MH profile component are
62 63
automatically included. You can update the alias list manually using
\\[mh-alias-reload].")
Bill Wohler's avatar
Bill Wohler committed
64

Bill Wohler's avatar
Bill Wohler committed
65 66 67 68 69
;; Copy of `goto-address-mail-regexp'.
(defvar mh-address-mail-regexp
  "[-a-zA-Z0-9._]+@\\([-a-zA-z0-9_]+\\.\\)+[a-zA-Z0-9]+"
  "A regular expression probably matching an e-mail address.")

Bill Wohler's avatar
Bill Wohler committed
70

Bill Wohler's avatar
Bill Wohler committed
71

Bill Wohler's avatar
Bill Wohler committed
72 73 74 75
;;; Alias Loading

(defun mh-alias-tstamp (arg)
  "Check whether alias files have been modified.
76 77
Return t if any file listed in the Aliasfile MH profile component has
been modified since the timestamp.
Bill Wohler's avatar
Bill Wohler committed
78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94
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.
95 96 97 98
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."
Bill Wohler's avatar
Bill Wohler committed
99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116
  (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))))

Bill Wohler's avatar
Bill Wohler committed
117 118
(defun mh-alias-gecos-name (gecos-name username comma-separator)
  "Return a usable address string from a GECOS-NAME and USERNAME.
119 120
Use only part of the GECOS-NAME up to the first comma if
COMMA-SEPARATOR is non-nil."
Bill Wohler's avatar
Bill Wohler committed
121 122 123 124 125 126 127
  (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)
128
        (setq res (mh-replace-regexp-in-string "&" (capitalize username) res)))
Bill Wohler's avatar
Bill Wohler committed
129 130
    ;; Remove " character
    (if (string-match "\"" res)
131
        (setq res (mh-replace-regexp-in-string "\"" "" res)))
Bill Wohler's avatar
Bill Wohler committed
132 133 134 135 136 137 138 139
    ;; 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))

Bill Wohler's avatar
Bill Wohler committed
140
(defun mh-alias-local-users ()
Bill Wohler's avatar
Bill Wohler committed
141
  "Return an alist of local users from /etc/passwd.
142
Exclude all aliases already in `mh-alias-alist' from \"ali\""
Bill Wohler's avatar
Bill Wohler committed
143 144 145 146 147 148 149 150 151 152
  (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")
Bill Wohler's avatar
Bill Wohler committed
153
        (shell-command-on-region (point-min) (point-max) mh-alias-local-users t)
Bill Wohler's avatar
Bill Wohler committed
154 155 156
        (goto-char (point-min))))
      (while  (< (point) (point-max))
        (cond
Bill Wohler's avatar
Bill Wohler committed
157
         ((looking-at "\\([^:]*\\):[^:]*:\\([^:]*\\):[^:]*:\\([^:]*\\):")
Bill Wohler's avatar
Bill Wohler committed
158
          (when (> (string-to-number (match-string 2)) 200)
Bill Wohler's avatar
Bill Wohler committed
159 160
            (let* ((username (match-string 1))
                   (gecos-name (match-string 3))
Bill Wohler's avatar
Bill Wohler committed
161 162
                   (realname (mh-alias-gecos-name
                              gecos-name username
Bill Wohler's avatar
Bill Wohler committed
163 164
                              mh-alias-passwd-gecos-comma-separator-flag))
                   (alias-name (if mh-alias-local-users-prefix
Bill Wohler's avatar
Bill Wohler committed
165 166 167
                                   (concat mh-alias-local-users-prefix
                                           (mh-alias-suggest-alias realname t))
                                 username))
Bill Wohler's avatar
Bill Wohler committed
168 169 170 171
                   (alias-translation
                    (if (string-equal username realname)
                        (concat "<" username ">")
                      (concat realname " <" username ">"))))
172
              (when (not (mh-assoc-string alias-name mh-alias-alist t))
Bill Wohler's avatar
Bill Wohler committed
173 174
                (setq passwd-alist (cons (list alias-name alias-translation)
                                         passwd-alist)))))))
Bill Wohler's avatar
Bill Wohler committed
175 176 177 178
        (forward-line 1)))
    passwd-alist))

(defun mh-alias-reload ()
Bill Wohler's avatar
Bill Wohler committed
179 180
  "Reload MH aliases.

181 182
Since aliases are updated frequently, MH-E reloads aliases
automatically whenever an alias lookup occurs if an alias source has
183
changed. Sources include files listed in your \"Aliasfile:\" profile
184 185 186
component and your password file if option `mh-alias-local-users' is
turned on. However, you can reload your aliases manually by calling
this command directly.
187

188 189
This function runs `mh-alias-reloaded-hook' after the aliases have
been loaded."
Bill Wohler's avatar
Bill Wohler committed
190 191 192 193 194 195 196 197 198 199 200
  (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
201
        (when (not (mh-assoc-string (match-string 1) mh-alias-blind-alist t))
Bill Wohler's avatar
Bill Wohler committed
202 203 204 205
          (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
206
        (when (not (mh-assoc-string (match-string 1) mh-alias-alist t))
Bill Wohler's avatar
Bill Wohler committed
207 208 209 210 211 212 213 214 215 216
          (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))
217
        (if (not (mh-assoc-string (car user) mh-alias-alist t))
Bill Wohler's avatar
Bill Wohler committed
218 219
            (setq mh-alias-alist (append mh-alias-alist (list user))))
        (setq local-users (cdr local-users)))))
Bill Wohler's avatar
Bill Wohler committed
220
  (run-hooks 'mh-alias-reloaded-hook)
Bill Wohler's avatar
Bill Wohler committed
221 222
  (message "Loading MH aliases...done"))

Bill Wohler's avatar
Bill Wohler committed
223
;;;###mh-autoload
Bill Wohler's avatar
Bill Wohler committed
224 225
(defun mh-alias-reload-maybe ()
  "Load new MH aliases."
Bill Wohler's avatar
Bill Wohler committed
226 227
  (if (or (eq mh-alias-alist 'not-read) ; Doesn't exist?
          (mh-alias-tstamp nil))        ; Out of date?
Bill Wohler's avatar
Bill Wohler committed
228 229 230
      (mh-alias-reload)))


Bill Wohler's avatar
Bill Wohler committed
231

Bill Wohler's avatar
Bill Wohler committed
232 233 234 235 236
;;; Alias Expansion

(defun mh-alias-ali (alias &optional user)
  "Return ali expansion for ALIAS.
ALIAS must be a string for a single alias.
237 238
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."
Bill Wohler's avatar
Bill Wohler committed
239 240 241 242 243 244 245 246
  (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
247
             (message "%s" (error-message-string err))
Bill Wohler's avatar
Bill Wohler committed
248
             alias))))
Bill Wohler's avatar
Bill Wohler committed
249 250 251 252 253

(defun mh-alias-expand (alias)
  "Return expansion for ALIAS.
Blind aliases or users from /etc/passwd are not expanded."
  (cond
254
   ((mh-assoc-string alias mh-alias-blind-alist t)
Bill Wohler's avatar
Bill Wohler committed
255
    alias)                              ; Don't expand a blind alias
256 257
   ((mh-assoc-string alias mh-alias-passwd-alist t)
    (cadr (mh-assoc-string alias mh-alias-passwd-alist t)))
Bill Wohler's avatar
Bill Wohler committed
258 259 260
   (t
    (mh-alias-ali alias))))

261 262
(mh-require 'crm nil t)                 ; completing-read-multiple
(mh-require 'multi-prompt nil t)
Bill Wohler's avatar
Bill Wohler committed
263

Bill Wohler's avatar
Bill Wohler committed
264 265 266 267
;;;###mh-autoload
(defun mh-read-address (prompt)
  "Read an address from the minibuffer with PROMPT."
  (mh-alias-reload-maybe)
Bill Wohler's avatar
Bill Wohler committed
268
  (if (not mh-alias-alist)              ; If still no aliases, just prompt
Bill Wohler's avatar
Bill Wohler committed
269 270 271 272
      (read-string prompt)
    (let* ((minibuffer-local-completion-map mh-alias-read-address-map)
           (completion-ignore-case mh-alias-completion-ignore-case-flag)
           (the-answer
Bill Wohler's avatar
Bill Wohler committed
273 274 275 276 277 278 279 280
            (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) ",")))))
Bill Wohler's avatar
Bill Wohler committed
281 282 283 284 285 286 287 288 289
      (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)
Bill Wohler's avatar
Bill Wohler committed
290
  (when mh-alias-flash-on-comma
Bill Wohler's avatar
Bill Wohler committed
291 292
    (save-excursion
      (let* ((case-fold-search t)
Bill Wohler's avatar
Bill Wohler committed
293 294
             (beg (mh-beginning-of-word))
             (the-name (buffer-substring-no-properties beg (point))))
295
        (if (mh-assoc-string the-name mh-alias-alist t)
Bill Wohler's avatar
Bill Wohler committed
296 297 298 299 300 301 302 303 304 305 306
            (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-autoload
(defun mh-alias-letter-expand-alias ()
  "Expand mail alias before point."
  (mh-alias-reload-maybe)
Bill Wohler's avatar
Bill Wohler committed
307 308 309 310 311 312 313 314 315
  (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)))))
Bill Wohler's avatar
Bill Wohler committed
316

Bill Wohler's avatar
Bill Wohler committed
317

Bill Wohler's avatar
Bill Wohler committed
318

Bill Wohler's avatar
Bill Wohler committed
319
;;; Alias File Updating
Bill Wohler's avatar
Bill Wohler committed
320

Bill Wohler's avatar
Bill Wohler committed
321 322
(defun mh-alias-suggest-alias (string &optional no-comma-swap)
  "Suggest an alias for STRING.
323 324
Don't reverse the order of strings separated by a comma if
NO-COMMA-SWAP is non-nil."
Bill Wohler's avatar
Bill Wohler committed
325
  (cond
Bill Wohler's avatar
Bill Wohler committed
326 327
   ((string-match "^<\\(.*\\)>$" string)
    ;; <somename@foo.bar>  -> recurse, stripping brackets.
Bill Wohler's avatar
Bill Wohler committed
328
    (mh-alias-suggest-alias (match-string 1 string) no-comma-swap))
Bill Wohler's avatar
Bill Wohler committed
329 330 331 332 333 334 335 336 337 338 339 340 341
   ((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" <somename@foo.bar>  -> recurse -> "Some name"
Bill Wohler's avatar
Bill Wohler committed
342
    (mh-alias-suggest-alias (match-string 1 string) no-comma-swap))
Bill Wohler's avatar
Bill Wohler committed
343 344
   ((string-match "^\\(.*\\) +<.*>$" string)
    ;; Some name <somename@foo.bar>  -> recurse -> Some name
Bill Wohler's avatar
Bill Wohler committed
345
    (mh-alias-suggest-alias (match-string 1 string) no-comma-swap))
Bill Wohler's avatar
Bill Wohler committed
346 347
   ((string-match (concat mh-address-mail-regexp " +(\\(.*\\))$") string)
    ;; somename@foo.bar (Some name)  -> recurse -> Some name
Bill Wohler's avatar
Bill Wohler committed
348
    (mh-alias-suggest-alias (match-string 1 string) no-comma-swap))
Bill Wohler's avatar
Bill Wohler committed
349 350
   ((string-match "^\\(Dr\\|Prof\\)\\.? +\\(.*\\)" string)
    ;; Strip out title
Bill Wohler's avatar
Bill Wohler committed
351
    (mh-alias-suggest-alias (match-string 2 string) no-comma-swap))
Bill Wohler's avatar
Bill Wohler committed
352 353
   ((string-match "^\\(.*\\), +\\(Jr\\.?\\|II+\\)$" string)
    ;; Strip out tails with comma
Bill Wohler's avatar
Bill Wohler committed
354
    (mh-alias-suggest-alias (match-string 1 string) no-comma-swap))
Bill Wohler's avatar
Bill Wohler committed
355 356
   ((string-match "^\\(.*\\) +\\(Jr\\.?\\|II+\\)$" string)
    ;; Strip out tails
Bill Wohler's avatar
Bill Wohler committed
357
    (mh-alias-suggest-alias (match-string 1 string) no-comma-swap))
Bill Wohler's avatar
Bill Wohler committed
358 359 360
   ((string-match "^\\(\\sw+\\) +[A-Z]\\.? +\\(.*\\)$" string)
    ;; Strip out initials
    (mh-alias-suggest-alias
Bill Wohler's avatar
Bill Wohler committed
361 362 363 364 365 366 367 368
     (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" <psg@debian.org>
    ;; but don't this for a name string extracted from the passwd file
    ;; with mh-alias-passwd-gecos-comma-separator-flag set to nil.
Bill Wohler's avatar
Bill Wohler committed
369
    (mh-alias-suggest-alias
Bill Wohler's avatar
Bill Wohler committed
370 371
     (format "%s %s" (match-string 2 string) (match-string 1 string))
     no-comma-swap))
Bill Wohler's avatar
Bill Wohler committed
372 373
   (t
    ;; Output string, with spaces replaced by dots.
Bill Wohler's avatar
Bill Wohler committed
374 375 376
    (mh-alias-canonicalize-suggestion string))))

(defun mh-alias-canonicalize-suggestion (string)
Bill Wohler's avatar
Bill Wohler committed
377 378
  "Process STRING to replace spaces by periods.
First all spaces and commas are replaced by periods. Then every run of
379 380
consecutive periods are replaced with a single period. Finally the
string is converted to lower case."
Bill Wohler's avatar
Bill Wohler committed
381 382 383 384
  (with-temp-buffer
    (insert string)
    ;; Replace spaces with periods
    (goto-char (point-min))
Bill Wohler's avatar
Bill Wohler committed
385 386 387 388 389 390
    (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))
Bill Wohler's avatar
Bill Wohler committed
391 392
    ;; Replace consecutive periods with a single period
    (goto-char (point-min))
Bill Wohler's avatar
Bill Wohler committed
393 394
    (while (re-search-forward "\\.\\.+" nil t)
      (replace-match "." nil nil))
Bill Wohler's avatar
Bill Wohler committed
395 396 397 398
    ;; Convert to lower case
    (downcase-region (point-min) (point-max))
    ;; Whew! all done...
    (buffer-string)))
Bill Wohler's avatar
Bill Wohler committed
399 400 401 402 403 404 405 406 407 408 409

(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))
Bill Wohler's avatar
Bill Wohler committed
410
          (if (re-search-forward (concat "^" (regexp-quote alias) ":") nil t)
Bill Wohler's avatar
Bill Wohler committed
411 412 413 414 415 416
              (setq found (car file-list)
                    the-list nil)
            (setq the-list (cdr the-list)))))
      found)))

(defun mh-alias-insert-file (&optional alias)
Bill Wohler's avatar
Bill Wohler committed
417
  "Return filename which should be used to add ALIAS.
418
The value of the option `mh-alias-insert-file' is used if non-nil\;
419
otherwise the value of the \"Aliasfile:\" profile component is used.
420 421
If the alias already exists, try to return the name of the file that
contains it."
Bill Wohler's avatar
Bill Wohler committed
422 423 424 425 426 427
  (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
Bill Wohler's avatar
Bill Wohler committed
428
          (completing-read "Alias file: "
Bill Wohler's avatar
Bill Wohler committed
429 430
                           (mapcar 'list mh-alias-insert-file) nil t)
        (or (mh-alias-which-file-has-alias alias mh-alias-insert-file)
Bill Wohler's avatar
Bill Wohler committed
431
            (completing-read "Alias file: "
Bill Wohler's avatar
Bill Wohler committed
432 433 434 435 436 437 438 439 440 441 442 443 444
                             (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)
Bill Wohler's avatar
Bill Wohler committed
445 446
        (error "No writable alias file;
set `mh-alias-insert-file' or the \"Aliasfile:\" profile component"))
Bill Wohler's avatar
Bill Wohler committed
447 448 449 450
       ((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
Bill Wohler's avatar
Bill Wohler committed
451
        (completing-read "Alias file: " (mapcar 'list autolist) nil t))
Bill Wohler's avatar
Bill Wohler committed
452 453
       (t
        (or (mh-alias-which-file-has-alias alias autolist)
Bill Wohler's avatar
Bill Wohler committed
454
            (completing-read "Alias file: "
Bill Wohler's avatar
Bill Wohler committed
455 456
                             (mapcar 'list autolist) nil t))))))))

Bill Wohler's avatar
Bill Wohler committed
457
;;;###mh-autoload
Bill Wohler's avatar
Bill Wohler committed
458 459 460 461 462
(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.
Bill Wohler's avatar
Bill Wohler committed
463 464
      ;; 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).
Bill Wohler's avatar
Bill Wohler committed
465 466 467 468 469 470 471 472 473 474
      (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
Bill Wohler's avatar
Bill Wohler committed
475 476
(defun mh-alias-for-from-p ()
  "Return t if sender's address has a corresponding alias."
Bill Wohler's avatar
Bill Wohler committed
477 478 479 480 481 482
  (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))
Bill Wohler's avatar
Bill Wohler committed
483 484
      (let ((from-header (mh-extract-from-header-value)))
        (and from-header
Bill Wohler's avatar
Bill Wohler committed
485
             (mh-alias-address-to-alias from-header))))))
Bill Wohler's avatar
Bill Wohler committed
486 487 488

(defun mh-alias-add-alias-to-file (alias address &optional file)
  "Add ALIAS for ADDRESS in alias FILE without alias check or prompts.
489 490 491 492 493 494 495 496
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."
Bill Wohler's avatar
Bill Wohler committed
497 498 499 500 501 502 503 504 505 506 507 508 509
  (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
Bill Wohler's avatar
Bill Wohler committed
510 511
                       (format (concat "Alias %s exists; insert new address "
                                       "[b]efore or [a]fter: ")
Bill Wohler's avatar
Bill Wohler committed
512 513
                               (match-string 1))))
              (case-fold-search t))
Bill Wohler's avatar
Bill Wohler committed
514
          (cond ((string-match "^b" answer))
Bill Wohler's avatar
Bill Wohler committed
515 516 517
                ((string-match "^a" answer)
                 (forward-line 1))
                (t
Bill Wohler's avatar
Bill Wohler committed
518
                 (error "Unrecognized response")))))
Bill Wohler's avatar
Bill Wohler committed
519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543
       ;; 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)))

(defun mh-alias-add-alias (alias address)
544 545
  "Add ALIAS for ADDRESS in personal alias file.

546 547 548 549 550 551
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."
Bill Wohler's avatar
Bill Wohler committed
552 553 554
  (interactive "P\nP")
  (mh-alias-reload-maybe)
  (setq alias (completing-read "Alias: " mh-alias-alist nil nil alias))
Bill Wohler's avatar
Bill Wohler committed
555 556
  (if (and address (string-match "^<\\(.*\\)>$" address))
      (setq address (match-string 1 address)))
Bill Wohler's avatar
Bill Wohler committed
557
  (setq address (read-string "Address: " address))
Bill Wohler's avatar
Bill Wohler committed
558 559
  (if (string-match "^<\\(.*\\)>$" address)
      (setq address (match-string 1 address)))
Bill Wohler's avatar
Bill Wohler committed
560 561 562 563 564 565 566
  (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))
567
      (message "Already defined as %s" alias-address))
Bill Wohler's avatar
Bill Wohler committed
568 569 570 571 572 573 574 575 576
     (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 ()
577
  "Add alias for the sender of the current message."
Bill Wohler's avatar
Bill Wohler committed
578 579 580 581 582 583 584 585 586 587 588 589
  (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")))
Bill Wohler's avatar
Bill Wohler committed
590 591
    (let* ((address (or (mh-extract-from-header-value)
                        (error "Message has no From: header")))
Bill Wohler's avatar
Bill Wohler committed
592 593 594 595
           (alias (mh-alias-suggest-alias address)))
      (mh-alias-add-alias alias address))))

(defun mh-alias-add-address-under-point ()
Bill Wohler's avatar
Bill Wohler committed
596
  "Insert an alias for address under point."
Bill Wohler's avatar
Bill Wohler committed
597 598 599 600
  (interactive)
  (let ((address (mh-goto-address-find-address-at-point)))
    (if address
        (mh-alias-add-alias nil address)
Bill Wohler's avatar
Bill Wohler committed
601
      (message "No email address found under point"))))
Bill Wohler's avatar
Bill Wohler committed
602

Bill Wohler's avatar
Bill Wohler committed
603 604 605 606 607 608
;; From goto-addr.el, which we don't want to force-load on users.
(defun mh-goto-address-find-address-at-point ()
  "Find e-mail address around or before point.

Then search backwards to beginning of line for the start of an
e-mail address. If no e-mail address found, return nil."
609
  (re-search-backward "[^-_A-z0-9.@]" (mh-line-beginning-position) 'lim)
Bill Wohler's avatar
Bill Wohler committed
610 611
  (if (or (looking-at mh-address-mail-regexp) ; already at start
          (and (re-search-forward mh-address-mail-regexp
612
                                  (mh-line-end-position) 'lim)
Bill Wohler's avatar
Bill Wohler committed
613
               (goto-char (match-beginning 0))))
614
      (mh-match-string-no-properties 0)))
Bill Wohler's avatar
Bill Wohler committed
615

Bill Wohler's avatar
Bill Wohler committed
616
(defun mh-alias-apropos (regexp)
617
  "Show all aliases or addresses that match a regular expression REGEXP."
Bill Wohler's avatar
Bill Wohler committed
618 619 620
  (interactive "sAlias regexp: ")
  (if mh-alias-local-users
      (mh-alias-reload-maybe))
Bill Wohler's avatar
Bill Wohler committed
621 622 623
  (let ((matches "")
        (group-matches "")
        (passwd-matches))
Bill Wohler's avatar
Bill Wohler committed
624 625 626
    (save-excursion
      (message "Reading MH aliases...")
      (mh-exec-cmd-quiet t "ali" "-nolist" "-nouser")
Bill Wohler's avatar
Bill Wohler committed
627
      (message "Parsing MH aliases...")
Bill Wohler's avatar
Bill Wohler committed
628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646
      (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")))))
Bill Wohler's avatar
Bill Wohler committed
647
      (message "Parsing MH aliases...done")
Bill Wohler's avatar
Bill Wohler committed
648
      (when mh-alias-local-users
Bill Wohler's avatar
Bill Wohler committed
649
        (message "Making passwd aliases...")
Bill Wohler's avatar
Bill Wohler committed
650 651 652 653 654 655 656
        (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 ""))
Bill Wohler's avatar
Bill Wohler committed
657
        (message "Making passwd aliases...done")))
Bill Wohler's avatar
Bill Wohler committed
658 659 660 661
    (if (and (string-equal "" matches)
             (string-equal "" group-matches)
             (string-equal "" passwd-matches))
        (message "No matches")
Bill Wohler's avatar
Bill Wohler committed
662
      (with-output-to-temp-buffer mh-aliases-buffer
Bill Wohler's avatar
Bill Wohler committed
663 664 665 666 667 668 669 670 671
        (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))))))

Bill Wohler's avatar
Bill Wohler committed
672 673 674 675 676 677 678 679 680 681 682 683 684 685 686
(defun mh-folder-line-matches-show-buffer-p ()
  "Return t if the message under point in folder-mode is in the show buffer.
Return nil in any other circumstance (no message under point, no
show buffer, the message in the show buffer doesn't match."
  (and (eq major-mode 'mh-folder-mode)
       (mh-get-msg-num nil)
       mh-show-buffer
       (get-buffer mh-show-buffer)
       (buffer-file-name (get-buffer mh-show-buffer))
       (string-match ".*/\\([0-9]+\\)$"
                     (buffer-file-name (get-buffer mh-show-buffer)))
       (string-equal
        (match-string 1 (buffer-file-name (get-buffer mh-show-buffer)))
        (int-to-string (mh-get-msg-num nil)))))

Bill Wohler's avatar
Bill Wohler committed
687 688
(provide 'mh-alias)

Bill Wohler's avatar
Bill Wohler committed
689 690 691 692
;; Local Variables:
;; indent-tabs-mode: nil
;; sentence-end-double-space: nil
;; End:
Bill Wohler's avatar
Bill Wohler committed
693

Bill Wohler's avatar
Bill Wohler committed
694
;; arch-tag: 49879e46-5aa3-4569-bece-e5a58731d690
Bill Wohler's avatar
Bill Wohler committed
695
;;; mh-alias.el ends here