;;; mew-xemacs.el --- Environment of XEmacs for Mew ;; Author: Kazu Yamamoto ;; Created: Mar 20, 1997 ;; Revised: Aug 30, 1999 ;;; Code: (defconst mew-xemacs-version "mew-xemacs.el version 0.09") ;; ;; Common ;; (cond ((not mew-icon-p) (defvar mew-icon-directory nil) (defvar mew-icon-separate-spec nil) (defvar mew-icon-blank nil) (defvar mew-icon-audio nil) (defvar mew-icon-image nil) (defvar mew-icon-video nil) (defvar mew-icon-application/postscript nil) (defvar mew-icon-application/octet-stream nil) (defvar mew-icon-message/rfc822 nil) (defvar mew-icon-message/external-body nil) (defvar mew-icon-text nil) (defvar mew-icon-multipart nil) (defvar mew-icon-unknown nil) (defvar mew-summary-toolbar nil) (defvar mew-draft-toolbar nil)) (t (defvar mew-icon-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 (mew-header-p) "Compose Message"] [mew-draft-toolbar-icon-send mew-draft-send-letter (not (mew-header-p)) "Send Message"] [mew-draft-toolbar-icon-cite mew-draft-cite (mew-header-p) "Cite Message"] [mew-draft-toolbar-icon-yank mew-draft-yank (mew-header-p) "Cite Message without Label"] [mew-draft-toolbar-icon-attach mew-draft-prepare-attachments (and (mew-header-p) (not (mew-attach-p))) "Prepare Attachments"] [mew-draft-toolbar-icon-pgp-sign mew-pgp-sign-letter (mew-header-p) "Sign Message with PGP"] [mew-draft-toolbar-icon-pgp-enc mew-pgp-encrypt-letter (mew-header-p) "Encrypt Message with PGP"] [mew-draft-toolbar-icon-pgp-sigenc mew-pgp-sign-encrypt-letter (mew-header-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 () "Call back function for toolbar of Summary mode. If event is button 1, show a part. If event is button 3, show a menu." (interactive) (let* ((msg (mew-summary-message-number)) (part (mew-syntax-number)) (nums (mew-syntax-number-to-nums part)) (button (event-button last-command-event))) (mew-summary-goto-part msg part) (mew-summary-recenter) (cond ((eq button 1) (mew-summary-show-part msg nums)) ((eq button 3) (popup-menu mew-summary-mode-toolbar-menu))))) (defun mew-summary-show-part (msg nums) "Show a part according to the clicked icon." (interactive) (let ((fld (mew-summary-folder-name)) (ofld-msg (mew-current-get 'message)) (buf (buffer-name))) (if (null nums) (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)) nums)) (mew-pop-to-buffer buf))))) (defun mew-draft-button () "Call back function for toolbar of Draft mode. If event is button 1, show a part. If event is button 3, show a menu." (interactive) (let ((nums (mew-syntax-nums)) (button (event-button last-command-event))) (mew-attach-goto-number 'here nums) (cond ((eq button 1) (mew-draft-show-attach nums)) ((eq button 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) "Show a part according to the clicked icon." (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 (and image-extent (glyphp image-extent)) (mew-overlay-delete 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)) (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 (mew-attachdir))) (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) (valid-image-instantiator-format-p 'jpeg)) 'jpeg) ((and (string-match "gif" ct) (valid-image-instantiator-format-p 'gif)) 'gif) ((and (string-match "xbm" ct) (valid-image-instantiator-format-p 'xbm)) 'xbm) ((and (string-match "xpm" ct) (valid-image-instantiator-format-p 'xpm)) 'xpm) ((and (string-match "png" ct) (valid-image-instantiator-format-p '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 (mew-overlay-make (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) "A replacement function 'press-toolbar-button' so that popup menu can be implemented." (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))))) )) ;; end of cond (defmacro mew-summary-toolbar-update () '(if mew-icon-p (set-specifier default-toolbar (cons (current-buffer) mew-summary-toolbar)))) (defmacro mew-draft-toolbar-update () '(if mew-icon-p (set-specifier default-toolbar (cons (current-buffer) mew-draft-toolbar)))) (defvar mew-x-emacs-end-of-message nil) (defvar mew-x-emacs-end-of-part nil) (defmacro mew-message-set-end-of-message () '(progn (if (not (glyphp mew-x-emacs-end-of-message)) (setq mew-x-emacs-end-of-message (make-glyph (vector 'string :data mew-end-of-message-string)))) (mew-overlay-put mew-message-overlay 'begin-glyph mew-x-emacs-end-of-message))) (defmacro mew-message-set-end-of-part () '(progn (if (not (glyphp mew-x-emacs-end-of-part)) (setq mew-x-emacs-end-of-part (make-glyph (vector 'string :data mew-end-of-part-string)))) (mew-overlay-put mew-message-overlay 'begin-glyph mew-x-emacs-end-of-part))) (defmacro mew-message-set-end-of-nil () '(mew-overlay-put mew-message-overlay 'begin-glyph nil)) (provide 'mew-xemacs) ;;; Copyright Notice: ;; Copyright (C) 1997, 1998, 1999 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. 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