;;; mh-alias.el --- MH-E mail alias completion and expansion
-;;
-;; Copyright (C) 1994, 1995, 1996, 1997, 2001, 2002 Free Software Foundation, Inc.
-
+
+;; Copyright (C) 1994, 1995, 1996, 1997,
+;; 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
+
;; Author: Peter S. Galbraith <psg@debian.org>
;; Maintainer: Bill Wohler <wohler@newt.com>
;; Keywords: mail
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
-;; [To be deleted when documented in MH-E manual.]
-;;
-;; This module provides mail alias completion when entering addresses.
-;;
-;; Use the TAB key to complete aliases (and optionally local usernames) when
-;; initially composing a message in the To: and Cc: minibuffer prompts. You
-;; may enter multiple addressees separated with a comma (but do *not* add any
-;; space after the comma).
-;;
-;; In the header of a message draft, use "M-TAB (mh-letter-complete)" to
-;; complete aliases. This is useful when you want to add an addressee as an
-;; afterthought when creating a message, or when adding an additional
-;; addressee to a reply.
-;;
-;; By default, completion is case-insensitive. This can be changed by
-;; customizing the variable `mh-alias-completion-ignore-case-flag'. This is
-;; useful, for example, to differentiate between people aliases in lowercase
-;; such as:
-;;
-;; p.galbraith: Peter Galbraith <GalbraithP@dfo-mpo.gc.ca>
-;;
-;; and lists in uppercase such as:
-;;
-;; MH-E: MH-E mailing list <mh-e-devel@lists.sourceforge.net>
-;;
-;; Note that this variable affects minibuffer completion only. If you have an
-;; alias for P.Galbraith and type in p.galbraith at the prompt, it will still
-;; be expanded in the letter buffer because MH is case-insensitive.
-;;
-;; When you press ", (mh-alias-minibuffer-confirm-address)" after an alias in
-;; the minibuffer, the expansion for the previous mail alias appears briefly.
-;; To inhibit this, customize the variable `mh-alias-flash-on-comma'.
-;;
-;; The addresses and aliases entered in the minibuffer are added to the
-;; message draft. To expand the aliases before they are added to the draft,
-;; customize the variable `mh-alias-expand-aliases-flag'.
-;;
-;; Completion is also performed on usernames extracted from the /etc/passwd
-;; file. This can be a handy tool on a machine where you and co-workers
-;; exchange messages, but should probably be disabled on a system with
-;; thousands of users you don't know. This is done by customizing the
-;; variable `mh-alias-local-users'. This variable also takes a string which
-;; is executed to generate the password file. For example, you'd use "ypcat
-;; passwd" for NIS.
-;;
-;; Aliases are loaded the first time you send mail and get the "To:" prompt
-;; and whenever a source of aliases changes. Sources of system aliases are
-;; defined in the customization variable `mh-alias-system-aliases' and
-;; include:
-;;
-;; /etc/nmh/MailAliases
-;; /usr/lib/mh/MailAliases
-;; /etc/passwd
-;;
-;; Sources of personal aliases are read from the files listed in your MH
-;; profile component Aliasfile. Multiple files are separated by white space
-;; and are relative to your mail directory.
-;;
-;; Alias Insertions
-;; ~~~~~~~~~~~~~~~~
-;; There are commands to insert new aliases into your alias file(s) (defined
-;; by the `Aliasfile' component in the .mh_profile file or by the variable
-;; `mh-alias-insert-file'). In particular, there is a tool-bar icon to grab
-;; an alias from the From line of the current message.
-
;;; Change Log:
-;; $Id: mh-alias.el,v 1.25 2003/01/27 04:16:47 wohler Exp $
-
;;; Code:
(require 'mh-e)
-(load "cmr" t t) ; Non-fatal dependency for
- ; completing-read-multiple.
-(eval-when-compile (defvar mail-abbrev-syntax-table))
-;;; Autoloads
-(autoload 'mail-abbrev-complete-alias "mailabbrev")
-(autoload 'multi-prompt "multi-prompt")
+(mh-require-cl)
-(defvar mh-alias-alist nil
+(require 'goto-addr)
+
+(defvar mh-alias-alist 'not-read
"Alist of MH aliases.")
(defvar mh-alias-blind-alist nil
"Alist of MH aliases that are blind lists.")
(defvar mh-alias-tstamp nil
"Time aliases were last loaded.")
(defvar mh-alias-read-address-map nil)
-(if mh-alias-read-address-map
- ()
+(unless mh-alias-read-address-map
(setq mh-alias-read-address-map
- (copy-keymap minibuffer-local-completion-map))
- (if mh-alias-flash-on-comma
- (define-key mh-alias-read-address-map
- "," 'mh-alias-minibuffer-confirm-address))
+ (copy-keymap minibuffer-local-completion-map))
+ (define-key mh-alias-read-address-map
+ "," 'mh-alias-minibuffer-confirm-address)
(define-key mh-alias-read-address-map " " 'self-insert-command))
+(defvar mh-alias-system-aliases
+ '("/etc/nmh/MailAliases" "/etc/mh/MailAliases"
+ "/usr/lib/mh/MailAliases" "/usr/share/mailutils/mh/MailAliases"
+ "/etc/passwd")
+ "*A list of system files which are a source of aliases.
+If these files are modified, they are automatically reread. This list
+need include only system aliases and the passwd file, since personal
+alias files listed in your \"Aliasfile:\" MH profile component are
+automatically included. You can update the alias list manually using
+\\[mh-alias-reload].")
+
\f
+
;;; Alias Loading
(defun mh-alias-tstamp (arg)
"Check whether alias files have been modified.
-Return t if any file listed in the MH profile component Aliasfile has been
-modified since the timestamp.
+Return t if any file listed in the Aliasfile MH profile component has
+been modified since the timestamp.
If ARG is non-nil, set timestamp with the current time."
(if arg
(let ((time (current-time)))
(defun mh-alias-filenames (arg)
"Return list of filenames that contain aliases.
-The filenames come from the MH profile component Aliasfile and are expanded.
-If ARG is non-nil, filenames listed in `mh-alias-system-aliases' are appended."
+The filenames come from the Aliasfile profile component and are
+expanded.
+If ARG is non-nil, filenames listed in `mh-alias-system-aliases' are
+appended."
(or mh-progs (mh-find-path))
(save-excursion
(let* ((filename (mh-profile-component "Aliasfile"))
(append userlist mh-alias-system-aliases))
userlist))))
+(defun mh-alias-gecos-name (gecos-name username comma-separator)
+ "Return a usable address string from a GECOS-NAME and USERNAME.
+Use only part of the GECOS-NAME up to the first comma if
+COMMA-SEPARATOR is non-nil."
+ (let ((res gecos-name))
+ ;; Keep only string until first comma if COMMA-SEPARATOR is t.
+ (if (and comma-separator
+ (string-match "^\\([^,]+\\)," res))
+ (setq res (match-string 1 res)))
+ ;; Replace "&" with capitalized username
+ (if (string-match "&" res)
+ (setq res (mh-replace-regexp-in-string "&" (capitalize username) res)))
+ ;; Remove " character
+ (if (string-match "\"" res)
+ (setq res (mh-replace-regexp-in-string "\"" "" res)))
+ ;; If empty string, use username instead
+ (if (string-equal "" res)
+ (setq res username))
+ ;; Surround by quotes if doesn't consist of simple characters
+ (if (not (string-match "^[ a-zA-Z0-9-]+$" res))
+ (setq res (concat "\"" res "\"")))
+ res))
+
(defun mh-alias-local-users ()
- "Return an alist of local users from /etc/passwd."
+ "Return an alist of local users from /etc/passwd.
+Exclude all aliases already in `mh-alias-alist' from \"ali\""
(let (passwd-alist)
(save-excursion
(set-buffer (get-buffer-create mh-temp-buffer))
(insert-file-contents "/etc/passwd")))
((stringp mh-alias-local-users)
(insert mh-alias-local-users "\n")
- (shell-command-on-region (point-min)(point-max) mh-alias-local-users t)
+ (shell-command-on-region (point-min) (point-max) mh-alias-local-users t)
(goto-char (point-min))))
(while (< (point) (point-max))
(cond
- ((looking-at "\\([^:]*\\):[^:]*:\\([^:]*\\):[^:]*:\\([^:,]*\\)[:,]")
- (when (> (string-to-int (match-string 2)) 200)
+ ((looking-at "\\([^:]*\\):[^:]*:\\([^:]*\\):[^:]*:\\([^:]*\\):")
+ (when (> (string-to-number (match-string 2)) 200)
(let* ((username (match-string 1))
(gecos-name (match-string 3))
- (realname
- (if (string-match "&" gecos-name)
- (concat
- (substring gecos-name 0 (match-beginning 0))
- (capitalize username)
- (substring gecos-name (match-end 0)))
- gecos-name)))
- (setq passwd-alist
- (cons (list username
- (if (string-equal "" realname)
- (concat "<" username ">")
- (concat realname " <" username ">")))
- passwd-alist))))))
+ (realname (mh-alias-gecos-name
+ gecos-name username
+ mh-alias-passwd-gecos-comma-separator-flag))
+ (alias-name (if mh-alias-local-users-prefix
+ (concat mh-alias-local-users-prefix
+ (mh-alias-suggest-alias realname t))
+ username))
+ (alias-translation
+ (if (string-equal username realname)
+ (concat "<" username ">")
+ (concat realname " <" username ">"))))
+ (when (not (mh-assoc-string alias-name mh-alias-alist t))
+ (setq passwd-alist (cons (list alias-name alias-translation)
+ passwd-alist)))))))
(forward-line 1)))
passwd-alist))
-;;;###mh-autoload
(defun mh-alias-reload ()
- "Load MH aliases into `mh-alias-alist'."
+ "Reload MH aliases.
+
+Since aliases are updated frequently, MH-E reloads aliases
+automatically whenever an alias lookup occurs if an alias source has
+changed. Sources include files listed in your \"Aliasfile:\" profile
+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.
+
+This function runs `mh-alias-reloaded-hook' after the aliases have
+been loaded."
(interactive)
(save-excursion
(message "Loading MH aliases...")
(cond
((looking-at "^[ \t]")) ;Continuation line
((looking-at "\\(.+\\): .+: .*$") ; A new -blind- MH alias
- (when (not (assoc-ignore-case (match-string 1) mh-alias-blind-alist))
+ (when (not (mh-assoc-string (match-string 1) mh-alias-blind-alist t))
(setq mh-alias-blind-alist
(cons (list (match-string 1)) mh-alias-blind-alist))
(setq mh-alias-alist (cons (list (match-string 1)) mh-alias-alist))))
((looking-at "\\(.+\\): .*$") ; A new MH alias
- (when (not (assoc-ignore-case (match-string 1) mh-alias-alist))
+ (when (not (mh-assoc-string (match-string 1) mh-alias-alist t))
(setq mh-alias-alist
(cons (list (match-string 1)) mh-alias-alist)))))
(forward-line 1)))
user)
(while local-users
(setq user (car local-users))
- (if (not (assoc-ignore-case (car user) mh-alias-alist))
+ (if (not (mh-assoc-string (car user) mh-alias-alist t))
(setq mh-alias-alist (append mh-alias-alist (list user))))
(setq local-users (cdr local-users)))))
+ (run-hooks 'mh-alias-reloaded-hook)
(message "Loading MH aliases...done"))
+;;;###mh-autoload
(defun mh-alias-reload-maybe ()
"Load new MH aliases."
- (if (or (not mh-alias-alist) ; Doesn't exist, so create it.
- (mh-alias-tstamp nil)) ; Out of date, so recreate it.
+ (if (or (eq mh-alias-alist 'not-read) ; Doesn't exist?
+ (mh-alias-tstamp nil)) ; Out of date?
(mh-alias-reload)))
\f
+
;;; Alias Expansion
(defun mh-alias-ali (alias &optional user)
"Return ali expansion for ALIAS.
ALIAS must be a string for a single alias.
-If USER is t, then assume ALIAS is an address and call ali -user.
-ali returns the string unchanged if not defined. The same is done here."
- (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))))
+If USER is t, then assume ALIAS is an address and call ali -user. ali
+returns the string unchanged if not defined. The same is done here."
+ (condition-case err
+ (save-excursion
+ (let ((user-arg (if user "-user" "-nouser")))
+ (mh-exec-cmd-quiet t "ali" user-arg "-nolist" alias))
+ (goto-char (point-max))
+ (if (looking-at "^$") (delete-backward-char 1))
+ (buffer-substring (point-min)(point-max)))
+ (error (progn
+ (message "%s" (error-message-string err))
+ alias))))
(defun mh-alias-expand (alias)
"Return expansion for ALIAS.
Blind aliases or users from /etc/passwd are not expanded."
(cond
- ((assoc-ignore-case alias mh-alias-blind-alist)
+ ((mh-assoc-string alias mh-alias-blind-alist t)
alias) ; Don't expand a blind alias
- ((assoc-ignore-case alias mh-alias-passwd-alist)
- (cadr (assoc-ignore-case alias mh-alias-passwd-alist)))
+ ((mh-assoc-string alias mh-alias-passwd-alist t)
+ (cadr (mh-assoc-string alias mh-alias-passwd-alist t)))
(t
(mh-alias-ali alias))))
+(mh-require 'crm nil t) ; completing-read-multiple
+(mh-require 'multi-prompt nil t)
+
;;;###mh-autoload
(defun mh-read-address (prompt)
"Read an address from the minibuffer with PROMPT."
(mh-alias-reload-maybe)
- (if (not mh-alias-alist) ; If still no aliases, just prompt
+ (if (not mh-alias-alist) ; If still no aliases, just prompt
(read-string prompt)
(let* ((minibuffer-local-completion-map mh-alias-read-address-map)
(completion-ignore-case mh-alias-completion-ignore-case-flag)
(the-answer
- (or (cond
- ((fboundp 'completing-read-multiple)
- (completing-read-multiple prompt mh-alias-alist nil nil))
- ((featurep 'multi-prompt)
- (multi-prompt "," nil prompt mh-alias-alist nil nil))
- (t
- (split-string
- (completing-read prompt mh-alias-alist nil nil)
- ","))))))
+ (cond ((fboundp 'completing-read-multiple)
+ (mh-funcall-if-exists
+ completing-read-multiple prompt mh-alias-alist nil nil))
+ ((featurep 'multi-prompt)
+ (mh-funcall-if-exists
+ multi-prompt "," nil prompt mh-alias-alist nil nil))
+ (t (split-string
+ (completing-read prompt mh-alias-alist nil nil) ",")))))
(if (not mh-alias-expand-aliases-flag)
(mapconcat 'identity the-answer ", ")
;; Loop over all elements, checking if in passwd aliast or blind first
(defun mh-alias-minibuffer-confirm-address ()
"Display the alias expansion if `mh-alias-flash-on-comma' is non-nil."
(interactive)
- (if (not mh-alias-flash-on-comma)
- ()
+ (when mh-alias-flash-on-comma
(save-excursion
(let* ((case-fold-search t)
- (the-name (buffer-substring
- (progn (skip-chars-backward " \t")(point))
- ;; This moves over to previous comma, if any
- (progn (or (and (not (= 0 (skip-chars-backward "^,")))
- ;; the skips over leading whitespace
- (skip-chars-forward " "))
- ;; no comma, then to beginning of word
- (skip-chars-backward "^ \t"))
- ;; In Emacs21, the beginning of the prompt
- ;; line is accessible, which wasn't the case
- ;; in emacs20. Skip over it.
- (if (looking-at "^[^ \t]+:")
- (skip-chars-forward "^ \t"))
- (skip-chars-forward " ")
- (point)))))
- (if (assoc-ignore-case the-name mh-alias-alist)
+ (beg (mh-beginning-of-word))
+ (the-name (buffer-substring-no-properties beg (point))))
+ (if (mh-assoc-string the-name mh-alias-alist t)
(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)
(defun mh-alias-letter-expand-alias ()
"Expand mail alias before point."
(mh-alias-reload-maybe)
- (let ((mail-abbrevs mh-alias-alist))
- (mail-abbrev-complete-alias))
- (when mh-alias-expand-aliases-flag
- (let* ((end (point))
- (syntax-table (syntax-table))
- (beg (unwind-protect
- (save-excursion
- (set-syntax-table mail-abbrev-syntax-table)
- (backward-word 1)
- (point))
- (set-syntax-table syntax-table)))
- (alias (buffer-substring beg end))
- (expansion (mh-alias-expand alias)))
- (delete-region beg end)
- (insert expansion))))
+ (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)))))
+
\f
-;;; Adding addresses to alias file.
-(defun mh-alias-suggest-alias (string)
- "Suggest an alias for STRING."
+;;; Alias File Updating
+
+(defun mh-alias-suggest-alias (string &optional no-comma-swap)
+ "Suggest an alias for STRING.
+Don't reverse the order of strings separated by a comma if
+NO-COMMA-SWAP is non-nil."
(cond
+ ((string-match "^<\\(.*\\)>$" string)
+ ;; <somename@foo.bar> -> recurse, stripping brackets.
+ (mh-alias-suggest-alias (match-string 1 string) no-comma-swap))
((string-match "^\\sw+$" string)
;; One word -> downcase it.
(downcase string))
(downcase (match-string 1 string)))
((string-match "^\"\\(.*\\)\".*" string)
;; "Some name" <somename@foo.bar> -> recurse -> "Some name"
- (mh-alias-suggest-alias (match-string 1 string)))
+ (mh-alias-suggest-alias (match-string 1 string) no-comma-swap))
((string-match "^\\(.*\\) +<.*>$" string)
;; Some name <somename@foo.bar> -> recurse -> Some name
- (mh-alias-suggest-alias (match-string 1 string)))
- ((string-match (concat mh-address-mail-regexp " +(\\(.*\\))$") string)
+ (mh-alias-suggest-alias (match-string 1 string) no-comma-swap))
+ ((string-match (concat goto-address-mail-regexp " +(\\(.*\\))$") string)
;; somename@foo.bar (Some name) -> recurse -> Some name
- (mh-alias-suggest-alias (match-string 1 string)))
+ (mh-alias-suggest-alias (match-string 1 string) no-comma-swap))
((string-match "^\\(Dr\\|Prof\\)\\.? +\\(.*\\)" string)
;; Strip out title
- (mh-alias-suggest-alias (match-string 2 string)))
+ (mh-alias-suggest-alias (match-string 2 string) no-comma-swap))
((string-match "^\\(.*\\), +\\(Jr\\.?\\|II+\\)$" string)
;; Strip out tails with comma
- (mh-alias-suggest-alias (match-string 1 string)))
+ (mh-alias-suggest-alias (match-string 1 string) no-comma-swap))
((string-match "^\\(.*\\) +\\(Jr\\.?\\|II+\\)$" string)
;; Strip out tails
- (mh-alias-suggest-alias (match-string 1 string)))
+ (mh-alias-suggest-alias (match-string 1 string) no-comma-swap))
((string-match "^\\(\\sw+\\) +[A-Z]\\.? +\\(.*\\)$" string)
;; Strip out initials
(mh-alias-suggest-alias
- (format "%s %s" (match-string 1 string) (match-string 2 string))))
- ((string-match "^\\([^,]+\\), +\\(.*\\)$" string)
- ;; Reverse order of comma-separated fields
+ (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.
(mh-alias-suggest-alias
- (format "%s %s" (match-string 2 string) (match-string 1 string))))
+ (format "%s %s" (match-string 2 string) (match-string 1 string))
+ no-comma-swap))
(t
;; Output string, with spaces replaced by dots.
- (downcase (replace-regexp-in-string
- "\\.\\.+" "."
- (replace-regexp-in-string " +" "." string))))))
+ (mh-alias-canonicalize-suggestion string))))
+
+(defun mh-alias-canonicalize-suggestion (string)
+ "Process STRING to replace spaces by periods.
+First all spaces and commas are replaced by periods. Then every run of
+consecutive periods are replaced with a single period. Finally the
+string is converted to lower case."
+ (with-temp-buffer
+ (insert string)
+ ;; Replace spaces with periods
+ (goto-char (point-min))
+ (while (re-search-forward " +" nil t)
+ (replace-match "." nil nil))
+ ;; Replace commas with periods
+ (goto-char (point-min))
+ (while (re-search-forward ",+" nil t)
+ (replace-match "." nil nil))
+ ;; Replace consecutive periods with a single period
+ (goto-char (point-min))
+ (while (re-search-forward "\\.\\.+" nil t)
+ (replace-match "." nil nil))
+ ;; Convert to lower case
+ (downcase-region (point-min) (point-max))
+ ;; Whew! all done...
+ (buffer-string)))
(defun mh-alias-which-file-has-alias (alias file-list)
"Return the name of writable file which defines ALIAS from list FILE-LIST."
(erase-buffer)
(when (file-writable-p (car file-list))
(insert-file-contents (car file-list))
- (if (re-search-forward (concat "^" (regexp-quote alias) ":"))
+ (if (re-search-forward (concat "^" (regexp-quote alias) ":") nil t)
(setq found (car file-list)
the-list nil)
(setq the-list (cdr the-list)))))
found)))
(defun mh-alias-insert-file (&optional alias)
- "Return the alias file to write a new entry for ALIAS in.
-Use variable `mh-alias-insert-file' if non-nil, else use AliasFile component
-value.
-If ALIAS is specified and it already exists, try to return the file that
+ "Return filename which should be used to add ALIAS.
+The value of the option `mh-alias-insert-file' is used if non-nil\;
+otherwise the value of the \"Aliasfile:\" profile component is used.
+If the alias already exists, try to return the name of the file that
contains it."
(cond
((and mh-alias-insert-file (listp mh-alias-insert-file))
(car mh-alias-insert-file)
(if (or (not alias)
(string-equal alias (mh-alias-ali alias))) ;alias doesn't exist
- (completing-read "Alias file [press Tab]: "
+ (completing-read "Alias file: "
(mapcar 'list mh-alias-insert-file) nil t)
(or (mh-alias-which-file-has-alias alias mh-alias-insert-file)
- (completing-read "Alias file [press Tab]: "
+ (completing-read "Alias file: "
(mapcar 'list mh-alias-insert-file) nil t)))))
((and mh-alias-insert-file (stringp mh-alias-insert-file))
mh-alias-insert-file)
(mh-alias-filenames t)))))
(cond
((not autolist)
- (error "No writable alias file.
-Set `mh-alias-insert-file' or set AliasFile in your .mh_profile file"))
+ (error "No writable alias file;
+set `mh-alias-insert-file' or the \"Aliasfile:\" profile component"))
((not (elt autolist 1)) ; Only one entry, use it
(car autolist))
((or (not alias)
(string-equal alias (mh-alias-ali alias))) ;alias doesn't exist
- (completing-read "Alias file [press Tab]: "
- (mapcar 'list autolist) nil t))
+ (completing-read "Alias file: " (mapcar 'list autolist) nil t))
(t
(or (mh-alias-which-file-has-alias alias autolist)
- (completing-read "Alias file [press Tab]: "
+ (completing-read "Alias file: "
(mapcar 'list autolist) nil t))))))))
;;;###mh-autoload
(split-string aliases ", +")))))))
;;;###mh-autoload
-(defun mh-alias-from-has-no-alias-p ()
- "Return t is From has no current alias set."
+(defun mh-alias-for-from-p ()
+ "Return t if sender's address has a corresponding alias."
(mh-alias-reload-maybe)
(save-excursion
(if (not (mh-folder-line-matches-show-buffer-p))
nil ;No corresponding show buffer
(if (eq major-mode 'mh-folder-mode)
(set-buffer mh-show-buffer))
- (not (mh-alias-address-to-alias (mh-extract-from-header-value))))))
+ (let ((from-header (mh-extract-from-header-value)))
+ (and from-header
+ (mh-alias-address-to-alias from-header))))))
(defun mh-alias-add-alias-to-file (alias address &optional file)
"Add ALIAS for ADDRESS in alias FILE without alias check or prompts.
-Prompt for alias file if not provided and there is more than one candidate.
-If ALIAS matches exactly, prompt to [i]nsert before old value or [a]ppend
-after it."
+Prompt for alias file if not provided and there is more than one
+candidate.
+
+If the alias exists already, you will have the choice of
+inserting the new alias before or after the old alias. In the
+former case, this alias will be used when sending mail to this
+alias. In the latter case, the alias serves as an additional
+folder name hint when filing messages."
(if (not file)
(setq file (mh-alias-insert-file alias)))
(save-excursion
(goto-char (point-min))
(let ((alias-search (concat alias ":"))
(letter)
- (here (point))
(case-fold-search t))
(cond
;; Search for exact match (if we had the same alias before)
((re-search-forward
(concat "^" (regexp-quote alias-search) " *\\(.*\\)") nil t)
(let ((answer (read-string
- (format "Exists for %s; [i]nsert, [a]ppend: "
+ (format (concat "Alias %s exists; insert new address "
+ "[b]efore or [a]fter: ")
(match-string 1))))
(case-fold-search t))
- (cond ((string-match "^i" answer))
+ (cond ((string-match "^b" answer))
((string-match "^a" answer)
(forward-line 1))
(t
- (error "Quitting")))))
+ (error "Unrecognized response")))))
;; No, so sort-in at the right place
;; search for "^alias", then "^alia", etc.
((eq mh-alias-insertion-location 'sorted)
(insert (format "%s: %s\n" alias address))
(save-buffer)))
-;;;###mh-autoload
(defun mh-alias-add-alias (alias address)
- "*Add ALIAS for ADDRESS in personal alias file.
-Prompts for confirmation if the address already has an alias.
-If the alias is already is use, `mh-alias-add-alias-to-file' will prompt."
+ "Add ALIAS for ADDRESS in personal alias file.
+
+This function prompts you for an alias and address. If the alias
+exists already, you will have the choice of inserting the new
+alias before or after the old alias. In the former case, this
+alias will be used when sending mail to this alias. In the latter
+case, the alias serves as an additional folder name hint when
+filing messages."
(interactive "P\nP")
(mh-alias-reload-maybe)
(setq alias (completing-read "Alias: " mh-alias-alist nil nil alias))
+ (if (and address (string-match "^<\\(.*\\)>$" address))
+ (setq address (match-string 1 address)))
(setq address (read-string "Address: " address))
+ (if (string-match "^<\\(.*\\)>$" address)
+ (setq address (match-string 1 address)))
(let ((address-alias (mh-alias-address-to-alias address))
(alias-address (mh-alias-expand alias)))
(if (string-equal alias-address alias)
(cond
((and (equal alias address-alias)
(equal address alias-address))
- (message "Already defined as: %s" alias-address))
+ (message "Already defined as %s" alias-address))
(address-alias
(if (y-or-n-p (format "Address has alias %s; set new one? "
address-alias))
;;;###mh-autoload
(defun mh-alias-grab-from-field ()
- "*Add ALIAS for ADDRESS in personal alias file.
-Prompts for confirmation if the alias is already in use or if the address
-already has an alias."
+ "Add alias for the sender of the current message."
(interactive)
(mh-alias-reload-maybe)
(save-excursion
(insert-file-contents (mh-msg-filename (mh-get-msg-num t))))
((eq major-mode 'mh-folder-mode)
(error "Cursor not pointing to a message")))
- (let* ((address (mh-extract-from-header-value))
+ (let* ((address (or (mh-extract-from-header-value)
+ (error "Message has no From: header")))
(alias (mh-alias-suggest-alias address)))
(mh-alias-add-alias alias address))))
-;;;###mh-autoload
(defun mh-alias-add-address-under-point ()
- "Insert an alias for email address under point."
+ "Insert an alias for address under point."
(interactive)
- (let ((address (mh-goto-address-find-address-at-point)))
+ (let ((address (goto-address-find-address-at-point)))
(if address
(mh-alias-add-alias nil address)
- (message "No email address found under point."))))
+ (message "No email address found under point"))))
+
+(defun mh-alias-apropos (regexp)
+ "Show all aliases or addresses that match a regular expression REGEXP."
+ (interactive "sAlias regexp: ")
+ (if mh-alias-local-users
+ (mh-alias-reload-maybe))
+ (let ((matches "")
+ (group-matches "")
+ (passwd-matches))
+ (save-excursion
+ (message "Reading MH aliases...")
+ (mh-exec-cmd-quiet t "ali" "-nolist" "-nouser")
+ (message "Parsing MH aliases...")
+ (while (re-search-forward regexp nil t)
+ (beginning-of-line)
+ (cond
+ ((looking-at "^[ \t]") ;Continuation line
+ (setq group-matches
+ (concat group-matches
+ (buffer-substring
+ (save-excursion
+ (or (re-search-backward "^[^ \t]" nil t)
+ (point)))
+ (progn
+ (if (re-search-forward "^[^ \t]" nil t)
+ (forward-char -1))
+ (point))))))
+ (t
+ (setq matches
+ (concat matches
+ (buffer-substring (point)(progn (end-of-line)(point)))
+ "\n")))))
+ (message "Parsing MH aliases...done")
+ (when mh-alias-local-users
+ (message "Making passwd aliases...")
+ (setq passwd-matches
+ (mapconcat
+ '(lambda (elem)
+ (if (or (string-match regexp (car elem))
+ (string-match regexp (cadr elem)))
+ (format "%s: %s\n" (car elem) (cadr elem))))
+ mh-alias-passwd-alist ""))
+ (message "Making passwd aliases...done")))
+ (if (and (string-equal "" matches)
+ (string-equal "" group-matches)
+ (string-equal "" passwd-matches))
+ (message "No matches")
+ (with-output-to-temp-buffer mh-aliases-buffer
+ (if (not (string-equal "" matches))
+ (princ matches))
+ (when (not (string-equal group-matches ""))
+ (princ "\nGroup Aliases:\n\n")
+ (princ group-matches))
+ (when (not (string-equal passwd-matches ""))
+ (princ "\nLocal User Aliases:\n\n")
+ (princ passwd-matches))))))
+
+(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)))))
(provide 'mh-alias)
-;;; Local Variables:
-;;; indent-tabs-mode: nil
-;;; sentence-end-double-space: nil
-;;; End:
+;; Local Variables:
+;; indent-tabs-mode: nil
+;; sentence-end-double-space: nil
+;; End:
+;; arch-tag: 49879e46-5aa3-4569-bece-e5a58731d690
;;; mh-alias.el ends here