Mercurial > emacs
changeset 111556:ee13ba492319
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.
| author | Katsumi Yamaoka <yamaoka@jpl.org> |
|---|---|
| date | Mon, 15 Nov 2010 23:45:55 +0000 |
| parents | 762d888ceed2 |
| children | 8bb6a226933b |
| files | lisp/gnus/ChangeLog lisp/gnus/gnus-art.el lisp/gnus/gnus-html.el lisp/gnus/gnus-sum.el lisp/gnus/gnus-util.el lisp/gnus/gnus.el lisp/gnus/shr.el |
| diffstat | 7 files changed, 56 insertions(+), 22 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/gnus/ChangeLog Mon Nov 15 22:12:43 2010 +0000 +++ b/lisp/gnus/ChangeLog Mon Nov 15 23:45:55 2010 +0000 @@ -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.
--- a/lisp/gnus/gnus-art.el Mon Nov 15 22:12:43 2010 +0000 +++ b/lisp/gnus/gnus-art.el Mon Nov 15 23:45:55 2010 +0000 @@ -2271,6 +2271,17 @@ (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
--- a/lisp/gnus/gnus-html.el Mon Nov 15 22:12:43 2010 +0000 +++ b/lisp/gnus/gnus-html.el Mon Nov 15 23:45:55 2010 +0000 @@ -201,7 +201,7 @@ (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 @@ (> 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 @@ (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 @@ (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 @@ "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 @@ '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 @@ 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)
--- a/lisp/gnus/gnus-sum.el Mon Nov 15 22:12:43 2010 +0000 +++ b/lisp/gnus/gnus-sum.el Mon Nov 15 23:45:55 2010 +0000 @@ -2136,7 +2136,7 @@ "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
--- a/lisp/gnus/gnus-util.el Mon Nov 15 22:12:43 2010 +0000 +++ b/lisp/gnus/gnus-util.el Mon Nov 15 23:45:55 2010 +0000 @@ -277,6 +277,21 @@ (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))
--- a/lisp/gnus/gnus.el Mon Nov 15 22:12:43 2010 +0000 +++ b/lisp/gnus/gnus.el Mon Nov 15 23:45:55 2010 +0000 @@ -2876,7 +2876,6 @@ 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)
--- a/lisp/gnus/shr.el Mon Nov 15 22:12:43 2010 +0000 +++ b/lisp/gnus/shr.el Mon Nov 15 23:45:55 2010 +0000 @@ -154,7 +154,7 @@ (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 @@ (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 @@ 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)))))