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