Merge branch 'master' of https://git.gnus.org/gnus

diff --combined lisp/ChangeLog
index 14d60bb,08a371f..205e5a0
--- 1/lisp/ChangeLog
--- 2/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@@ -1,9 -1,12 +1,15 @@@
+ 2010-09-01  Teodor Zlatanov  <tzz@lifelogs.com>
+ 
+       * gnus-html.el (gnus-html-wash-tags)
+       (gnus-html-schedule-image-fetching, gnus-html-prefetch-images): Add
+       extra logging.
+ 
  2010-09-01  Lars Magne Ingebrigtsen  <larsi@gnus.org>
  
        * gnus-html.el (gnus-html-wash-tags): Delete the IMG_ALT region. 
 +      (gnus-max-image-proportion): New variable.
 +      (gnus-html-rescale-image): New function.
 +      (gnus-html-put-image): Rescale images.
  
  2010-09-01  Katsumi Yamaoka  <yamaoka@jpl.org>
  

diff --combined lisp/gnus-html.el
index ea5137b,2e44c3f..a89a3f5
--- 1/lisp/gnus-html.el
--- 2/lisp/gnus-html.el
+++ b/lisp/gnus-html.el
@@@ -56,16 -56,6 +56,16 @@@
    :group 'gnus-art
    :type 'regexp)
  
 +(defcustom gnus-max-image-proportion 0.7
 +  "How big pictures displayed are in relation to the window they're in.
 +A value of 0.7 means that they are allowed to take up 70% of the
 +width and height of the window.  If they are larger than this,
 +and Emacs supports it, then the images will be rescaled down to
 +fit these criteria."
 +  :version "24.1"
 +  :group 'gnus-art
 +  :type 'float)
 +
  ;;;###autoload
  (defun gnus-article-html (handle)
    (let ((article-buffer (current-buffer)))
@@@ -117,8 -107,9 +117,9 @@@
        (cond
         ;; Fetch and insert a picture.
         ((equal tag "img_alt")
-       (when (string-match "src=\"\\([^\"]+\\)" parameters)
+         (when (string-match "src=\"\\([^\"]+\\)" parameters)
          (setq url (match-string 1 parameters))
+           (gnus-message 8 "Fetching image URL %s" url)
          (if (string-match "^cid:\\(.*\\)" url)
              ;; URLs with cid: have their content stashed in other
              ;; parts of the MIME structure, so just insert them
@@@ -152,6 -143,7 +153,7 @@@
         ((equal tag "a")
        (when (string-match "href=\"\\([^\"]+\\)" parameters)
          (setq url (match-string 1 parameters))
+           (gnus-message 8 "Fetching link URL %s" url)
          (gnus-article-add-button start end
                                   'browse-url url
                                   url)
@@@ -177,6 -169,7 +179,7 @@@
        (gnus-html-schedule-image-fetching (current-buffer) (nreverse images)))))
  
  (defun gnus-html-schedule-image-fetching (buffer images)
+   (gnus-message 8 "Scheduling image fetching in buffer %s, images %s" buffer images)
    (let* ((url (caar images))
         (process (start-process
                   "images" nil "curl"
@@@ -226,33 -219,13 +229,33 @@@
                           (= (car (image-size image t)) 30)
                           (= (cdr (image-size image t)) 30))))
            (progn
 -            (gnus-put-image image)
 +            (gnus-put-image (gnus-html-rescale-image image))
              t)
          (when (fboundp 'find-image)
            (gnus-put-image (find-image
                             '((:type xpm :file "lock-broken.xpm")))))
          nil)))))
  
 +(defun gnus-html-rescale-image (image)
 +  (if (not (fboundp 'imagemagick-types))
 +      image
 +    (let* ((width (car (image-size image t)))
 +         (height (cdr (image-size image t)))
 +         (edges (window-pixel-edges))
 +         (window-width (truncate (* gnus-max-image-proportion
 +                                    (- (nth 2 edges) (nth 0 edges)))))
 +         (window-height (truncate (* gnus-max-image-proportion
 +                                     (- (nth 3 edges) (nth 1 edges)))))
 +         scaled-image)
 +      (when (> width window-width)
 +      (setq window-height (truncate (* window-height
 +                                       (/ (* 1.0 window-width) width)))))
 +      (if (> height window-height)
 +        (or (create-image file 'imagemagick nil
 +                          :height window-height)
 +            image)
 +      image))))
 +
  (defun gnus-html-prune-cache ()
    (let ((total-size 0)
        files)
@@@ -280,12 -253,13 +283,13 @@@
        (save-match-data
        (while (re-search-forward "<img.*src=[\"']\\([^\"']+\\)" nil t)
          (let ((url (match-string 1)))
-           (when (or (null blocked-images)
-                     (not (string-match blocked-images url)))
-             (unless (file-exists-p (gnus-html-image-id url))
-               (push url urls)
-               (push (gnus-html-image-id url) urls)
-               (push "-o" urls)))))
+           (if (or (null blocked-images)
+                     (not (string-match blocked-images url)))
+                 (unless (file-exists-p (gnus-html-image-id url))
+                   (push url urls)
+                   (push (gnus-html-image-id url) urls)
+                   (push "-o" urls))
+               (gnus-message 8 "Image URL %s is blocked" url))))
        (let ((process
               (apply 'start-process 
                      "images" nil "curl"