; -*-Emacs-Lisp-*-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; File:         mh-alias.el
; RCS:          $Header: /users/darrylo/.repository/mh-e/mh-alias.el,v 1.3 1998/07/23 22:31:55 darrylo Exp $
; Description:  MH alias handling routines
; Author:       Darryl Okahata
; Created:      Tue Sep 24 18:01:15 1991
; Modified:     Thu Jul 23 13:11:06 1998 (Darryl Okahata) darrylo@sr.hp.com
; Language:     Emacs-Lisp
; Package:      N/A
; Status:       Experimental
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; This file provides optional MH alias expansion for mh-e.el.
;;
;; When you are prompted for one or more addresses, or when the cursor
;; is within a To:, Bcc:, or Cc: mail header, pressing TAB will cause
;; the alias just before the cursor to be expanded, if it exists and is
;; unique.  If the alias is not unique, all matching possibilities are
;; displayed in a pop-up buffer.  If there is no alias before the
;; cursor, all aliases are displayed.
;;
;; In order to have alias completion, you must have a set of valid MH
;; aliases, as the "ali" command is used to get a list of MH aliases.
;; By setting the variable `y-mh-read-aliases-from-passwd' to non-nil, all
;; usernames in the file given by `y-mh-etc-passwd-file' ("/etc/passwd" by
;; default) will be added to the list of aliases.  Note that this
;; requires a readable password file in order to work.
;;
;; Configuration variables:
;;
;;	y-mh-read-aliases-from-passwd
;;		If non-nil, merge usernames from the password file given
;;		by `y-mh-etc-passwd-file' into the list of MH aliases.
;;	y-mh-use-system-aliases
;;		If non-nil, read aliases from sendmail-style alias
;;		files.  The list of sendmail-style alias files is given
;;		by `y-mh-system-aliases-file-list'.  Note that merging
;;		system aliases can take a while.  On my moderately fast
;;		workstation, it takes just over a minute to rebuild the
;;		list of aliases (however, my site has about 3000
;;		aliases).
;;	y-mh-alias-fully-expand-aliases
;;		If non-nil, allows y-mh-expand-alias to replace a
;;		fully-specified and unambiguous alias by its expansion.
;;		If nil, aliases are expanded only up to the point of
;;		being fully-specified and unambiguous; the alias name is
;;		not replaced with its expansion.
;;	y-mh-etc-passwd-file
;;		The /etc/passwd file to use to read usernames.
;;	y-mh-system-aliases-file-list
;;		List of sendmail-style alias files to scan, if system
;;		aliases are used.  Some sites have multiple sendmail
;;		alias files, which is why this variable is a list.
;;	y-mh-ask-to-address
;;	y-mh-ask-cc-address
;;	y-mh-ask-subject
;;		If nil, suppress the asking of the corresponding header info,
;;		when composing, forwarding, or redistributing mail.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(require 'mh-e)			;; mh-e.el must be loaded before this one

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; User-settable variables (don't change them here -- change them in
;; your .emacs file):
;;

(defvar y-mh-read-aliases-from-passwd nil
  "*If non-nil, merge usernames from the password file given by
`y-mh-etc-passwd-file' into the list of MH aliases.")


(defvar y-mh-use-system-aliases nil
  "*If non-nil, read aliases from sendmail-style alias files.
The list of sendmail-style alias files is given by
`y-mh-system-aliases-file-list'.  Note that merging system aliases can
take a while.  On my moderately fast workstation, it takes just over a
minute to rebuild the list of aliases (however, my site has about 3000
aliases).")


(defvar y-mh-alias-fully-expand-aliases t
  "*If non-nil, allows y-mh-expand-alias to replace a fully-specified and
unambiguous alias by its expansion.  If nil, aliases are expanded only
up to the point of being fully-specified and unambiguous; the alias name
is not replaced with its expansion.")


(defvar y-mh-etc-passwd-file "/etc/passwd"
  "The /etc/passwd file to use to read usernames.")


(defvar y-mh-system-aliases-file-list '("/usr/lib/aliases")
  "List of sendmail-style alias files to scan, if system aliases are
used.  Some sites have multiple sendmail alias files, which is why this
variable is a list.")


(defvar y-mh-ask-to-address t
  "*If non-nil, ask the user for a To: address when composing or forwarding
a message.")


(defvar y-mh-ask-cc-address t
  "*If non-nil, ask the user for a Cc: address when composing or forwarding
a message.")


(defvar y-mh-ask-subject t
  "*If non-nil, ask the user for a Subject: when composing or forwarding
a message.")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; These variables are not intended for modification by the user.
;;

(defvar y-mh-aliases-list nil
  "List of known mh aliases.
Generated at run time from various sources (e.g., the MH `ali' command).")


(defvar y-mh-additional-aliases-list nil
  "List of additional aliases.
Intended to be used by other packages.")


(defvar y-mh-read-address-keymap
  (let ( (map (copy-keymap minibuffer-local-map)) )
    (define-key map "\t" 'y-mh-expand-alias)
    map
    )
  "Keymap to use when reading email addresses/aliases.  The default is to
use the existing minibuffer-local-map as a template.")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defun y-mh-read-etc-passwd (file)
  "Read usernames from the password file FILE.
The usernames are returned in a form suitable for completing-read.
If the file cannot be read, nil is returned; an error is not raised."
  (let (result (temp-buf " *y-mh-temp*") uname)
    (save-excursion
      (set-buffer (get-buffer-create temp-buf))
      (buffer-disable-undo (current-buffer))
      (erase-buffer)
      (condition-case err
	  (insert-file-contents (expand-file-name
				 (substitute-in-file-name file)))
	(error nil))	;; ignore errors
      (goto-char (point-min))
      (while (< (point) (point-max))
	(if (or (looking-at "^\\([^+:]+\\):")
		(looking-at "^[+]\\([^:\n]+\\)"))
	   (progn
	     (setq uname (buffer-substring (match-beginning 1)
					   (match-end 1)))
	     (setq result (cons (cons uname uname) result))
	     ))
	(forward-line 1)
	)
      )
    result
    ))


(defun y-mh-string-in-list (str list)
  "Check to see if string (STR) is in LIST."
  (let ()
    (catch 'exit
      (while list
	(if (string= (car str) (car (car list)))
	    (throw 'exit t))
	(setq list (cdr list))
	))
    ))


(defun y-mh-make-alias-list (&optional in-minibuffer list)
  "Return a list of the user's MH aliases.
Result is in a form suitable for completing read.
If `in-minibuffer is non-nil, the current buffer is the minibuffer, and
messages will be displayed using an alternative scheme, one which does not
interfere with the display of the minibuffer.."
  (interactive)
  (let ( (case-fold-search t)
	 original-contents origin alias expansion
	 )
    (unwind-protect
	(progn
	  (if in-minibuffer
	      (progn
		(setq origin (point)
		      original-contents (buffer-substring (point-min)
							  (point-max)))
		(erase-buffer)
		(insert " [ Collecting MH aliases ... ]")
		(sit-for 0)
		)
	    (message "Collecting MH aliases ..."))
	  (save-window-excursion
	    (mh-exec-cmd-quiet " *y-mh-temp*"
			       "ali" "-nolist" "-nonormalize" "-nouser")
	    (goto-char (point-min))
	    
	    (while (re-search-forward "^\\([-\\+a-z0-9_]+\\):\\s-+\\(.*\\)$" nil t)
	      (setq alias (buffer-substring (match-beginning 1) (match-end 1))
		    expansion (buffer-substring (match-beginning 2)
						(match-end 2)))
	      (if (not (assoc alias list))
		(progn
		  (forward-line 1)
		  (while (looking-at "\\s-")
		    (setq expansion (concat expansion
					    (buffer-substring (1- (point))
							      (progn
								(forward-line 1)
								(1- (point)))))))
		  (setq list (cons (cons alias expansion) list))))
	      )
	    list))
      (progn
	(if in-minibuffer
	    (progn
	      (erase-buffer)
	      (insert original-contents)
	      (goto-char origin)
	      )
	  (message "Collecting MH aliases ... done"))
	)
      )))


(defun y-mh-make-passwd-alias-list (&optional in-minibuffer list)
  "Return a list of aliases, obtained from the passwd file.
The passwd file to examine is specified by `y-mh-etc-passwd-file'
variable."
  (interactive)
  (let (plist minibuf origin original-contents)
    (unwind-protect
	(progn
	  (if in-minibuffer
	      (progn
		(setq minibuf (current-buffer)
		      origin (point)
		      original-contents (buffer-substring (point-min)
							  (point-max)))
		(erase-buffer)
		(insert " [ Collecting passwd aliases ... ]")
		(sit-for 0)
		)
	    (message "Collecting passwd aliases ... "))
	  (setq plist (y-mh-read-etc-passwd y-mh-etc-passwd-file))
	  (while plist
	    (if (not (assoc (car (car plist)) list))
		(setq list (cons (car plist) list)))
	    (setq plist (cdr plist))
	    )
	  )
      (progn
	(if (and in-minibuffer minibuf original-contents)
	    (progn
	      (set-buffer minibuf)
	      (erase-buffer)
	      (insert original-contents)
	      (goto-char origin)
	      )	
	  (message "Collecting passwd aliases ... done"))
	))
    list
    ))


(defun y-mh-make-system-alias-list (&optional in-minibuffer list)
  "Return an alist of the system-wide aliases, similar to the above function."
  (interactive)
  (let ( (file-list y-mh-system-aliases-file-list)
	 alias aliases origin expansion minibuf original-contents
	 )
    (unwind-protect
	(progn
	  (save-window-excursion
	    (if in-minibuffer
		(progn
		  (setq minibuf (current-buffer)
			origin (point)
			original-contents (buffer-substring (point-min)
							    (point-max)))
		  (erase-buffer)
		  (insert " [ Collecting system aliases (this can take a while) ... ]")
		  (sit-for 0)
		  )
	      (message "Collecting system aliases (this can take a while) ... ")
	      )
	    (buffer-disable-undo (set-buffer
				  (setq aliases
					(get-buffer-create "*system-aliases"))))
	    (erase-buffer)
	    (goto-char (point-min))
	    (while file-list
	      (if (file-exists-p (car file-list))
		  (progn
		    (insert-file-contents (expand-file-name
					   (substitute-in-file-name
					    (car file-list))))
		    (goto-char (point-max))
		    ))
	      (setq file-list (cdr file-list))
	      )
	    (goto-char (point-min))
	    (while (re-search-forward
		    "^\\([-_a-z0-9]+\\)\\s-*:\\s-*\\(.*\\)$" nil t)
	      (setq alias (buffer-substring (match-beginning 1) (match-end 1))
		    expansion (buffer-substring (match-beginning 2)
						(match-end 2)))
	      (forward-line 1)
	      (while (looking-at "[ \t]")
		(setq expansion (concat expansion
					(buffer-substring (1- (point))
							  (progn
							    (forward-line 1)
							    (1- (point)))))))
	      (setq list (cons (cons alias expansion) list))
	      )
	    (kill-buffer aliases)
	    list))
      (progn
	(if (and in-minibuffer minibuf original-contents)
	    (progn
	      (set-buffer minibuf)
	      (erase-buffer)
	      (insert original-contents)
	      (goto-char origin)
	      ))
	(message "Collecting system aliases (this can take a while) ... done")
	)
      )))


(defun y-mh-rebuild-aliases (in-minibuffer)
  "Rebuild the list of aliases to be used for completion."
  (interactive '(nil))
  (let (aliases)
    ;;
    ;; System aliases are created first, so that these aliases will end
    ;; up a the END of the list.  We want system aliases searched after
    ;; MH aliases.
    ;;
    (if y-mh-use-system-aliases
	(setq aliases (y-mh-make-system-alias-list in-minibuffer aliases)))
    ;;
    ;; By checking for passwd aliases here, we insure that passwd
    ;; aliases are added before MH aliases.  We want any MH aliases to
    ;; take precedence over any in the passwd file.
    ;;
    (if y-mh-read-aliases-from-passwd
	(setq aliases (y-mh-make-passwd-alias-list in-minibuffer aliases)))
    ;;
    ;; Now, merge in MH aliases.
    ;;
    (setq aliases (y-mh-make-alias-list in-minibuffer aliases))
    (setq y-mh-aliases-list aliases)
    ))


(defun y-mh-string< (a b)
  (let ()
    (setq a (downcase a)
	  b (downcase b))
    (string< a b)
    ))


(defun y-mh-pop-up-aliases (aliases)
  "Display to the user a list of aliases."
  (let (display-aliases)
    (save-excursion
      (if (not (stringp (car aliases)))
	  (while aliases
	    (setq display-aliases (cons (car (car aliases)) display-aliases))
	    (setq aliases (cdr aliases))
	    )
	(setq display-aliases (copy-sequence aliases)))
      (setq display-aliases (sort display-aliases 'y-mh-string<))
      (with-output-to-temp-buffer
	  " *Completions*"
	(display-completion-list display-aliases))
      )))


(defun y-mh-handle-letter-mode-key (key)
  (let ()
    (cond
     ( (or (eq key 'tab) (and (numberp key) (= key ?\t))) (tab-to-tab-stop) )
     ( t (insert key) )
     )))


(defun y-mh-insert-replacement (start stop abbrev alias-list)
  (let ( (replacement (cdr (assoc abbrev alias-list))) )
    (if (string= abbrev replacement)
	(progn
	  (goto-char stop)
	  (unwind-protect
	      (progn
		(insert " [ alias is unique ]")
		(ding)
		(sit-for 3)
		)
	    (delete-region origin (point)))
	  )
      (progn
	(delete-region start stop)
	(goto-char start)
	(if (not (or (= (preceding-char) ? )
		     (= (preceding-char) ?\t)
		     (bolp)))
	    (insert " "))
	(insert replacement)))
    ))


(defun y-mh-expand-alias (expand-exact)
  "Expand the alias before point.
In order for the alias to be expanded, point must be either in the minibuffer
or in the To: or Cc: mail headers.  Otherwise, the keypress used to invoke
this function is instead inserted into the buffer.

If the alias is not unique, all matching possibilities are displayed in
a pop-up buffer.  If there is no alias before point, all aliases are
displayed.

If the alias is unique, it is replaced with its expanded value if the
`y-mh-alias-fully-expand-aliases' variable is non-nil."
  (interactive "P")
  (let ( (origin (point))
	 (case-fold-search t)
	 abbrev aliases in-minibuffer)
    (if (string-match "^ [*]Minibuf-[0-9]" (buffer-name))
	(progn
	  (setq in-minibuffer t)
	  )
      (progn
	(beginning-of-line)
	(while (and (< (point-min) (point))
		    (looking-at "[ \t]")
		    )
	  (forward-line -1))
	))
    (cond
     ( (or in-minibuffer
	   (looking-at "To:\\|Cc:\\|Bcc:")
	   )
       (if (not y-mh-aliases-list)
	   (y-mh-rebuild-aliases in-minibuffer))
       (goto-char origin)
       (if (and (re-search-backward "\\(^\\)\\|\\([,: \t]\\)" nil t)
		(not (bolp)))
	   (forward-char 1))
       (if (or (and (looking-at "[ \t,:]*\\([-_a-z0-9]+\\)")
		    (not (bolp)))
	       in-minibuffer
	       (looking-at "[ \t,:\n]")
	       )
	   (let ( (start (match-beginning 1))
		  (stop (match-end 1))
		  (alias-list (append y-mh-additional-aliases-list
				      y-mh-aliases-list))
		  )
	     (if (and start stop (/= start stop) alias-list)
		 (progn
		   (if (and (> (point-max) stop)
			    (string= (buffer-substring stop (1+ stop))
				     "@"))
		       (progn
			 (end-of-line)
			 (setq origin (point))
			 (unwind-protect
			     (progn
			       (insert " [ alias is already expanded ]")
			       (ding)
			       (sit-for 3)
			       )
			   (delete-region origin (point)))
			 )
		     (progn
		       (setq abbrev (buffer-substring start stop))
		       (setq aliases (try-completion abbrev alias-list))
		       (cond ((eq aliases t) ; found a match: replace it!
			      (if (not y-mh-alias-fully-expand-aliases)
				  (goto-char stop)
				(y-mh-insert-replacement start stop abbrev
							 alias-list))
			      )
			     ((eq aliases nil) ; no such match: leave alone
			      (goto-char stop)
			      (unwind-protect
				  (progn
				    (insert " [No Match]")
				    (ding)
				    (sit-for 3)
				    )
				(delete-region origin (point)))
			      )
			     ((string= abbrev aliases)
			      (let ( (list (all-completions abbrev alias-list))
				     match )
				(goto-char stop)
				(if expand-exact
				    (progn
				      (setq match (member abbrev list))
				      (if match
					  (y-mh-insert-replacement start stop abbrev
								   alias-list))
				      )
				  (progn
				    (y-mh-pop-up-aliases list)
				    ))
				))
			     ((stringp aliases)
			      (delete-region start stop)
			      (goto-char start)
			      (if (not (or (= (preceding-char) ? )
					   (= (preceding-char) ?\t)
					   (bolp)))
				  (insert " "))
			      (insert aliases))
			     ))))
	       (progn
		 (goto-char origin)
		 (y-mh-pop-up-aliases alias-list)
		 )))
	 (progn
	   (goto-char origin)
	   (y-mh-handle-letter-mode-key last-input-char)
	   )))
     ( (looking-at "Fcc:")
       (goto-char origin)
       (error "Please use %s for Fcc: completion"
	      (key-description (where-is-internal 'mh-to-fcc
						  mh-letter-mode-map t t)))
       )
     ( t
       (goto-char origin)
       (y-mh-handle-letter-mode-key last-input-char)
       )
     )))


(defmacro y-mh-read-address (prompt)
  "Stupid macro to read a list of MH addresses."
  (` (read-from-minibuffer (, prompt) nil y-mh-read-address-keymap) ))


(defun y-mh-read-to-address (&optional prompt)
  "Ask the user for a To: address only if y-mh-ask-to-address is non-nil."
  (if (not prompt)
      (setq prompt "To: "))
  (if y-mh-ask-to-address
      (y-mh-read-address prompt)
    ""))


(defun y-mh-read-cc-address (&optional prompt)
  "Ask the user for a Cc: address, only if y-mh-ask-cc-address is non-nil."
  (if (not prompt)
      (setq prompt "Cc: "))
  (if y-mh-ask-cc-address
      (y-mh-read-address prompt)
    ""))


(defun y-mh-read-subject (&optional prompt)
  "Ask the user for a Subject: only, if y-mh-ask-subject is non-nil."
  (if (not prompt)
      (setq prompt "Subject: "))
  (if y-mh-ask-subject
      (read-from-minibuffer prompt)
    ""))


(defun y-mh-read-to-cc-subject ()
  "Read addresses for To: and Cc:, and read a subject line.
The result is returned in a form suitable for passing to the `interactive'
function.
This should really be a macro"
  (list (y-mh-read-to-address) (y-mh-read-cc-address) (y-mh-read-subject)))
