Commit 8b6f6573 authored by Lars Magne Ingebrigtsen's avatar Lars Magne Ingebrigtsen Committed by Katsumi Yamaoka
Browse files

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.
parent 90eef047
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.
 
......
......@@ -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
......
......@@ -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)
......
......@@ -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
......
......@@ -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))
......
......@@ -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)
......
......@@ -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)))))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment