Rework how Gnus is supposed to be able to display all the images in HTML.

shr.el (shr-tag-img): Put a displayer in the text property.
gnus-util.el (gnus-find-text-property-region): New utility function.
gnus-html.el (gnus-html-display-image): Make the alt optional.
gnus-html.el (gnus-html-show-images): Remove.
gnus-art.el (gnus-article-show-images): New, more general function.
gnus-html.el, shr.el: Use image-url instead of gnus-image-url to unify the image url text properties.

diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 74f218aa4bdd3926700ecfe57c127fab1634bbe8..e1265e7cc430261204d9ff283d46431fa63e995a 100644 (file)
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,5 +1,19 @@
 2010-11-15  Lars Magne Ingebrigtsen  <larsi@gnus.org>
 
+       * shr.el (shr-tag-img): Put a displayer in the text property.
+
+       * gnus-util.el (gnus-find-text-property-region): New utility function.
+
+       * gnus-html.el (gnus-html-display-image): Make the alt optional.
+       (gnus-html-show-images): Remove.
+
+       * gnus-art.el (gnus-article-show-images): New, more general function.
+
+       * gnus-html.el: Use image-url instead of gnus-image-url to unify the
+       image url text properties.
+
+       * shr.el: Ditto.
+
        * gnus-agent.el (gnus-agentize): Only do the auto-agentizing if
        gnus-agent-auto-agentize-methods is set.  Which it isn't.
 

diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index a5d9a279ddba4285716073d22a426fdc6db670d5..e2be314f8d19ee1e45c5a44e4303fe2bd0786e63 100644 (file)
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -2271,6 +2271,17 @@ unfolded."
     (dolist (elem gnus-article-image-alist)
       (gnus-delete-images (car elem)))))
 
