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.
(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
(> 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)
(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)
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)
"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
(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))
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)
(put-text-property start (point) 'keymap shr-map)
(put-text-property start (point) 'shr-alt alt)
(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)))))