Auto-addtion of new aliases

Auto-addtion of new aliases

[Erik Selberg]

I just put together my previous additions for integrating MH aliases
along with a quick routine I wrote which allows the user to add new
aliases to the approprite alias file on the fly. This function is
similar to define-mail-abbrev, which creates a new alias, but goes
beyond define-mail-abbrev's functionality by actually saving the alias
to the appropriate file (MH or .mailrc) so you can use the alias again
without editing the various files.

Function: message-add-mail-alias
Interactively creates a new alias, using the default from the "To" header if
possible. It then saves that alias to the appropriate alias file.

Lars --- if you like, you're more than welcome to incorporate this
file into Gnus, either as a patch to message.el or as a separate file.

;;; message-add-alias.el --- alias addition for Gnus 5.2.x message system
;;; Author: Erik Selberg <selberg@cs.washington.edu>
;;; Created: 6/15/96
;;; Today's Score: 89-78 Sonics def Bulls!

;;; Commentary:

;; This file provides two useful features to the message system of Gnus 5.2.x:
;;   + Allows incorporation of (some) MH aliases 
;;   + Allows interactive adding of new aliases
;;
;; The variable message-use-mh-aliases, if non-nil, will incorporate all
;; MH aliases so that the Gnus message package will use them. Currently,
;; this is in exclusion of anything in .mailrc.
;;
;; The function message-add-mail-alias askes the user to define a new alias, 
;; ala define-mail-abbrev, and then saves the alias into the user's alias file
;; (either their MH file or their .mailrc, as specified by the above variable)
;;

;;; Use:

;; (require 'message-add-alias)

;;; Notes:

;; This file may be incorporated by Lars or anyone into message.el or other appropriate file.

(require 'e-mh-alias)
(require 'mh-utils)
(if (string-match "XEmacs\\|Lucid" emacs-version)
    (require 'mail-abbrevs)
  (require 'mailabbrev))

(defvar message-use-mh-aliases nil
  "If non-nil, use mh-aliases (as specified in .mhprofile) file
instead of .mailrc for mail aliases. Requires e-mh-alias.el")

; (setq message-use-mh-aliases t)

(defun message-add-alias-setup ()
  (add-hook 'mh-find-path-hook (lambda () (setq e-mh-aliasfile (mh-get-profile-field "Aliasfile:"))))
  (mh-find-path)

  (if message-use-mh-aliases 
      (progn
	(setq e-mh-alias-local-users nil)
	
	(e-mh-learn-aliases) ;; sets e-mh-alias-lowercase-alist
	(mapcar (lambda (x) (define-mail-abbrev (car x) (cdr x)))
		(mapcar
		 (lambda (y)
		   (cons (car y)
			 (mapconcat 
			  (function (lambda (x) (format "%s" x)))
			  (cdr y) ",\n "
			  )))
		 e-mh-alias-lowercase-alist))
	))
  )


(defun message-save-mh-alias (name def &optional file)
  (write-region (format "%s:\t%s\n" name def) nil (or file (concat mh-user-path e-mh-aliasfile)) t 'dontprintme)
)

(defun message-save-mail-alias (name def &optional file)
 (write-region (format "alias %s\t%s\n" name def) nil (or file mail-personal-alias-file) t 'dontprintme)
)


(defun message-add-mail-alias (name def)
  (interactive (let* ((def-name (read-string "Define mail alias: "))
		      (default-def (message-fetch-field "To") )
		      (new-def (read-string
				 (format "Define %s as: "  def-name) default-def))
		      )
		 (list def-name
		       (if (equal "" new-def)
			   default-def
		    new-def
		    ))
		))
  (if message-use-mh-aliases
      (message-save-mh-alias name def)
    (message-save-mail-alias name def)
    )
  (define-mail-abbrev name def)
)

(message-add-alias-setup)
(provide 'message-add-alias)