+(defun gnus-article-show-images ()
+  "Show any images that are in the HTML-rendered article buffer.
+This only works if the article in question is HTML."
+  (interactive)
+  (gnus-with-article-buffer
+    (dolist (region (gnus-find-text-property-region (point-min) (point-max)
+                                                   'image-displayer))
+      (destructuring-bind (start end function) region
+       (funcall function (get-text-property start 'image-url)
+                start end)))))
+
 (defun gnus-article-treat-fold-newsgroups ()
   "Unfold folded message headers.
 Only the headers that fit into the current window width will be

diff --git a/lisp/gnus/gnus-html.el b/lisp/gnus/gnus-html.el
index 46e5881d9fb8b75c42ce8b59665736ac2003eb7f..8274e20c8c13f36b1bc05e4ca8a89fb7d7805c4e 100644 (file)
--- a/lisp/gnus/gnus-html.el
+++ b/lisp/gnus/gnus-html.el
@@ -201,7 +201,7 @@ CHARS is a regexp-like character alternative (e.g., \"[)$]\")."
           (let ((alt-text (when (string-match "\\(alt\\|title\\)=\"\\([^\"]+\\)"
                                               parameters)
                             (xml-substitute-special (match-string 2 parameters)))))
-            (gnus-put-text-property start end 'gnus-image-url url)
+            (gnus-put-text-property start end 'image-url url)
             (if (gnus-html-image-url-blocked-p
                  url
                  (if (buffer-live-p gnus-summary-buffer)
@@ -237,7 +237,7 @@ CHARS is a regexp-like character alternative (e.g., \"[)$]\")."
                                (> width 4)))
                   (gnus-html-display-image url start end alt-text))))))))))
 
-(defun gnus-html-display-image (url start end alt-text)
+(defun gnus-html-display-image (url start end &optional alt-text)
   "Display image at URL on text from START to END.
 Use ALT-TEXT for the image string."
   (if (gnus-html-cache-expired url gnus-html-image-cache-ttl)
@@ -247,7 +247,7 @@ Use ALT-TEXT for the image string."
        (current-buffer)
        (list url alt-text))
     ;; It's already cached, so just insert it.
-    (gnus-html-put-image (gnus-html-get-image-data url) url alt-text)))
+    (gnus-html-put-image (gnus-html-get-image-data url) url (or alt-text "*"))))
 
 (defun gnus-html-wash-tags ()
   (let (tag parameters string start end images url)
@@ -344,7 +344,7 @@ Use ALT-TEXT for the image string."
 (defun gnus-html-browse-image ()
   "Browse the image under point."
   (interactive)
-  (browse-url (get-text-property (point) 'gnus-image-url)))
+  (browse-url (get-text-property (point) 'image-url)))
 
 (defun gnus-html-browse-url ()
   "Browse the image under point."
@@ -415,9 +415,9 @@ Return a string with image data."
   "Put an image with DATA from URL and optional ALT-TEXT."
   (when (gnus-graphic-display-p)
     (let* ((start (text-property-any (point-min) (point-max)
-                                    'gnus-image-url url))
+                                    'image-url url))
            (end (when start
-                  (next-single-property-change start 'gnus-image-url))))
+                  (next-single-property-change start 'image-url))))
       ;; Image found?
       (when start
         (let* ((image
@@ -459,7 +459,7 @@ Return a string with image data."
                                            'gnus-alt-text alt-text)
                     (when url
                       (gnus-put-text-property start (point)
-                                             'gnus-image-url url))
+                                             'image-url url))
                     (gnus-add-image 'external image)
                     t)
                 ;; Bad image, try to show something else
@@ -482,16 +482,6 @@ Return a string with image data."
                     url blocked-images))
     ret))
 
-(defun gnus-html-show-images ()
-  "Show any images that are in the HTML-rendered article buffer.
-This only works if the article in question is HTML."
-  (interactive)
-  (gnus-with-article-buffer
-    (dolist (overlay (overlays-in (point-min) (point-max)))
-      (let ((o (overlay-get overlay 'gnus-image)))
-        (when o
-          (apply 'gnus-html-display-image o))))))
-
 ;;;###autoload
 (defun gnus-html-prefetch-images (summary)
   (when (buffer-live-p summary)

diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index f936127f0de72dbca169245489f8d1871a436199..ff85d45d7b0a08269df55b5cd2d36c183b01c273 100644 (file)
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -2136,7 +2136,7 @@ increase the score of each group you read."
   "d" gnus-article-display-face
   "s" gnus-treat-smiley
   "D" gnus-article-remove-images
-  "W" gnus-html-show-images
+  "W" gnus-article-show-images
   "f" gnus-treat-from-picon
   "m" gnus-treat-mail-picon
   "n" gnus-treat-newsgroups-picon

diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el
index cacca018fd5ed5e96afede40e0496dd2d449e9a3..4e4aab43ba2cc3c04914976383af0ef41be21db5 100644 (file)
--- a/lisp/gnus/gnus-util.el
+++ b/lisp/gnus/gnus-util.el
@@ -277,6 +277,21 @@ Uses `gnus-extract-address-components'."
       (setq start (when end
                    (next-single-property-change start prop))))))
 
+(defun gnus-find-text-property-region (start end prop)
+  "Return a list of text property regions that has property PROP."
+  (let (regions value)
+    (unless (get-text-property start prop)
+      (setq start (next-single-property-change start prop)))
+    (while start
+      (setq value (get-text-property start prop)
+           end (text-property-not-all start (point-max) prop value))
+      (if (not end)
+         (setq start nil)
+       (when value
+         (push (list start end value) regions))
+       (setq start (next-single-property-change start prop))))
+    (nreverse regions)))
+
 (defun gnus-newsgroup-directory-form (newsgroup)
   "Make hierarchical directory name from NEWSGROUP name."
   (let* ((newsgroup (gnus-newsgroup-savable-name newsgroup))

diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el
index 82cfd672be7de91268b68a22b9eaa76f19b93b39..20ce72d8855d8785f11af33930f713b062d29cb8 100644 (file)
--- a/lisp/gnus/gnus.el
+++ b/lisp/gnus/gnus.el
@@ -2876,7 +2876,6 @@ gnus-registry.el will populate this if it's loaded.")
       gnus-start-date-timer gnus-stop-date-timer
       gnus-mime-view-all-parts)
      ("gnus-int" gnus-request-type)
-     ("gnus-html" gnus-html-show-images)
      ("gnus-start" gnus-newsrc-parse-options gnus-1 gnus-no-server-1
       gnus-dribble-enter gnus-read-init-file gnus-dribble-touch
       gnus-check-reasonable-setup)

diff --git a/lisp/gnus/shr.el b/lisp/gnus/shr.el
index d1788c334bc7f902fded6d5a2d3ce348cbb5bdb6..4f3b20531f599e39997461b36f1e98c50cd04d43 100644 (file)
--- a/lisp/gnus/shr.el
+++ b/lisp/gnus/shr.el
@@ -154,7 +154,7 @@ redirects somewhere else."
 (defun shr-browse-image ()
   "Browse the image under point."
   (interactive)
-  (let ((url (get-text-property (point) 'shr-image)))
+  (let ((url (get-text-property (point) 'image-url)))
     (if (not url)
        (message "No image under point")
       (message "Browsing %s..." url)
@@ -163,7 +163,7 @@ redirects somewhere else."
 (defun shr-insert-image ()
   "Insert the image under point into the buffer."
   (interactive)
-  (let ((url (get-text-property (point) 'shr-image)))
+  (let ((url (get-text-property (point) 'image-url)))
     (if (not url)
        (message "No image under point")
       (message "Inserting %s..." url)
@@ -572,7 +572,12 @@ Return a string with image data."
                          t))))
        (put-text-property start (point) 'keymap shr-map)
        (put-text-property start (point) 'shr-alt alt)
-       (put-text-property start (point) 'shr-image url)
+       (put-text-property start (point) 'image-url url)
+       (put-text-property start (point) 'image-displayer
+                          (lambda (url start end)
+                            (url-retrieve url 'shr-image-fetched
+                                          (list (current-buffer) start end)
+                                          t)))
        (put-text-property start (point) 'help-echo alt)
        (setq shr-state 'image)))))