changeset 111557:8bb6a226933b

Allow gnus-html to register image displayer callbacks. gnus-html.el (gnus-html-wash-images): Register a displayer. gnus-util.el (gnus-find-text-property-region): Return markers.
author Katsumi Yamaoka <yamaoka@jpl.org>
date Tue, 16 Nov 2010 00:04:25 +0000
parents ee13ba492319
children a673d202fe46
files lisp/gnus/ChangeLog lisp/gnus/gnus-html.el lisp/gnus/gnus-util.el
diffstat 3 files changed, 21 insertions(+), 7 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/gnus/ChangeLog	Mon Nov 15 23:45:55 2010 +0000
+++ b/lisp/gnus/ChangeLog	Tue Nov 16 00:04:25 2010 +0000
@@ -1,5 +1,9 @@
 2010-11-15  Lars Magne Ingebrigtsen  <larsi@gnus.org>
 
+	* gnus-html.el (gnus-html-wash-images): Register a displayer.
+
+	* gnus-util.el (gnus-find-text-property-region): Return markers.
+
 	* shr.el (shr-tag-img): Put a displayer in the text property.
 
 	* gnus-util.el (gnus-find-text-property-region): New utility function.
--- a/lisp/gnus/gnus-html.el	Mon Nov 15 23:45:55 2010 +0000
+++ b/lisp/gnus/gnus-html.el	Tue Nov 16 00:04:25 2010 +0000
@@ -189,19 +189,26 @@
 	    (let* ((handle (mm-get-content-id
                             (setq url (match-string 1 url))))
                    (image (when handle
-                            (gnus-create-image (mm-with-part handle (buffer-string))
-                                               nil t))))
+                            (gnus-create-image
+			     (mm-with-part handle (buffer-string))
+			     nil t))))
 	      (when image
                 (let ((string (buffer-substring start end)))
                   (delete-region start end)
-                  (gnus-put-image (gnus-rescale-image image (gnus-html-maximum-image-size))
+                  (gnus-put-image (gnus-rescale-image
+				   image (gnus-html-maximum-image-size))
                                   (gnus-string-or string "*") 'cid)
                   (gnus-add-image 'cid image))))
 	  ;; Normal, external URL.
-          (let ((alt-text (when (string-match "\\(alt\\|title\\)=\"\\([^\"]+\\)"
-                                              parameters)
-                            (xml-substitute-special (match-string 2 parameters)))))
+          (let ((alt-text
+		 (when (string-match "\\(alt\\|title\\)=\"\\([^\"]+\\)"
+				     parameters)
+		   (xml-substitute-special (match-string 2 parameters)))))
             (gnus-put-text-property start end 'image-url url)
+            (gnus-put-text-property
+	     start end 'image-displayer
+	     (lambda (url start end)
+	       (gnus-html-display-image url start end)))
             (if (gnus-html-image-url-blocked-p
                  url
                  (if (buffer-live-p gnus-summary-buffer)
--- a/lisp/gnus/gnus-util.el	Mon Nov 15 23:45:55 2010 +0000
+++ b/lisp/gnus/gnus-util.el	Tue Nov 16 00:04:25 2010 +0000
@@ -288,7 +288,10 @@
       (if (not end)
 	  (setq start nil)
 	(when value
-	  (push (list start end value) regions))
+	  (push (list (set-marker (make-marker) start)
+		      (set-marker (make-marker) end)
+		      value)
+		regions))
 	(setq start (next-single-property-change start prop))))
     (nreverse regions)))