[gnus git] branch master updated: n0-17-28-g387b3ba =1= shr.el (shr-put-image-function): New variable. (shr-image-fetched, shr-image-displayer, shr-tag-img): Funcall it. (shr-put-image): Return scaled image. gnus-art.el (gnus-shr-put-image): New function. (gnus-article-prepare-display): Bind shr-put-image-function to it. gnus-html.el (gnus-html-wash-images): Register scaled images, not original ones, as deletable.
Katsumi Yamaoka <[email protected]>
| Newsgroups | gmane.emacs.gnus.cvs |
|---|---|
| Message-ID | <[email protected]> |
via 387b3ba7d4c42771d541085cddfc02ebf276521d (commit)
from 43f8466d321c873caa15f169da159de5457ffd7f (commit)
- Log -----------------------------------------------------------------
commit 387b3ba7d4c42771d541085cddfc02ebf276521d
Author: Katsumi Yamaoka <[email protected]>
Date: Tue May 10 03:10:49 2011 +0000
shr.el (shr-put-image-function): New variable.
(shr-image-fetched, shr-image-displayer, shr-tag-img): Funcall it.
(shr-put-image): Return scaled image.
gnus-art.el (gnus-shr-put-image): New function.
(gnus-article-prepare-display): Bind shr-put-image-function to it.
gnus-html.el (gnus-html-wash-images): Register scaled images, not original ones, as deletable.
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index eba5015..49a4776 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,15 @@
+2011-05-10 Katsumi Yamaoka <[email protected]>
+
+ * shr.el (shr-put-image-function): New variable.
+ (shr-image-fetched, shr-image-displayer, shr-tag-img): Funcall it.
+ (shr-put-image): Return scaled image.
+
+ * gnus-art.el (gnus-shr-put-image): New function.
+ (gnus-article-prepare-display): Bind shr-put-image-function to it.
+
+ * gnus-html.el (gnus-html-wash-images): Register scaled images, not
+ original ones, as deletable.
+
2011-05-09 Stefan Monnier <[email protected]>
* nntp.el (nntp-open-connection): Set TCP keepalive option.
diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el
index 690e29c..13531bf 100644
--- a/lisp/gnus-art.el
+++ b/lisp/gnus-art.el
@@ -4656,6 +4656,8 @@ If ALL-HEADERS is non-nil, no headers are hidden."
(gnus-run-hooks 'gnus-article-prepare-hook)
t))))))
+(defvar shr-put-image-function)
+
;;;###autoload
(defun gnus-article-prepare-display ()
"Make the current buffer look like a nice article."
@@ -4669,6 +4671,7 @@ If ALL-HEADERS is non-nil, no headers are hidden."
(setq buffer-read-only nil
gnus-article-wash-types nil
gnus-article-image-alist nil)
+ (set (make-local-variable 'shr-put-image-function) 'gnus-shr-put-image)
(gnus-run-hooks 'gnus-tmp-internal-hook)
(when gnus-display-mime-function
(funcall gnus-display-mime-function))))
@@ -6139,6 +6142,15 @@ Provided for backwards compatibility."
(not gnus-inhibit-hiding))
(gnus-article-hide-headers)))
+(declare-function shr-put-image "shr" (data alt))
+
+(defun gnus-shr-put-image (data alt)
+ "Put image DATA with a string ALT. Enable image to be deleted."
+ (let ((image (shr-put-image data (propertize (or alt "*")
+ 'gnus-image-category 'shr))))
+ (when image
+ (gnus-add-image 'shr image))))
+
;;; Article savers.
(defun gnus-output-to-file (file-name)
diff --git a/lisp/gnus-html.el b/lisp/gnus-html.el
index f380d07..b7f0c09 100644
--- a/lisp/gnus-html.el
+++ b/lisp/gnus-html.el
@@ -215,7 +215,8 @@ CHARS is a regexp-like character alternative (e.g., \"[)$]\")."
(mm-with-part handle (buffer-string))
nil t))))
(if image
- (progn
+ (gnus-add-image
+ 'cid
(gnus-put-image
(gnus-rescale-image
image (gnus-html-maximum-image-size))
@@ -223,8 +224,7 @@ CHARS is a regexp-like character alternative (e.g., \"[)$]\")."
(buffer-substring start end)
(delete-region start end))
"*")
- 'cid)
- (gnus-add-image 'cid image))
+ 'cid))
(widget-convert-button
'link start end
:action 'gnus-html-insert-image
diff --git a/lisp/shr.el b/lisp/shr.el
index 2e7968e..da27edc 100644
--- a/lisp/shr.el
+++ b/lisp/shr.el
@@ -87,6 +87,9 @@ used."
This is used for cid: URLs, and the function is called with the
cid: URL as the argument.")
+(defvar shr-put-image-function 'shr-put-image
+ "Function called to put image and alt string.")
+
(defface shr-strike-through '((t (:strike-through t)))
"Font for <s> elements."
:group 'shr)
@@ -500,10 +503,11 @@ redirects somewhere else."
(inhibit-read-only t))
(delete-region start end)
(goto-char start)
- (shr-put-image data alt)))))))
+ (funcall shr-put-image-function data alt)))))))
(kill-buffer (current-buffer)))
(defun shr-put-image (data alt)
+ "Put image DATA with a string ALT. Return image."
(if (display-graphic-p)
(let ((image (ignore-errors
(shr-rescale-image data))))
@@ -513,7 +517,8 @@ redirects somewhere else."
(when (and (> (current-column) 0)
(> (car (image-size image t)) 400))
(insert "\n"))
- (insert-image image (or alt "*"))))
+ (insert-image image (or alt "*")))
+ image)
(insert alt)))
(defun shr-rescale-image (data)
@@ -576,8 +581,8 @@ START, and END. Note that START and END should be merkers."
(substring url (match-end 0)))))
(when image
(goto-char start)
- (shr-put-image image
- (buffer-substring-no-properties start end))
+ (funcall shr-put-image-function
+ image (buffer-substring-no-properties start end))
(delete-region (point) end))))
(url-retrieve url 'shr-image-fetched
(list (current-buffer) start end)
@@ -864,7 +869,7 @@ ones, in case fg and bg are nil."
(if (or (not shr-content-function)
(not (setq image (funcall shr-content-function url))))
(insert alt)
- (shr-put-image image alt))))
+ (funcall shr-put-image-function image alt))))
((or shr-inhibit-images
(and shr-blocked-images
(string-match shr-blocked-images url)))
@@ -874,7 +879,7 @@ ones, in case fg and bg are nil."
(shr-insert (truncate-string-to-width alt 8))
(shr-insert alt))))
((url-is-cached (shr-encode-url url))
- (shr-put-image (shr-get-image-data url) alt))
+ (funcall shr-put-image-function (shr-get-image-data url) alt))
(t
(insert alt)
(funcall
-----------------------------------------------------------------------
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we listed those
revisions in full, above.
Summary of changes:
lisp/ChangeLog | 12 ++++++++++++
lisp/gnus-art.el | 12 ++++++++++++
lisp/gnus-html.el | 20 ++++++++++----------
lisp/shr.el | 17 +++++++++++------
4 files changed, 45 insertions(+), 16 deletions(-)
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "Gnus Project".
The branch, master has been updated
hooks/post-receive
--
Gnus Project