From xemacs-m  Mon Jan 13 11:01:17 1997
Received: from mgate.uni-hannover.de (mgate.uni-hannover.de [130.75.2.3])
          by xemacs.org (8.8.4/8.8.4) with SMTP
	  id LAA05972 for <xemacs-beta@xemacs.org>; Mon, 13 Jan 1997 11:01:06 -0600 (CST)
Received: from helios (actually helios.tnt.uni-hannover.de) by mgate 
          with SMTP (PP); Mon, 13 Jan 1997 17:58:03 +0100
Received: from daedalus.tnt.uni-hannover.de by helios (SMI-8.6/SMI-SVR4) 
          id RAA18363; Mon, 13 Jan 1997 17:57:22 +0100
Received: by daedalus.tnt.uni-hannover.de (SMI-8.6/SMI-SVR4) id RAA00813;
          Mon, 13 Jan 1997 17:57:16 +0100
Date: Mon, 13 Jan 1997 17:57:16 +0100
Message-Id: <199701131657.RAA00813@daedalus.tnt.uni-hannover.de>
From: Heiko Muenkel <muenkel@tnt.uni-hannover.de>
To: toy@rtp.ericsson.se
Cc: xemacs-beta@xemacs.org
In-Reply-To: <7941.852936278@rtp.ericsson.se>
References: <7941.852936278@rtp.ericsson.se>
X-Face: n}R'l6CHRf>pi&bj7[x0CW3:kmXm@1)7m+l*9[fp;-Ow4Xe~=5E;skf?2> 
        y]f{HzB|Q(\V9+y$PP~.4G[2n4W7{6Ilm[AMY9B:0kj.K_$-d%p4YIF*bX;=ADp6{ 
        HS@NEv9c.VII+9PgXHASx}K(jy^t=q%qzZ72q1e4E;O!$A$`&wgtLk"1%p.nC_G!] 
        4d1!+J4Q#YD_iXeEy`1x)d\r$1Qn\'23n|[8Y_xzuXJJ7W(EGqnzB]`]aq??;+z=) 
        DW~\'Vq&F'g%QU[Mv2:}nS>SdZFTEC2GsgB=Q,:~H<R5S[:ZN%B:s0;|v1x"Jb
Subject: Re: Wishful thinking for TM (1/2)
MIME-version: 1.0
Content-type: message/partial; id="Mon_Jan_13_17:57:15_1997@daedalus.tnt.uni-hannover.de"; number="1"; total="2"

To: toy@rtp.ericsson.se
Cc: xemacs-beta@xemacs.org
Subject: Re: Wishful thinking for TM
In-Reply-To: <7941.852936278@rtp.ericsson.se>
References: <7941.852936278@rtp.ericsson.se>
X-Face: n}R'l6CHRf>pi&bj7[x0CW3:kmXm@1)7m+l*9[fp;-Ow4Xe~=5E;skf?2>
 y]f{HzB|Q(\V9+y$PP~.4G[2n4W7{6Ilm[AMY9B:0kj.K_$-d%p4YIF*bX;=ADp6{
 HS@NEv9c.VII+9PgXHASx}K(jy^t=q%qzZ72q1e4E;O!$A$`&wgtLk"1%p.nC_G!]
 4d1!+J4Q#YD_iXeEy`1x)d\r$1Qn\'23n|[8Y_xzuXJJ7W(EGqnzB]`]aq??;+z=)
 DW~\'Vq&F'g%QU[Mv2:}nS>SdZFTEC2GsgB=Q,:~H<R5S[:ZN%B:s0;|v1x"Jb
Mime-Version: 1.0 (generated by tm-edit 7.90)
Content-Type: text/plain; charset=US-ASCII

>>>>> "Raymond" == Raymond Toy <toy@rtp.ericsson.se> writes:

    Raymond> I think it's great that TM will be bundled with the next
    Raymond> release of xemacs.  But today, I received a tar file sent
    Raymond> using mailtool using Sun's own mail format.

    Raymond> Would it be possible for TM to support Sun's mime
    Raymond> formatting?  I know it's non-standard and all, but it
    Raymond> sure would be nice.  Metamail tries to understand some,
    Raymond> but it doesn't always work.

    Raymond> Just wishful thinking,

    Raymond> Ray

I'm not sure, if it must be integrated tm. Here is a package, which
could be used additional to the tm package. It works, but I've not had
the time to finish it :-(. Some icons are missing and also some
commands and it may be that you receive a file which is not in the list
mailtool-data-type-alist.


;-*- mode:emacs-lisp-*-
;;; mailtool.el version 0.3
;;; By Peter Pezaris, adapted from detach.el by Cris Perdue
;;;

;;; $Id: mailtool.el,v 1.4 1996/03/13 23:11:32 muenkel Exp muenkel $

;;; to Install, byte-compile this file and put it in your load path, and
;;; add the following lines to your .emacs file:

;;; (require 'mailtool)
;;; (add-hook 'vm-select-message-hook 'mailtool-add-icons)
;;; (add-hook 'vm-quit-hook 'mailtool-quit)

(require 'cl)

(defvar mailtool-icon-buffer nil)

(defvar mailtool-tmp-dir "/tmp/emacs-mailtool"
  "Directory for saving attachments temporary.")

(defvar mailtool-default-directory (concat (getenv "HOME") "/mail"))

(defvar mailtool-icon-list nil
  "Internal variable.")
(make-variable-buffer-local 'mailtool-icon-list)

(defvar mailtool-vm-buffer nil)
(make-variable-buffer-local 'mailtool-vm-buffer)

(defvar mailtool-open-new-screen t
  "Open a new screen to view attachments if non-nil.")

(defvar mailtool-encoding-info-alist
  '(("uuencode" ("uudecode" nil 0 nil file)))
  "An alist with encoding templates.")

(defvar mailtool-faultback-data-type
  '((:save-command (mailtool-exec-internal 
			(mailtool-save-text-region 
			 -start-mark- -end-mark- -data-name-)
			t))
    (:icon default)))

(defvar mailtool-data-type-alist
  '((nil	; X-Sun-Encoding-Info or nil
     (("text"			; X-Sun-Data-Type
       ((:open-command (mailtool-exec-internal 
			(progn (find-file-other-frame -file-name-)
			       (view-minor-mode))))
	(:view-command (mailtool-exec-internal 
			(progn (find-file-other-frame -file-name-)
			       (view-minor-mode))))
	(:edit-command (mailtool-exec-internal
			(find-file-other-frame -file-name-)))
	(:run-command nil)
	(:print-command (mailtool-exec-internal
			 (mailtool-print-region -start-mark- -end-mark-)
			 t))
	(:save-command (mailtool-exec-internal 
			(mailtool-save-text-region 
			 -start-mark- -end-mark- -data-name-)
			t))
	(:icon text)
	)
       )
      ("default"		; X-Sun-Data-Type
       ((:open-command (mailtool-exec-internal 
			(mailtool-save-text-region 
			 -start-mark- -end-mark- -data-name-)
			t))
	(:view-command nil)
	(:edit-command nil)
	(:run-command nil)
	(:print-command nil)
	(:save-command (mailtool-exec-internal 
			(mailtool-save-text-region 
			 -start-mark- -end-mark- -data-name-)
			t))
	(:icon default)
	)
       )
      ("Makefile"		; X-Sun-Data-Type
       ((:open-command (mailtool-exec-internal 
			(progn (find-file-other-frame -file-name-)
			       (view-minor-mode))))
	(:view-command (mailtool-exec-internal 
			(progn (find-file-other-frame -file-name-)
			       (view-minor-mode))))
	(:edit-command (mailtool-exec-internal
			(find-file-other-frame -file-name-)))
	(:run-command nil)
	(:print-command (mailtool-exec-internal
			 (mailtool-print-region -start-mark- -end-mark-)
			 t))
	(:save-command (mailtool-exec-internal 
			(mailtool-save-text-region 
			 -start-mark- -end-mark- -data-name-)
			t))
	(:icon ) ;'makefile)
	)
       )
      ("readme-file"		; X-Sun-Data-Type
       ((:open-command (mailtool-exec-internal 
			(progn (find-file-other-frame -file-name-)
			       (view-minor-mode))))
	(:view-command (mailtool-exec-internal 
			(progn (find-file-other-frame -file-name-)
			       (view-minor-mode))))
	(:edit-command (mailtool-exec-internal
			(find-file-other-frame -file-name-)))
	(:run-command nil)
	(:print-command (mailtool-exec-internal
			 (mailtool-print-region -start-mark- -end-mark-)
			 t))
	(:save-command (mailtool-exec-internal 
			(mailtool-save-text-region 
			 -start-mark- -end-mark- -data-name-)
			t))
	(:icon )
	)
       )
      ("c-file"		; X-Sun-Data-Type
       ((:open-command (mailtool-exec-internal 
			(progn (find-file-other-frame -file-name-)
			       (view-minor-mode))))
	(:view-command (mailtool-exec-internal 
			(progn (find-file-other-frame -file-name-)
			       (view-minor-mode))))
	(:edit-command (mailtool-exec-internal
			(find-file-other-frame -file-name-)))
	(:run-command nil)
	(:print-command (mailtool-exec-internal
			 (mailtool-print-region -start-mark- -end-mark-)
			 t))
	(:save-command (mailtool-exec-internal 
			(mailtool-save-text-region 
			 -start-mark- -end-mark- -data-name-)
			t))
	(:icon c-file)
	)
       )      
      ("h-file"		; X-Sun-Data-Type
       ((:open-command (mailtool-exec-internal 
			(progn (find-file-other-frame -file-name-)
			       (view-minor-mode))))
	(:view-command (mailtool-exec-internal 
			(progn (find-file-other-frame -file-name-)
			       (view-minor-mode))))
	(:edit-command (mailtool-exec-internal
			(find-file-other-frame -file-name-)))
	(:run-command nil)
	(:print-command (mailtool-exec-internal
			 (mailtool-print-region -start-mark- -end-mark-)
			 t))
	(:save-command (mailtool-exec-internal 
			(mailtool-save-text-region 
			 -start-mark- -end-mark- -data-name-)
			t))
	(:icon h-file)
	)
       )      
      ("postscript-file"	; X-Sun-Data-Type
       ((:open-command (mailtool-exec-external "ghostview %s"))
	(:view-command (mailtool-exec-external "ghostview %s"))
	(:edit-command (mailtool-exec-internal
			(find-file-other-frame -file-name-)))
	(:run-command nil)
	(:print-command (mailtool-exec-external "lpr -Pgoethe %s"))
	(:save-command (mailtool-exec-internal 
			(mailtool-save-text-region 
			 -start-mark- -end-mark- -data-name-)
			t))
	(:icon postscript)
	)
       )
      ("shell-script"		; X-Sun-Data-Type
       ((:open-command (mailtool-exec-internal 
			(progn (find-file-other-frame -file-name-)
			       (view-minor-mode))))
	(:view-command (mailtool-exec-internal 
			(progn (find-file-other-frame -file-name-)
			       (view-minor-mode))))
	(:edit-command (mailtool-exec-internal
			(find-file-other-frame -file-name-)))
	;; In the hope, that nobody sends a command like "/bin/rm -r ~/" !!!
	(:run-command (mailtool-exec-external "xterm -e %s"))
	(:print-command (mailtool-exec-internal
			 (mailtool-print-region -start-mark- -end-mark-)
			 t))
	(:save-command (mailtool-exec-internal 
			(mailtool-save-text-region 
			 -start-mark- -end-mark- -data-name-)
			t))
	(:icon )
	)
       )
      ("xbm-file"		; X-Sun-Data-Type
       ((:open-command (mailtool-exec-external "xv %s"))
	(:view-command (mailtool-exec-external "xv %s"))
	(:edit-command (mailtool-exec-internal
			(find-file-other-frame -file-name-)))
	(:run-command nil)
	(:print-command nil)
	(:save-command (mailtool-exec-internal 
			(mailtool-save-text-region 
			 -start-mark- -end-mark- -data-name-)
			t))
	(:icon )
	)
       )
      ("xpm-file"		; X-Sun-Data-Type
       ((:open-command (mailtool-exec-external "xv %s"))
	(:view-command (mailtool-exec-external "xv %s"))
	(:edit-command (mailtool-exec-internal
			(find-file-other-frame -file-name-)))
	(:run-command nil)
	(:print-command nil)
	(:save-command (mailtool-exec-internal 
			(mailtool-save-text-region 
			 -start-mark- -end-mark- -data-name-)
			t))
	(:icon )
	)
       )
      )
     )
    ("uuencode"	; X-Sun-Encoding-Info or nil
     (("mail-file"
       ((:open-command (mailtool-exec-internal 
			(vm-visit-folder-other-frame -file-name-)))
	(:view-command (mailtool-exec-internal 
			(vm-visit-folder-other-frame -file-name-)))
	(:edit-command nil)
	(:run-command nil)
	(:print-command nil)
	(:save-command (mailtool-exec-internal 
			(mailtool-save-encoded-region
			 -start-mark- -end-mark- -data-name- -encoding-)
			t))
	(:icon )
	)
       )
      ("gif-file"		; X-Sun-Data-Type
       ((:open-command (mailtool-exec-external "xv %s"))
	(:view-command (mailtool-exec-external "xv %s"))
	(:edit-command nil)
	(:run-command nil)
	(:print-command nil)
	(:save-command (mailtool-exec-internal 
			(mailtool-save-encoded-region
			 -start-mark- -end-mark- -data-name- -encoding-)
			t))
	(:icon )
	)
       )
      ("tiff-file"		; X-Sun-Data-Type
       ((:open-command (mailtool-exec-external "xv %s"))
	(:view-command (mailtool-exec-external "xv %s"))
	(:edit-command nil)
	(:run-command nil)
	(:print-command nil)
	(:save-command (mailtool-exec-internal 
			(mailtool-save-encoded-region
			 -start-mark- -end-mark- -data-name- -encoding-)
			t))
	(:icon )
	)
       )
      ("jpeg-file"		; X-Sun-Data-Type
       ((:open-command (mailtool-exec-external "xv %s"))
	(:view-command (mailtool-exec-external "xv %s"))
	(:edit-command nil)
	(:run-command nil)
	(:print-command nil)
	(:save-command (mailtool-exec-internal 
			(mailtool-save-encoded-region
			 -start-mark- -end-mark- -data-name- -encoding-)
			t))
	(:icon )
	)
       )
      ("audio-file"		; X-Sun-Data-Type
       ((:open-command (mailtool-exec-internal (play-sound-file -file-name-)))
	(:view-command (mailtool-exec-internal (play-sound-file -file-name-)))
	(:edit-command nil)
	(:run-command nil)
	(:print-command nil)
	(:save-command (mailtool-exec-internal 
			(mailtool-save-encoded-region
			 -start-mark- -end-mark- -data-name- -encoding-)
			t))
	(:icon );'audio)
	)
       )
      ("gzip"
       ((:open-command (mailtool-exec-internal 
			(mailtool-save-encoded-region
			 -start-mark- -end-mark- -data-name- -encoding-)
			t))
	(:view-command )
	(:edit-command nil)
	(:run-command )
	(:print-command )
	(:save-command (mailtool-exec-internal 
			(mailtool-save-encoded-region
			 -start-mark- -end-mark- -data-name- -encoding-)
			t))
	(:icon )
	)
       )
      ("tar-file"
       ((:open-command (mailtool-exec-internal 
			(mailtool-save-encoded-region
			 -start-mark- -end-mark- -data-name- -encoding-)
			t))
	(:view-command (mailtool-exec-internal 
			(find-file-other-frame -file-name-)))
	(:edit-command nil)
	(:run-command nil)
	(:print-command nil)
	(:save-command (mailtool-exec-internal 
			(mailtool-save-encoded-region
			 -start-mark- -end-mark- -data-name- -encoding-)
			t))
	(:icon )
	)
       )
      ("compress"
       ((:open-command (mailtool-exec-internal 
			(mailtool-save-encoded-region
			 -start-mark- -end-mark- -data-name- -encoding-)
			t))
	(:view-command )
	(:edit-command nil)
	(:run-command )
	(:print-command )
	(:save-command (mailtool-exec-internal 
			(mailtool-save-encoded-region
			 -start-mark- -end-mark- -data-name- -encoding-)
			t))
	(:icon )
	)
       )
      ("default-app"		; X-Sun-Data-Type
       ((:open-command )
	(:view-command )
	(:edit-command nil)
	(:run-command nil)
	(:print-command )
	(:save-command (mailtool-exec-internal 
			(mailtool-save-encoded-region
			 -start-mark- -end-mark- -data-name- -encoding-)
			t))
	(:icon )
	)
       )
      ("framemaker-document"		; X-Sun-Data-Type
       ((:open-command )
	(:view-command )
	(:edit-command )
	(:run-command nil)
	(:print-command )
	(:save-command (mailtool-exec-internal 
			(mailtool-save-encoded-region
			 -start-mark- -end-mark- -data-name- -encoding-)
			t))
	(:icon frame-file)
	)
       )
      ("doc-file"		; X-Sun-Data-Type
       ((:open-command )
	(:view-command )
	(:edit-command )
	(:run-command nil)
	(:print-command )
	(:save-command (mailtool-exec-internal 
			(mailtool-save-encoded-region
			 -start-mark- -end-mark- -data-name- -encoding-)
			t))
	(:icon )
	)
       )
      )
     )
    )
  )

(defun mailtool-no-attachments-p ()
  "Returns t, if no attachments are in the current buffer."
  (save-excursion
    (goto-char (point-min))
    (if (search-forward-regexp
	 (concat "\\(^Date:\\)\\|"  ; in the hope, that this is the last one
		 "\\(^Mime-Version:\\)\\|"
		 "\\(^Content-Type: X-sun-attachment\\)")
	 nil
	 t)
	(or (match-beginning 1) (match-beginning 2))
      t)))

(defun mailtool-add-icons ()
  "Find, extract, and skip to the end of the next attachment from
a mail message.  If an X-Sun-Data-Name is specified, puts the attachment
into /tmp/<name>.  Uses the uudecode command to decode
attachments marked as uuencoded.  Views the attachment with
pageview if PostScript, otherwise directly in a buffer in Emacs.
If the data-type is framemaker-document, this does not attempt
to view it."
  (interactive)
  (setq mailtool-icon-list nil)
  (setq mailtool-old-buffer (current-buffer)) ; Message Buffer
  (if (mailtool-no-attachments-p)
      (progn
	(message "No \"Content-Type: X-sun-attachment\" found.")
	(and mailtool-icon-buffer
	     (get-buffer-window mailtool-icon-buffer)
	     (delete-window (get-buffer-window mailtool-icon-buffer)))
	(set-buffer mailtool-old-buffer))
    (save-excursion
;;    (and (eq major-mode 'vm-summary-mode)
;;	 (set-buffer vm-mail-buffer))
      (goto-char (point-min))
      (message "Parsing attachments...")
      (while (re-search-forward "^X-Sun-" nil t)
	(let (datatype lines encoding dataname file start end)
	  (beginning-of-line)
	  (while (not (looking-at "^$"))
	    (when (looking-at "^\\(X-Sun-[-a-zA-Z]*\\):[ 	]*\\(.*$\\)")
	      (let ((attr (mailtool-re-match 1))
		    (value (mailtool-re-match 2)))
		;; (message "%s = %s" attr value)
		;; (sit-for 1)
		(when (equal attr "X-Sun-Data-Type")
		  (setq datatype value))
		(when (equal attr "X-Sun-Content-Lines")
		  (setq lines (car (read-from-string value)))
		  (unless (numberp lines) 
		    (error "X-Sun-Content-Lines (%s) not a number." lines)))
		(when (equal attr "X-Sun-Encoding-Info")
		  (setq encoding value))
		(when (equal attr "X-Sun-Data-Name")
		  (setq dataname value)
		  (setq file (format "/tmp/%s" dataname)))))
	    (forward-line)
	    (beginning-of-line))
	  (forward-line)
	  (setq start (point-marker))
	  (forward-line lines)
	  (setq end (point-marker))
;	(message "Type %s, File %s, Encoding %s, Start/End %s/%s"
;	    datatype dataname encoding start end)
;	(sit-for 2)

	  (let* ((data-type-alist (second 
				   (assoc encoding mailtool-data-type-alist)))
		 (command-alist nil)
		 (warning-message ""))
	    (cond ((not data-type-alist)
		   (setq warning-message " - Unknown Encoding Type")
		   (setq command-alist mailtool-faultback-data-type))
		  ((setq command-alist 
		  (second (assoc datatype data-type-alist))))
		  (t (setq warning-message " - Unknown Data Type")
		     (setq command-alist mailtool-faultback-data-type)))
	    (mailtool-add-icon (or (second (assoc ':icon 
						  command-alist))
				   'default)
			       lines
			       (concat
				(if encoding
				(format "%s (%s)" dataname encoding)
				dataname)
				warning-message)
			       encoding
			       command-alist
			       start
			       end))


;	(when dataname
;	 (cond
;	   ((string-equal encoding "uuencode")
;	    (mailtool-add-icon 'uuencoded lines (concat dataname
;							" (uuencoded)")))
;	   ((string-equal datatype "text")
;	    (mailtool-add-icon 'text lines dataname))
;	   ((string-equal datatype "default")
;	    (mailtool-add-icon 'default lines dataname))
;	   ((string-equal datatype "c-file")
;	    (mailtool-add-icon 'c-file lines dataname))
;	   ((string-equal datatype "h-file")
;	    (mailtool-add-icon 'h-file lines dataname))
;	   ((string-equal datatype "postscript-file")
;	    (mailtool-add-icon 'postscript lines dataname))
;	   ((string-equal datatype "gif-file")
;	    (mailtool-add-icon 'gif lines dataname))
;	   ((string-equal datatype "audio-file")
;	    (mailtool-add-icon 'audio lines dataname))
;	   ((string-equal datatype "framemaker-document")
;	    (mailtool-add-icon 'frame-file lines dataname))
;	   (t (message "UNKNOWN datatype %s" datatype)
;	      (mailtool-add-icon 'default lines dataname)
;	      )))
	  ))
      (goto-char (point-min))
      (if mailtool-icon-list
	  (mailtool-make-icon-buffer vm-summary-buffer)
	(and mailtool-icon-buffer
	(get-buffer-window mailtool-icon-buffer)
	(delete-window (get-buffer-window mailtool-icon-buffer))))
      (message "Parsing attachments...done"))
; (select-window (get-buffer-window mailtool-old-buffer));)
    (set-buffer mailtool-old-buffer)	; better comment this out ?
    )
  )

(defun mailtool-add-icon (icon-type 
			  file-size
			  file-name
			  encoding
			  command-alist
			  start
			  end)
  "Add an icon to the icon list `mailtool-icon-list'.
Each element of this list consists of a sublist with the following
elements:
ICON-TYPE, FILE-SIZE, FILE-NAME, ENCODING, COMMAND-ALIST, START, END."
  (let ((new-icon
	 (list icon-type file-size file-name encoding command-alist start end)
		  ))
    (setq mailtool-icon-list (cons new-icon mailtool-icon-list))))

(defvar mailtool-icon-keymap (make-sparse-keymap))
;(define-key mailtool-icon-keymap [(button2)] 'mailtool-do-icon-on-line)
(define-key mailtool-icon-keymap [(button2)] 'mailtool-mouse-open-icon)
(define-key mailtool-icon-keymap [(button3)] 'mailtool-icon-popup-menu)
(define-key mailtool-icon-keymap "s" 'mailtool-save-icon)
(define-key mailtool-icon-keymap " " 'mailtool-open-icon)

(defun mailtool-mouse-open-icon ()
  "Run the open command on the icon."
  (interactive)
  (mouse-set-point last-command-event)
  (mailtool-open-icon))

(defun mailtool-open-icon ()
  "Run the open command on the icon."
  (interactive)
  (setq mailtool-actual-icon-data
	(extent-property (extent-at (point))
			 'mailtool-icon-data))
  (if (mailtool-exist-command-p ':open-command)
      (mailtool-exec-command-with-key ':open-command)
    (error "ERROR: This icon has no open command.")))

(defun mailtool-save-icon ()
  "Run the save command on the icon."
  (interactive)
  (setq mailtool-actual-icon-data
	(extent-property (extent-at (point))
			 'mailtool-icon-data))
  (if (mailtool-exist-command-p ':save-command)
      (mailtool-exec-command-with-key ':save-command)
    (error "ERROR: This icon has no save command.")))

;(defun mailtool-do-icon-on-line ()
;  (interactive)
;  (mouse-set-point last-command-event)
;  (let* ((cword (progn (beginning-of-line) (current-word)))
;	 (index (1- (string-to-int cword))))
;    (set-buffer mailtool-old-buffer)
;;    (other-window 2) ; better comment this out <HM> ?
;    (goto-char (point-min))
;    (mailtool-detach index)))

(defun mailtool-insert-icon (icon-data index)
  (insert "  " (int-to-string index))
  (insert "  [" (int-to-string (nth 1 icon-data))"] ")
  (while (< (current-column) 14)
    (insert " "))
  (insert " " (or (nth 2 icon-data) "FOO"))
  (insert "\n")
  (forward-line -1)
  (let ((e (make-extent (point) (point)))
	(e2 (make-extent (point) (progn (end-of-line) (point))))
	(p (mailtool-reference (car icon-data) mailtool-pixmap-list)))
    (set-extent-begin-glyph e p)
    (set-extent-property e2 'highlight t)
    (set-extent-property e2 'keymap mailtool-icon-keymap)
    (set-extent-property e2 'mailtool-icon-data icon-data))
  (forward-line 1))

;(defun mailtool-insert-icon-2 (icon-data index)
;  (let ((cc (current-column)))
;    (insert "  " (int-to-string index))
;    (insert "  [" (int-to-string (nth 1 icon-data))"] ")
;    (while (< (current-column) (+ cc 14))
;      (insert " "))
;    (insert " " (or (nth 2 icon-data) "FOO"))
;    (insert "\n")
;    (forward-line -1)
;    (forward-char cc)
;    (let ((e (make-extent (point) (point)))
;	  (e2 (make-extent (point) (progn (end-of-line) (point))))
;	  (p (mailtool-reference (car icon-data) mailtool-pixmap-list)))
;      (set-extent-begin-glyph e p)
;      (set-extent-property e2 'highlight t)
;      (set-extent-property e2 'keymap mailtool-icon-keymap))
;    (if (> cc 0)
;	(forward-line 1)
;      (while (< (current-column) (- (/ (window-width) 2) 4))
;	(insert " ")))))

(defun mailtool-reference (e l)
  (cdr (assoc e l)))

(defun mailtool-quit ()
  (if mailtool-icon-buffer
      (kill-buffer mailtool-icon-buffer)
    (message "NULL mailtool-icon-buffer")))
  
(defvar mailtool-use-vm-window-configurations t
  "t, if the vm window configuration code should be used.")

;; Defines the vm window configuration name mailtool, if necessary.
;; It's a little bit tricky, because vm must be loaded already and one 
;; can't enable the vm configuration stuff after loading this file
;; (one has to reload it then)
(if (and mailtool-use-vm-window-configurations
	 vm-supported-window-configurations
	 (not (assoc "mailtool" vm-supported-window-configurations)))
    (setq vm-supported-window-configurations
	  (cons '("mailtool") vm-supported-window-configurations)))

(defun mailtool-make-icon-buffer (the-vm-buffer)
  "Build and display the icon buffer. 
It uses the vm window configuration stuff, if `mailtool-use-vm-window-configurations'
is t. The name of the window configuration is mailtool.

THE-VM-BUFFER is only used, if `mailtool-use-vm-window-configurations' is nil."
  (if (not mailtool-use-vm-window-configurations)
      (mailtool-make-icon-buffer-old the-vm-buffer)
    (or (and (bufferp mailtool-icon-buffer) (buffer-name mailtool-icon-buffer))
	(setq mailtool-icon-buffer (get-buffer-create "icon-buffer")))
    (set-buffer mailtool-icon-buffer)
    (toggle-read-only nil)
    (erase-buffer)
    (setq major-mode 'mailtool-mode)
    (setq mode-name "Mailtool")
    (let ((the-list (reverse mailtool-icon-list))
	  (counter 1))
      (while the-list
	(mailtool-insert-icon (car the-list) counter)
	(setq counter (1+ counter))
	(setq the-list (cdr the-list))))
    (goto-char (point-min))
    ;; The following is a little bit tricky -
    ;; it is necessary to use the nice vm window configuration stuff
    (let ((this-command 'mailtool-add-icons))      
      (vm-display mailtool-old-buffer ;mailtool-icon-buffer
		  t
		  '(mailtool-add-icons)
		  '(mailtool-add-icons mailtool))))

  (toggle-read-only 1))

(defun mailtool-make-icon-buffer-old (the-vm-buffer)
  (other-window 1)
  (and mailtool-icon-buffer
       (get-buffer-window mailtool-icon-buffer)
       (delete-window (get-buffer-window mailtool-icon-buffer)))
  (or (and (bufferp mailtool-icon-buffer) (buffer-name mailtool-icon-buffer))
      (setq mailtool-icon-buffer (get-buffer-create "icon-buffer")))
  (let ((window-min-height 1))
    (split-window nil (- (window-height)
			 (floor (+ 2 (* 2.5 (length mailtool-icon-list))))))
    (switch-to-buffer-other-window mailtool-icon-buffer)
;    (setq mailtool-vm-buffer the-vm-buffer)
    (toggle-read-only nil)
    (erase-buffer)
    (setq major-mode 'mailtool-mode)
    (setq mode-name "Mailtool")
    (let ((the-list (reverse mailtool-icon-list))
	  (counter 1))
      (while the-list
	(mailtool-insert-icon (car the-list) counter)
	(setq counter (1+ counter))
	(setq the-list (cdr the-list)))))
  (goto-char (point-min)))
;  (select-window (get-buffer-window mailtool-vm-buffer)))

(defun mailtool-re-match (n)
  (buffer-substring (match-beginning n) (match-end n)))

;(defun mailtool-detach (&optional index)
;"Find, extract, and skip to the end of the next attachment from
;a mail message.  If an X-Sun-Data-Name is specified, puts the attachment
;into /tmp/<name>.  Uses the uudecode command to decode
;attachments marked as uuencoded.  Views the attachment with
;pageview if PostScript, otherwise directly in a buffer in Emacs.
;If the data-type is framemaker-document, this does not attempt
;to view it."
;(interactive)
;(if (re-search-forward "^X-Sun-" nil t)
;    (let (datatype lines encoding dataname file start end)
;      (beginning-of-line)
;      (while (not (looking-at "^$"))
;	(when (looking-at "^\\(X-Sun-[-a-zA-Z]*\\):[ 	]*\\(.*$\\)")
;	  (let ((attr (mailtool-re-match 1))
;		(value (mailtool-re-match 2)))
;	    ;; (message "%s = %s" attr value)
;	    ;; (sit-for 1)
;	    (when (equal attr "X-Sun-Data-Type")
;	      (setq datatype value))
;	    (when (equal attr "X-Sun-Content-Lines")
;	      (setq lines (car (read-from-string value)))
;	      (unless (numberp lines) 
;		(error "X-Sun-Content-Lines (%s) not a number." lines)))
;	    (when (equal attr "X-Sun-Encoding-Info")
;	      (setq encoding value))
;	    (when (equal attr "X-Sun-Data-Name")
;	      (setq dataname value)
;	      (setq file (format "/tmp/%s" dataname)))))
;	(forward-line)
;	(beginning-of-line))
;      (forward-line)
;      (setq start (point))
;      (forward-line lines)
;      (setq end (point))
;      ;; (message "Type %s, File %s, Encoding %s, Start/End %s/%s"
;      ;;    datatype dataname encoding start end)
;      (if (and index (> index 0))
;	  (mailtool-detach (1- index))
;	(goto-char (point-min))
;;	(other-window 2)
;	(when dataname
;	  (if (equal encoding "uuencode")
;	      (let ((default-directory (file-name-directory file)))
;		(write-region start end (concat file ".uu"))
;		(call-process "uudecode" nil nil nil (concat file ".uu")))
;	    (write-region start end file)))
;	(let ((tpl (assoc datatype attachment-action-templates)))
;	  (cond
;	   (tpl
;	    (let ((pgm (first (second tpl))))
;	      (if dataname
;		  (progn
;		    (message "Running %s on %s ..." pgm file)
;		    (apply 'call-process (subst file 'file (second tpl))))
;		(let ((file (make-temp-name (if (eq system-type 'vax-vms)
;						"tmp:emacs"
;					      "/tmp/emacs"))))
;		  (message "Running %s ..." pgm)
;		  (apply 'call-process (subst file 'file (second tpl)))))))
;	   ((equal datatype "framemaker-document")
;	    (message "File %s is a Frame document; not attempting to view."
;		     dataname))
;	   (dataname
;	    (if mailtool-open-new-screen
;		(find-file-other-screen file)
;	      (find-file file)))
;	   (t (message "Didn't reconize data type %s." datatype))))))
;  (or index (message "No more attachments."))))

(defun mailtool-attach (file)
  "This attaches a file in the manner of Sun's mailtool.
If a prefix argument is supplied, encodes the file with uuencode.
Leaves point at the beginning of the contents of the file.  You may
hand-edit the headers except for X-Sun-Content-Lines."
  (interactive "fAttach file: ")
  (let ((encode current-prefix-arg)
	nchars nlines (here (point)))
    (if encode
	(progn
	  (shell-command (format "uuencode %s %s" 
				 file 
				 (file-name-nondirectory file)) t)
	  (setq nchars (- (mark t) (point)))
	  (setq nlines (count-lines (point) (mark t))))
      (progn
	(setq nchars (second (insert-file-contents file)))
	(setq nlines (count-lines (point) (+ (point) nchars)))))
    (insert "----------\n")
    (insert "X-Sun-Data-Type: default\n")
    (insert "X-Sun-Data-Description: default\n")
    (insert (format "X-Sun-Data-Name: %s\n" (file-name-nondirectory file)))
    (insert (format "X-Sun-Full-File-Name: %s\n" (expand-file-name file)))
    (when encode
      (insert "X-Sun-Encoding-Info: uuencode\n"))
    (insert (format "X-Sun-Content-Lines: %d\n\n" nlines))

    (mail-add-header "Content-Type" "X-sun-attachment\n")

    ))

;(defvar attachment-action-templates
;  '(("postscript-file" ("pageview" nil 0 nil file))
;    ("gif-file" ("imagetool" nil 0 nil file))
;    ("audio-file" ("audioplay" nil 0 nil file))))


(if (not (fboundp 'subst))
    (defun subst (new old sexpr)
      (cond ((equal sexpr old) new)
	    ((atom sexpr) sexpr)
	    (t (cons (subst new old (car sexpr))
		     (subst new old (cdr sexpr)))))))

(setq mailtool-pixmap-list
      (list
       (cons
	'text
	(make-pixmap "/* XPM */
static char * text_xpm[] = {
\"32 32 6 1\",
\" 	s None	c None\",
\".	c grey90\",
\"X	c grey75\",
\"o	c grey50\",
\"O	c black\",
\"+	c grey63\",
\"                                \",
\"                                \",
\"                                \",
\"      ....................      \",
\"      .XXXXXXXXXXXXXXXXXXo      \",
\"      .XXXXXXXXXXXXXXXXXXo      \",
\"      .XXOOOOOXXXXXXXXXXXo      \",
\"      .XXXXXXXXXXXXXXXXXXo      \",
\"      .XXOOOOXXXXXXXXXXXXo      \",
\"      .XXXXXXXXXXXXXXXXXXo      \",
\"      .XXXXXXXXXXXXXXXXXXo      \",
\"      .XXXXXXXXXXXXXXXXXXo      \",
\"      .XXOOOOOOOOOOOOOXXXo      \",
\"      .XXXXXXXXXXXXXXXXXXo      \",
\"      .XXOOOOOOOOOOOOOOXXo      \",
\"      .XXXXXXXXXXXXXXXXXXo      \",
\"      .XXOOOOOOOOOOOXXXXXo      \",
\"      .XXXXXXXXXXXXXXXXXXo      \",
\"      .XXOOOOOOOOOOOOOXXXo      \",
\"      .XXXXXXXXXXXXXXXXXXo      \",
\"      .XXOOOOOOOOOOOOXXXXo      \",
\"      .XXXXXXXXXXXXXXXXXXo      \",
\"      .XXOOOOOOOOOX......o      \",
\"      .XXXXXXXXXXXX.++++o       \",
\"      .XXXXXXXXXXXX.+++o        \",
\"      .XXXXXXXXXXXX.++o         \",
\"      .XXXXXXXXXXXX.+o          \",
\"      .XXXXXXXXXXXX.o           \",
\"      .ooooooooooooo            \",
\"                                \",
\"                                \",
\"                                \"};"))
       (cons
	'default
	(make-pixmap "/* XPM */
static char * questionmark_xpm[] = {
\"32 32 5 1\",
\" 	s None	c None\",
\".	c grey90\",
\"X	c grey75\",
\"o	c grey50\",
\"O	c white\",
\"                                \",
\"                                \",
\"                                \",
\"      ....................      \",
\"      .XXXXXXXXXXXXXXXXXXo      \",
\"      .XXXXXXXXXXXXXXXXXXo      \",
\"      .XXXXXX......XXXXXXo      \",
\"      .XXXXX.XXXXXX.XXXXXo      \",
\"      .XXXX.XoXXXXoXoXXXXo      \",
\"      .XXX.XoXXXXXX.XoXXXo      \",
\"      .XXXOooXXXXXX.XoXXXo      \",
\"      .XXXXoXXXXXXX.XoXXXo      \",
\"      .XXXXXXXXXXXX.XoXXXo      \",
\"      .XXXXXXXXXXXX.XoXXXo      \",
\"      .XXXXXXXXXXX.XoXXXXo      \",
\"      .XXXXXXXXX..XoXXXXXo      \",
\"      .XXXXXXXX.XXoXXXXXXo      \",
\"      .XXXXXXX.XooXXXXXXXo      \",
\"      .XXXXXXX.XoXXXXXXXXo      \",
\"      .XXXXXXX.XoXXXXXXXXo      \",
\"      .XXXXXXX.XoXXXXXXXXo      \",
\"      .XXXXXXXXoXXXXXXXXXo      \",
\"      .XXXXXXXXXXXXXXXXXXo      \",
\"      .XXXXXXXX.XXXXXXXXXo      \",
\"      .XXXXXXX.XoXXXXXXXXo      \",
\"      .XXXXXXXXoXXXXXXXXXo      \",
\"      .XXXXXXXXXXXXXXXXXXo      \",
\"      .XXXXXXXXXXXXXXXXXXo      \",
\"      .ooooooooooooooooooo      \",
\"                                \",
\"                                \",
\"                                \"};"))
       (cons
	'uuencoded
	(make-pixmap "/* XPM */
static char * uuencoded_xpm[] = {
\"32 32 6 1\",
\" 	s None	c None\",
\".	c grey90\",
\"X	c grey75\",
\"o	c grey50\",
\"O	c black\",
\"+	c grey63\",
\"                                \",
\"                                \",
\"                                \",
\"      ....................      \",
\"      .XXXXXXXXXXXXXXXXXXo      \",
\"      .XXXXXXXXXXXXXXXXXXo      \",
\"      .XXXXXXXXXXXXXXXXXXo      \",
\"      .XXXXXXXXXXXXXXXXXXo      \",
\"      .XXXXXXXXXXXXXXXXXXo      \",
\"      .XXXXXXXXXXXXXXXXXXo      \",
\"      .XXXXXXXXXXXXXXXXXXo      \",
\"      .XXXXXXXXXXXXXXXXXXo      \",
\"      .XXOOXXOOXXOOXXOOXXo      \",
\"      .XXOOXXOOXXOOXXOOXXo      \",
\"      .XXOOXXOOXXOOXXOOXXo      \",
\"      .XXOOXXOOXXOOXXOOXXo      \",
\"      .XXOOXXOOXXOOXXOOXXo      \",
\"      .XXXOOOOXOXXOOOOXOXo      \",
\"      .XXXXXXXXXXXXXXXXXXo      \",
\"      .XXXXXXXXXXXXXXXXXXo      \",
\"      .XXXXXXXXXXXXXXXXXXo      \",
\"      .XXXXXXXXXXXXXXXXXXo      \",
\"      .XXXXXXXXXXXX......o      \",
\"      .XXXXXXXXXXXX.++++o       \",
\"      .XXXXXXXXXXXX.+++o        \",
\"      .XXXXXXXXXXXX.++o         \",
\"      .XXXXXXXXXXXX.+o          \",
\"      .XXXXXXXXXXXX.o           \",
\"      .ooooooooooooo            \",
\"                                \",
\"                                \",
\"                                \"};"))
       (cons
	'c-file
	(make-pixmap "/* XPM */
static char * c_xpm[] = {
\"32 32 7 1\",
\" 	s None	c None\",
\".	c grey90\",
\"X	c grey75\",
\"o	c grey50\",
\"O	c black\",
\"+	c #888888888888\",
\"@	c grey63\",
\"                                \",
\"                                \",
\"                                \",
\"      ....................      \",
\"      .XXXXXXXXXXXXXXXXXXo      \",
\"      .XXXXXXXXXXXXXXXXXXo      \",
\"      .XXXXXXXXXXXXXXXXXXo      \",
\"      .XXXXXXXXXXXXXXXXXXo      \",
\"      .XXXXXXXXXXXXXXXXXXo      \",
\"      .XXXXXXXXXXXXXXXXXXo      \",
\"      .XXXXXXXXOOOXXXXXXXo      \",
\"      .XXXXXXXOOOOOXXXXXXo      \",
\"      .XXXXXXOO+XXO+XXXXXo      \",

