;;; mew-xemacs.el --- Environment of XEmacs for Mew

;; Author:  Kazu Yamamoto <Kazu@Mew.org>
;; Created: Mar 20, 1997
;; Revised: Oct 25, 1997

;;; Code:

(defconst mew-xemacs-version "mew-xemacs.el version 0.07")

;;
;; Common
;;

(defvar mew-icon-directory (if (fboundp 'locate-data-directory)
			       (locate-data-directory "mew")))

(defvar mew-icon-separate
  (toolbar-make-button-list
   (expand-file-name "mew-sep.xpm" mew-icon-directory))
  )

(defvar mew-icon-separate-spec
  (list [mew-icon-separate nil nil ""]))

(defvar mew-icon-blank
  (toolbar-make-button-list
   (expand-file-name "mew-Blank.xpm" mew-icon-directory))
  )

(defvar mew-icon-audio 
  (toolbar-make-button-list
   (expand-file-name "mew-Audio.xpm" mew-icon-directory))
  )

(defvar mew-icon-image
  (toolbar-make-button-list
   (expand-file-name "mew-Image.xpm" mew-icon-directory))
  )

(defvar mew-icon-video
  (toolbar-make-button-list
   (expand-file-name "mew-Video.xpm" mew-icon-directory))
  )

(defvar mew-icon-application/postscript
  (toolbar-make-button-list
   (expand-file-name "mew-Postscript.xpm" mew-icon-directory))
  )

(defvar mew-icon-application/octet-stream
  (toolbar-make-button-list
   (expand-file-name "mew-Octet-Stream.xpm" mew-icon-directory))
  )

(defvar mew-icon-message/rfc822
  (toolbar-make-button-list
   (expand-file-name "mew-Rfc822.xpm" mew-icon-directory))
  )

(defvar mew-icon-message/external-body
  (toolbar-make-button-list
   (expand-file-name "mew-External.xpm" mew-icon-directory))
  )

(defvar mew-icon-text
  (toolbar-make-button-list
   (expand-file-name "mew-Text.xpm" mew-icon-directory))
  )

(defvar mew-icon-multipart
  (toolbar-make-button-list
   (expand-file-name "mew-Folder.xpm" mew-icon-directory))
  )

(defvar mew-icon-unknown
  (toolbar-make-button-list
   (expand-file-name "mew-Unknown.xpm" mew-icon-directory))
  )

;;
;; Summary mode
;;

(defvar mew-summary-toolbar-icon-show
  (toolbar-make-button-list
   (expand-file-name "mew-show.xpm" mew-icon-directory))
  )

(defvar mew-summary-toolbar-icon-next
  (toolbar-make-button-list
   (expand-file-name "mew-next.xpm" mew-icon-directory))
  )

(defvar mew-summary-toolbar-icon-prev
  (toolbar-make-button-list
   (expand-file-name "mew-prev.xpm" mew-icon-directory))
  )

(defvar mew-summary-toolbar-icon-inc
  (toolbar-make-button-list
   (expand-file-name "mew-inc.xpm" mew-icon-directory))
  )

(defvar mew-summary-toolbar-icon-write
  (toolbar-make-button-list
   (expand-file-name "mew-write.xpm" mew-icon-directory))
  )

(defvar mew-summary-toolbar-icon-reply
  (toolbar-make-button-list
   (expand-file-name "mew-reply.xpm" mew-icon-directory))
  )

(defvar mew-summary-toolbar-icon-forward
  (toolbar-make-button-list
   (expand-file-name "mew-forward.xpm" mew-icon-directory))
  )

(defvar mew-summary-toolbar-icon-refile
  (toolbar-make-button-list
   (expand-file-name "mew-refile.xpm" mew-icon-directory))
  )

(defvar mew-summary-toolbar
  '(
    [mew-summary-toolbar-icon-show
     mew-summary-show
     t
     "Read Forward"]
    [mew-summary-toolbar-icon-next
     mew-summary-display-down
     t
     "Show Next Message"]
    [mew-summary-toolbar-icon-prev
     mew-summary-display-up
     t
     "Show Previous Message"]
    [mew-summary-toolbar-icon-inc
     mew-summary-get
     t
     "Check New Messages"]
    [mew-summary-toolbar-icon-write
     mew-summary-send
     t
     "Write Message"]
    [mew-summary-toolbar-icon-reply
     mew-summary-reply
     t
     "Reply to This Message"]
    [mew-summary-toolbar-icon-forward
     mew-summary-forward
     t
     "Forward This Message"]
    [mew-summary-toolbar-icon-refile
     mew-summary-refile
     t
     "Refile This Message"]
    )
  )

