[PATCH] Image display in Emacs 21...

[PATCH] Image display in Emacs 21...

[William M. Perry]

Any chance this could be applied?  I sent it quite a while ago, but never
heard anything back.  It should degrade gracefully on Emacs 19 & 20.  And
works great on the alpha of Emacs 21.

-Bill P.

[PATCH] Image display in Emacs 21...

[William M. Perry]

[-- Attachment #1: Type: text/plain, Size: 197 bytes --]

Any chance this could be applied?  I sent it quite a while ago, but never
heard anything back.  It should degrade gracefully on Emacs 19 & 20.  And
works great on the alpha of Emacs 21.

-Bill P.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: emacs21-image.patch --]
[-- Type: text/x-patch, Size: 5024 bytes --]

Index: lisp/mm-decode.el
===================================================================
RCS file: /usr/local/cvsroot/gnus/lisp/mm-decode.el,v
retrieving revision 5.71
diff -u -r5.71 mm-decode.el
--- lisp/mm-decode.el	2000/03/07 14:28:55	5.71
+++ lisp/mm-decode.el	2000/03/14 12:36:17
@@ -28,6 +28,8 @@
 (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")
@@ -730,7 +732,7 @@
   "Return the handle(s) referred to by ID."
   (cdr (assoc id mm-content-id-alist)))
 
-(defun mm-get-image (handle)
+(defun mm-get-image-emacs (handle)
   "Return an image instance based on HANDLE."
   (let ((type (mm-handle-media-subtype handle))
 	spec)
@@ -755,6 +757,36 @@
 			;; (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))))
@@ -769,17 +801,37 @@
 			 (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)))
-    (or mm-inline-large-images
-	(and (< (glyph-width image) (window-pixel-width))
-	     (< (glyph-height image) (window-pixel-height))))))
+    (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."
-  (and (fboundp 'valid-image-instantiator-format-p)
-       (valid-image-instantiator-format-p format)))
+  (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: lisp/mm-view.el
===================================================================
RCS file: /usr/local/cvsroot/gnus/lisp/mm-view.el,v
retrieving revision 5.41
diff -u -r5.41 mm-view.el
--- lisp/mm-view.el	2000/03/13 19:43:14	5.41
+++ lisp/mm-view.el	2000/03/14 12:36:21
@@ -38,8 +38,26 @@
 ;;;
 ;;; 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)
 
-(defun mm-inline-image (handle)
+    (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,6 +71,11 @@
 			 ,(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 ()