From mboxrd@z Thu Jan  1 00:00:00 1970
X-Msuck: nntp://news.gmane.io/gmane.emacs.gnus.general/29502
Path: main.gmane.org!not-for-mail
From: wmperry@aventail.com (William M. Perry)
Newsgroups: gmane.emacs.gnus.general
Subject: [PATCH] Image display in Emacs 21...
Date: Tue, 14 Mar 2000 07:34:46 -0500
Sender: owner-ding@hpc.uh.edu
Message-ID: <200003141234.HAA02355@localhost.localdomain>
Reply-To: wmperry@aventail.com
NNTP-Posting-Host: coloc-standby.netfonds.no
Mime-Version: 1.0
Content-Type: multipart/mixed; boundary="=-=-="
X-Trace: main.gmane.org 1035166161 3108 80.91.224.250 (21 Oct 2002 02:09:21 GMT)
X-Complaints-To: usenet@main.gmane.org
NNTP-Posting-Date: Mon, 21 Oct 2002 02:09:21 +0000 (UTC)
Return-Path: <owner-ding@hpc.uh.edu>
Original-Received: from lisa.math.uh.edu (lisa.math.uh.edu [129.7.128.49])
	by mailhost.sclp.com (Postfix) with ESMTP id 8A435D051E
	for <jason@mailhost.sclp.com>; Tue, 14 Mar 2000 07:37:38 -0500 (EST)
Original-Received: from sina.hpc.uh.edu (lists@Sina.HPC.UH.EDU [129.7.3.5])
	by lisa.math.uh.edu (8.9.1/8.9.1) with ESMTP id GAB17714;
	Tue, 14 Mar 2000 06:37:30 -0600 (CST)
Original-Received: by sina.hpc.uh.edu (TLB v0.09a (1.20 tibbs 1996/10/09 22:03:07)); Tue, 14 Mar 2000 06:37:06 -0600 (CST)
Original-Received: from mailhost.sclp.com (postfix@sclp3.sclp.com [204.252.123.139])
	by sina.hpc.uh.edu (8.9.3/8.9.3) with ESMTP id GAA24613
	for <ding@hpc.uh.edu>; Tue, 14 Mar 2000 06:36:51 -0600 (CST)
Original-Received: from localhost.localdomain (dial487.bton.kiva.net [216.9.129.231])
	by mailhost.sclp.com (Postfix) with ESMTP id B969CD051F
	for <ding@gnus.org>; Tue, 14 Mar 2000 07:35:42 -0500 (EST)
Original-Received: (from wmperry@localhost)
	by localhost.localdomain (8.9.3/8.8.7) id HAA02355;
	Tue, 14 Mar 2000 07:34:46 -0500
X-Authentication-Warning: localhost.localdomain: wmperry set sender to wmperry@aventail.com using -f
Original-To: ding@gnus.org
X-Face: O~Rn;(l][/-o1sALg4A@xpE:9-"'IR[%;,,!m7</SYF`{vYQ(&RI1&EiH[FvT;J}@f!4kfz
 x_!Y#=y{Uuj9GvUi=cPuajQ(Z42R[wE@{G,sn$qGr5g/wnb*"*ktI+,CD}1Z'wxrM2ag-r0p5I6\nA
 [WJopW_J.WY;
Original-Lines: 167
Precedence: list
X-Majordomo: 1.94.jlt7
Xref: main.gmane.org gmane.emacs.gnus.general:29502
X-Report-Spam: http://spam.gmane.org/gmane.emacs.gnus.general:29502

--=-=-=

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.


--=-=-=
Content-Type: text/x-patch
Content-Disposition: attachment; filename=emacs21-image.patch

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 ()

--=-=-=--