;;
;; Draft mode
;;

(defvar mew-draft-toolbar-icon-comp
  (toolbar-make-button-list
   (expand-file-name "mew-comp.xpm" mew-icon-directory))
  )

(defvar mew-draft-toolbar-icon-send
  (toolbar-make-button-list
   (expand-file-name "mew-send.xpm" mew-icon-directory))
  )

(defvar mew-draft-toolbar-icon-attach
  (toolbar-make-button-list
   (expand-file-name "mew-attach.xpm" mew-icon-directory))
  )

(defvar mew-draft-toolbar-icon-cite
  (toolbar-make-button-list
   (expand-file-name "mew-cite.xpm" mew-icon-directory))
  )

(defvar mew-draft-toolbar-icon-yank
  (toolbar-make-button-list
   (expand-file-name "mew-yank.xpm" mew-icon-directory))
  )

(defvar mew-draft-toolbar-icon-pgp-sign
  (toolbar-make-button-list
   (expand-file-name "mew-pgp-sign.xpm" mew-icon-directory))
  )

(defvar mew-draft-toolbar-icon-pgp-enc
  (toolbar-make-button-list
   (expand-file-name "mew-pgp-enc.xpm" mew-icon-directory))
  )


(defvar mew-draft-toolbar-icon-pgp-sigenc
  (toolbar-make-button-list
   (expand-file-name "mew-pgp-sigenc.xpm" mew-icon-directory))
  )

(defvar mew-draft-toolbar
  '(
    [mew-draft-toolbar-icon-comp
     mew-draft-make-message
     t
     "Compose Message"]
    [mew-draft-toolbar-icon-send
     mew-draft-send-letter
     t
     "Send Message"]
    [mew-draft-toolbar-icon-cite
     mew-draft-cite
     t
     "Cite Message"]
    [mew-draft-toolbar-icon-yank
     mew-draft-yank
     t
     "Cite Message without Label"]
    [mew-draft-toolbar-icon-attach
     mew-draft-prepare-attachments
     (not (mew-attach-p))
     "Prepare Attachments"]
    [mew-draft-toolbar-icon-pgp-sign
     mew-pgp-sign-letter
     (not (mew-attach-p))
     "Sign Message with PGP"]
    [mew-draft-toolbar-icon-pgp-enc
     mew-pgp-encrypt-letter
     (not (mew-attach-p))
     "Encrypt Message with PGP"]
    [mew-draft-toolbar-icon-pgp-sigenc
     mew-pgp-sign-encrypt-letter
     (not (mew-attach-p))
     "Sign Then Encrypt Message with PGP"]
    )
  )

;;
;; Button
;; 

(define-key toolbar-map 'button3   'pressed-and-activate-toolbar-button)
(define-key toolbar-map 'button3up 'release-and-activate-toolbar-button)

(defun mew-summary-button ()
  (interactive)
  (let ((msg (mew-summary-message-number))
	(part (mew-syntax-number))
	(button (event-button last-command-event)))
    (mew-summary-goto-part msg part)
    (mew-summary-recenter)
    (cond
     ((eq button 1)
      (mew-summary-show-part part msg))
     ((eq button 3)
      (popup-menu mew-summary-mode-toolbar-menu))
     )
    ))

