comparison lisp/mh-e/mh-alias.el @ 50702:7dd3d5eae9c7

Upgraded to MH-E version 7.3. See etc/MH-E-NEWS and lisp/mh-e/ChangeLog for details.

50701:cb5f0a5d5b36

;;; mh-alias.el --- MH-E mail alias completion and expansion
;;
;; Copyright (C) 1994, 1995, 1996, 1997, 2001, 2002 Free Software Foundation, Inc.

;; Author: Peter S. Galbraith <[e-mail]>
;; Maintainer: Bill Wohler <[e-mail]>
;; Keywords: mail
;; See: mh-e.el

;;  `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.2 2003/02/03 20:55:30 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")

(defvar mh-alias-alist nil
  "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.")

       ((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)

        (setq local-users (cdr local-users)))))
  (message "Loading MH aliases...done"))

(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.
      (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."
  (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))))

(defun mh-alias-expand (alias)
  "Return expansion for ALIAS.
Blind aliases or users from /etc/passwd are not expanded."
  (cond

  (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)
                   ","))))))
      (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 ")))))

          (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)
  (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

;;; Adding addresses to alias file.

(defun mh-alias-suggest-alias (string)
  "Suggest an alias for STRING."
  (cond
   ((string-match "^\\sw+$" string)
    ;; One word -> downcase it.
    (downcase string))
   ((string-match "^\\(\\sw+\\)\\s-+\\(\\sw+\\)$" string)
    ;; Two words -> first.last

    ;; Reverse order of comma-separated fields
    (mh-alias-suggest-alias
     (format "%s %s" (match-string 2 string) (match-string 1 string))))
   (t
    ;; Output string, with spaces replaced by dots.
    (downcase (replace-regexp-in-string
               "\\.\\.+" "."
               (replace-regexp-in-string " +" "." 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))

          (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) ":"))
              (setq found (car file-list)
                    the-list nil)
            (setq the-list (cdr the-list)))))
      found)))

                             alias))))
                      (split-string aliases ", +")))))))

;;;###mh-autoload
(defun mh-alias-from-has-no-alias-p ()
  "Return t is From has no current alias set."
  (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))))))

(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

  (save-excursion
    (set-buffer (find-file-noselect file))
    (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)

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."
  (interactive "P\nP")
  (mh-alias-reload-maybe)
  (setq alias (completing-read "Alias: " mh-alias-alist nil nil alias))
  (setq address (read-string "Address: " 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

           (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 (mh-extract-from-header-value))
           (alias (mh-alias-suggest-alias address)))
      (mh-alias-add-alias alias address))))

;;;###mh-autoload
(defun mh-alias-add-address-under-point ()

50702:7dd3d5eae9c7

;;; mh-alias.el --- MH-E mail alias completion and expansion
;;
;; Copyright (C) 1994, 95, 96, 1997,
;;  2001, 02, 2003 Free Software Foundation, Inc.

;; Author: Peter S. Galbraith <[e-mail]>
;; Maintainer: Bill Wohler <[e-mail]>
;; Keywords: mail
;; See: mh-e.el

;;  `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:

;;; Code:

(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.")

       ((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)

        (setq local-users (cdr local-users)))))
  (message "Loading MH aliases...done"))

(defun mh-alias-reload-maybe ()
  "Load new MH aliases."
  (if (or (eq mh-alias-alist 'not-read) ; Doesn't exist, so create it.
          (mh-alias-tstamp nil))        ; Out of date, so recreate it.
      (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

  (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 ")))))

          (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 ((mail-abbrevs mh-alias-alist))
    (mh-funcall-if-exists mail-abbrev-complete-alias))
  (when mh-alias-expand-aliases-flag
    (let* ((end (point))
           (syntax-table (syntax-table))
           (beg (unwind-protect
                    (save-excursion

;;; Adding addresses to alias file.

(defun mh-alias-suggest-alias (string)
  "Suggest an alias for STRING."
  (cond
   ((string-match "^<\\(.*\\)>$" string)
    ;; <[e-mail]>  -> recurse, stripping brackets.
    (mh-alias-suggest-alias (match-string 1 string)))
   ((string-match "^\\sw+$" string)
    ;; One word -> downcase it.
    (downcase string))
   ((string-match "^\\(\\sw+\\)\\s-+\\(\\sw+\\)$" string)
    ;; Two words -> first.last

    ;; Reverse order of comma-separated fields
    (mh-alias-suggest-alias
     (format "%s %s" (match-string 2 string) (match-string 1 string))))
   (t
    ;; Output string, with spaces replaced by dots.
    (mh-alias-canonicalize-suggestion string))))

(defun mh-alias-canonicalize-suggestion (string)
  "Process STRING to replace spacess by periods.
First all spaces 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))
    (replace-regexp " +" ".")
    ;; Replace consecutive periods with a single period
    (goto-char (point-min))
    (replace-regexp "\\.\\.+" ".")
    ;; 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))

          (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)))

                             alias))))
                      (split-string aliases ", +")))))))

;;;###mh-autoload
(defun mh-alias-from-has-no-alias-p ()
  "Return t is From has no current alias set.
In the exceptional situation where there isn't a From header in the message the
function returns nil."
  (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
             (not (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

  (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)

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."
  (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

           (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 ()