From 8b6f657390dab08e53e2bca366b26d0b57cd1285 Mon Sep 17 00:00:00 2001 From: Lars Magne Ingebrigtsen Date: Mon, 15 Nov 2010 23:45:55 +0000 Subject: [PATCH] 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. --- lisp/gnus/ChangeLog | 14 ++++++++++++++ lisp/gnus/gnus-art.el | 11 +++++++++++ lisp/gnus/gnus-html.el | 24 +++++++----------------- lisp/gnus/gnus-sum.el | 2 +- lisp/gnus/gnus-util.el | 15 +++++++++++++++ lisp/gnus/gnus.el | 1 - lisp/gnus/shr.el | 11 ++++++++--- 7 files changed, 56 insertions(+), 22 deletions(-) diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 74f218aa4bd..e1265e7cc43 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,5 +1,19 @@ 2010-11-15 Lars Magne Ingebrigtsen + * 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 a5d9a279ddb..e2be314f8d1 100644 --- 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 46e5881d9fb..8274e20c8c1 100644 --- 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 f936127f0de..ff85d45d7b0 100644 --- 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 cacca018fd5..4e4aab43ba2 100644 --- 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 82cfd672be7..20ce72d8855 100644 --- 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 d1788c334bc..4f3b20531f5 100644 --- 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))))) -- 2.39.5