[PATCH] image support for Emacs 21.x

[PATCH] image support for Emacs 21.x

[William M. Perry]

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

This adds image support for Emacs 21.x.  You will a _very_ up-to-date
version from CVS, since I just committed the changes to allow reading
images from memory, which this relies on.

I'm attaching a screenshot of a test image I sent myself.

-Bill P.


[-- Attachment #2: emacs21-screenshot.jpg --]
[-- Type: image/jpeg, Size: 139335 bytes --]

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

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