Mercurial > emacs
changeset 110068:2af503eb57ef
Clarify the code a bit by renaming the variable with the url to `url'; Support cid: URLs/images; by Lars Magne Ingebrigtsen <larsi@gnus.org>.
| author | Katsumi Yamaoka <yamaoka@jpl.org> |
|---|---|
| date | Tue, 31 Aug 2010 13:28:02 +0000 |
| parents | 5cab4c4229ff |
| children | c837e7372468 |
| files | lisp/gnus/ChangeLog lisp/gnus/gnus-ems.el lisp/gnus/gnus-html.el |
| diffstat | 3 files changed, 38 insertions(+), 20 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/gnus/ChangeLog Tue Aug 31 14:22:40 2010 +0200 +++ b/lisp/gnus/ChangeLog Tue Aug 31 13:28:02 2010 +0000 @@ -10,6 +10,9 @@ 2010-08-31 Lars Magne Ingebrigtsen <larsi@gnus.org> * gnus-html.el: require mm-url. + (gnus-html-wash-tags): Clarify the code a bit by renaming the variable + with the url to `url'. + (gnus-html-wash-tags): Support cid: URLs/images. 2010-08-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
--- a/lisp/gnus/gnus-ems.el Tue Aug 31 14:22:40 2010 +0200 +++ b/lisp/gnus/gnus-ems.el Tue Aug 31 13:28:02 2010 +0000 @@ -276,7 +276,7 @@ (defun gnus-put-image (glyph &optional string category) (let ((point (point))) - (insert-image glyph (or string " ")) + (insert-image glyph (or string "*")) (put-text-property point (point) 'gnus-image-category category) (unless string (put-text-property (1- (point)) (point)
--- a/lisp/gnus/gnus-html.el Tue Aug 31 14:22:40 2010 +0200 +++ b/lisp/gnus/gnus-html.el Tue Aug 31 13:28:02 2010 +0000 @@ -72,7 +72,7 @@ (gnus-html-wash-tags)))) (defun gnus-html-wash-tags () - (let (tag parameters string start end images) + (let (tag parameters string start end images url) (mm-url-decode-entities) (goto-char (point-min)) (while (re-search-forward "<\\([^ />]+\\)\\([^>]*\\)>" nil t) @@ -89,31 +89,46 @@ ;; Fetch and insert a picture. ((equal tag "img_alt") (when (string-match "src=\"\\([^\"]+\\)" parameters) - (setq parameters (match-string 1 parameters)) + (setq url (match-string 1 parameters)) (when (or (null mm-w3m-safe-url-regexp) - (string-match mm-w3m-safe-url-regexp parameters)) - (let ((file (gnus-html-image-id parameters))) - (if (file-exists-p file) - ;; It's already cached, so just insert it. - (when (gnus-html-put-image file (point)) - ;; Delete the ALT text. - (delete-region start end)) - ;; We don't have it, so schedule it for fetching - ;; asynchronously. - (push (list parameters - (set-marker (make-marker) start) - (point-marker)) - images)))))) + (string-match mm-w3m-safe-url-regexp url)) + (if (string-match "^cid:\\(.*\\)" url) + ;; URLs with cid: have their content stashed in other + ;; parts of the MIME structure, so just insert them + ;; immediately. + (let ((handle (mm-get-content-id + (setq url (match-string 1 url)))) + image) + (when handle + (mm-with-part handle + (setq image (gnus-create-image (buffer-string) + nil t)))) + (when image + (delete-region start end) + (gnus-put-image image))) + ;; Normal, external URL. + (let ((file (gnus-html-image-id url))) + (if (file-exists-p file) + ;; It's already cached, so just insert it. + (when (gnus-html-put-image file (point)) + ;; Delete the ALT text. + (delete-region start end)) + ;; We don't have it, so schedule it for fetching + ;; asynchronously. + (push (list url + (set-marker (make-marker) start) + (point-marker)) + images))))))) ;; Add a link. ((equal tag "a") (when (string-match "href=\"\\([^\"]+\\)" parameters) - (setq parameters (match-string 1 parameters)) + (setq url (match-string 1 parameters)) (gnus-article-add-button start end - 'browse-url parameters - parameters) + 'browse-url url + url) (let ((overlay (gnus-make-overlay start end))) (gnus-overlay-put overlay 'evaporate t) - (gnus-overlay-put overlay 'gnus-button-url parameters) + (gnus-overlay-put overlay 'gnus-button-url url) (when gnus-article-mouse-face (gnus-overlay-put overlay 'mouse-face gnus-article-mouse-face))))) ;; Whatever. Just ignore the tag.