Index: mm-decode.el =================================================================== RCS file: /usr/local/cvsroot/gnus/lisp/mm-decode.el,v retrieving revision 5.67 diff -c -w -r5.67 mm-decode.el *** mm-decode.el 1999/12/04 16:04:16 5.67 --- mm-decode.el 1999/12/31 16:29:19 *************** *** 28,33 **** --- 28,35 ---- (require 'mailcap) (require 'mm-bodies) + (defvar mm-xemacs-p (string-match "XEmacs" (emacs-version))) + (defgroup mime-display () "Display of MIME in mail and news articles." :link '(custom-manual "(emacs-mime)Customization") *************** *** 723,729 **** "Return the handle(s) referred to by ID." (cdr (assoc id mm-content-id-alist))) ! (defun mm-get-image (handle) "Return an image instance based on HANDLE." (let ((type (mm-handle-media-subtype handle)) spec) --- 725,731 ---- "Return the handle(s) referred to by ID." (cdr (assoc id mm-content-id-alist))) ! (defun mm-get-image-emacs (handle) "Return an image instance based on HANDLE." (let ((type (mm-handle-media-subtype handle)) spec) *************** *** 748,753 **** --- 750,785 ---- ;; (without a ton of work) is to write them ;; out to a file, and then create a file ;; specifier. + (error "Don't know what to do for XBMs right now.")) + (t + (list 'image :type (intern type) :data (buffer-string)))))) + (mm-handle-set-cache handle spec)))))) + + (defun mm-get-image-xemacs (handle) + "Return an image instance based on HANDLE." + (let ((type (mm-handle-media-subtype handle)) + spec) + ;; Allow some common translations. + (setq type + (cond + ((equal type "x-pixmap") + "xpm") + ((equal type "x-xbitmap") + "xbm") + (t type))) + (or (mm-handle-cache handle) + (mm-with-unibyte-buffer + (mm-insert-part handle) + (prog1 + (setq spec + (ignore-errors + (cond + ((equal type "xbm") + ;; xbm images require special handling, since + ;; the only way to create glyphs from these + ;; (without a ton of work) is to write them + ;; out to a file, and then create a file + ;; specifier. (let ((file (make-temp-name (expand-file-name "emm.xbm" mm-tmp-directory)))) *************** *** 762,778 **** (vector (intern type) :data (buffer-string))))))) (mm-handle-set-cache handle spec)))))) (defun mm-image-fit-p (handle) "Say whether the image in HANDLE will fit the current window." (let ((image (mm-get-image handle))) (or mm-inline-large-images (and (< (glyph-width image) (window-pixel-width)) ! (< (glyph-height image) (window-pixel-height)))))) (defun mm-valid-image-format-p (format) "Say whether FORMAT can be displayed natively by Emacs." ! (and (fboundp 'valid-image-instantiator-format-p) ! (valid-image-instantiator-format-p format))) (defun mm-valid-and-fit-image-p (format handle) "Say whether FORMAT can be displayed natively and HANDLE fits the window." --- 794,830 ---- (vector (intern type) :data (buffer-string))))))) (mm-handle-set-cache handle spec)))))) + (defun mm-get-image (handle) + (if mm-xemacs-p + (mm-get-image-xemacs handle) + (mm-get-image-emacs handle))) + (defun mm-image-fit-p (handle) "Say whether the image in HANDLE will fit the current window." (let ((image (mm-get-image handle))) + (if (fboundp 'glyph-width) + ;; XEmacs' glyphs can actually tell us about their width, so + ;; lets be nice and smart about them. (or mm-inline-large-images (and (< (glyph-width image) (window-pixel-width)) ! (< (glyph-height image) (window-pixel-height)))) ! ;; Let's just inline everything under Emacs 21, since the image ! ;; specification there doesn't actually get the width/height ! ;; until you render the image. ! t))) (defun mm-valid-image-format-p (format) "Say whether FORMAT can be displayed natively by Emacs." ! (cond ! ;; Handle XEmacs ! ((fboundp 'valid-image-instantiator-format-p) ! (valid-image-instantiator-format-p format)) ! ;; Handle Emacs 21 ! ((fboundp 'image-type-available-p) ! (image-type-available-p format)) ! ;; Nobody else can do images yet. ! (t ! nil))) (defun mm-valid-and-fit-image-p (format handle) "Say whether FORMAT can be displayed natively and HANDLE fits the window." Index: mm-view.el =================================================================== RCS file: /usr/local/cvsroot/gnus/lisp/mm-view.el,v retrieving revision 5.40 diff -c -w -r5.40 mm-view.el *** mm-view.el 1999/12/12 17:33:18 5.40 --- mm-view.el 1999/12/31 16:29:19 *************** *** 38,45 **** ;;; ;;; Functions for displaying various formats inline ;;; ! (defun mm-inline-image (handle) (let ((b (point)) (annot (make-annotation (mm-get-image handle) nil 'text)) buffer-read-only) --- 38,63 ---- ;;; ;;; Functions for displaying various formats inline ;;; + (defun mm-inline-image-emacs (handle) + (let ((b (point)) + (overlay nil) + (string (copy-sequence "[MM-INLINED-IMAGE]")) + buffer-read-only) + (insert "\n") + (buffer-name) + (setq overlay (make-overlay (point) (point) (current-buffer))) + (put-text-property 0 (length string) 'display (mm-get-image handle) string) + (overlay-put overlay 'before-string string) ! (mm-handle-set-undisplayer ! handle ! `(lambda () ! (let (buffer-read-only) ! (delete-overlay ,overlay) ! (delete-region ,(set-marker (make-marker) b) ! ,(set-marker (make-marker) (point)))))))) ! ! (defun mm-inline-image-xemacs (handle) (let ((b (point)) (annot (make-annotation (mm-get-image handle) nil 'text)) buffer-read-only) *************** *** 53,58 **** --- 71,81 ---- ,(set-marker (make-marker) (point)))))) (set-extent-property annot 'mm t) (set-extent-property annot 'duplicable t))) + + (defun mm-inline-image (handle) + (if mm-xemacs-p + (mm-inline-image-xemacs handle) + (mm-inline-image-emacs handle))) (defvar mm-w3-setup nil) (defun mm-setup-w3 ()