(defun mew-summary-show-part (part msg)
  (interactive)
  (let ((fld (mew-summary-folder-name))
	(ofld-msg (mew-current-get 'message))
	(buf (buffer-name)))
    (if (null part) 
	(message "No message")
      (mew-summary-toggle-disp-msg 'on)
      (unwind-protect
	  (progn
	    (mew-window-configure buf 'message)
	    ;; message buffer
	    (mew-summary-display-part 
	     (mew-cache-decode-syntax (mew-cache-hit ofld-msg)) part)
	    )
	(mew-pop-to-buffer buf))
      )))

(defun mew-draft-button ()
  (interactive)
  (let ((nums (mew-attach-nums))
	(botton (event-button last-command-event)))
    (mew-attach-goto-number 'here nums)
    (cond
     ((eq botton 1)
      (mew-draft-show-attach nums))
     ((eq botton 3)
      (popup-menu mew-draft-mode-toolbar-menu))
     )
    ))

;; This is a toy at present. Support only CT: Image/*.
;; To make Summary and Draft symmetric, left button click on icon
;; should display the attachment. 
(defun mew-draft-show-attach (nums)
  (interactive)
  (let ((case-fold-search t)
	(str (toolbar-button-help-string last-pressed-toolbar-button))
	(image-extent (extent-at (point-max) nil nil nil 'at))
	ct)
    (if image-extent
	(delete-extent image-extent))
    (if (null (string-match "(\\(.*\\))" str))
	()
      (setq ct (mew-match 1 str))
      (if (string-match "^Image/" ct)
	  (let* ((subdir (mew-attach-expand-path mew-encode-syntax nums))
		 (mimedir (mew-expand-folder
			   (mew-draft-to-mime (buffer-name))))
		 (syntax (mew-syntax-get-entry mew-encode-syntax nums))
		 (name (mew-syntax-get-file syntax))
		 (ename (if (equal subdir "") name (concat subdir name)))
		 (file (expand-file-name ename mimedir))
		 (attr (mew-attr-by-ct ct))
		 (program (mew-attr-get-prog attr))
		 (options (mew-attr-get-opt attr))
		 (async   (mew-attr-get-async attr))
		 (zmacs-regions nil) ;; for XEmacs
		 (format (cond ((and (string-match "jpeg" ct)
				     (featurep 'jpeg)) 'jpeg)
			       ((and (string-match "gif" ct)
				     (featurep 'gif)) 'gif)
			       ((and (string-match "xbm" ct)
				     (featurep 'xpm)) 'xbm)
			       ((and (string-match "xpm" ct)
				     (featurep 'xpm)) 'xpm)
			       ((and (string-match "png" ct)
				     (featurep 'png)) 'png)
			       (t nil)))
		 glyph) 
	    (if format
		(progn
		  (message "Loading image...")
		  (setq glyph (make-glyph (vector format :file file)))
		  (if (eq format 'xbm)
		      (set-glyph-property glyph 'face 'x-face))
		  (set-extent-begin-glyph (make-extent (point-max) (point-max))
					  glyph)
		  (message "Loading image...done."))
	      (if (and (stringp program) (mew-which program exec-path))
		  (if async
		      (mew-mime-start-process program options file)
		    (mew-mime-call-process program options file)))))))))

(defun pressed-and-activate-toolbar-button (event)
  (interactive "_e")
  (or (button-press-event-p event)
      (error "%s must be invoked by a mouse-press" this-command))
  (let ((button (event-toolbar-button event)) callback)
    (if (null (toolbar-button-p button))
	()
      (setq last-pressed-toolbar-button button)
      (if (and (setq callback (toolbar-button-callback button))
	       (or (equal callback 'mew-summary-button)
		   (equal callback 'mew-draft-button)))
	  (if (null (toolbar-button-enabled-p button))
	      ()
	    ;; (setq toolbar-active t) is meaningless... why?
	    (setq this-command callback)
	    (if (symbolp callback)
		(call-interactively callback)
	      (eval callback))
	    )
	;; emulate press-toolbar-button
	(setq this-command last-command)
	(setq toolbar-active t)
	(set-toolbar-button-down-flag button t)
	))
    ))

(provide 'mew-xemacs)

;;; Copyright Notice:

;; Copyright (C) 1997, 1998 Mew developing team.
;; All rights reserved.

;; Redistribution and use in source and binary forms, with or without
;; modification, are permitted provided that the following conditions
;; are met:
;; 
;; 1. Redistributions of source code must retain the above copyright
;;    notice, this list of conditions and the following disclaimer.
;; 2. Redistributions in binary form must reproduce the above copyright
;;    notice, this list of conditions and the following disclaimer in the
;;    documentation and/or other materials provided with the distribution.
;; 3. All advertising materials mentioning features or use of this software
;;    must display the following acknowledgement:
;;       This product includes software developed by 
;;       Mew developing team and its contributors.
;; 4. Neither the name of the team nor the names of its contributors
;;    may be used to endorse or promote products derived from this software
;;    without specific prior written permission.
;; 
;; THIS SOFTWARE IS PROVIDED BY THE TEAM AND CONTRIBUTORS ``AS IS'' AND
;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
;; PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE TEAM OR CONTRIBUTORS BE
;; LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
;; BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
;; OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
;; IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

;;; mew-xemacs.el ends here