Merge branch 'master' of https://git.gnus.org/gnus
authorLars Magne Ingebrigtsen <larsi@quimbies.gnus.org>
Tue, 31 Aug 2010 12:49:29 +0000 (14:49 +0200)
committerLars Magne Ingebrigtsen <larsi@quimbies.gnus.org>
Tue, 31 Aug 2010 12:49:29 +0000 (14:49 +0200)
lisp/ChangeLog
lisp/gnus-ems.el
lisp/gnus-html.el

index 7f7a21a..f56530f 100644 (file)
@@ -13,6 +13,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>
 
index efa7414..6b7d6a6 100644 (file)
 
 (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)
index 77cc5dc..542d140 100644 (file)
@@ -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)
        ;; 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.