* [PATCH] Image display in Emacs 21...
@ 2000-03-14 12:34 William M. Perry
0 siblings, 0 replies; 2+ messages in thread
From: William M. Perry @ 2000-03-14 12:34 UTC (permalink / raw)
[-- 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 ()
^ permalink raw reply [flat|nested] 2+ messages in thread
* [PATCH] Image display in Emacs 21...
@ 2000-03-14 12:34 William M. Perry
0 siblings, 0 replies; 2+ messages in thread
From: William M. Perry @ 2000-03-14 12:34 UTC (permalink / raw)
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.
^ permalink raw reply [flat|nested] 2+ messages in thread
end of thread, other threads:[~2000-03-14 12:34 UTC | newest]
Thread overview: 2+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2000-03-14 12:34 [PATCH] Image display in Emacs 21 William M. Perry
-- strict thread matches above, loose matches on Subject: below --
2000-03-14 12:34 William M. Perry
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for NNTP newsgroup(s).