X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-html.el;h=7e13a0bde979c043dfe8f8eff1cb8b2e9adc5da7;hb=d690c9a0370e1a17632f4934bbfaa06349c701b1;hp=d2d8989223a5f9ef7c2811197a6522ebe1ee1ea5;hpb=6d8b33c34a32a6f2d382aa033b00d9b8c6230770;p=gnus diff --git a/lisp/gnus-html.el b/lisp/gnus-html.el index d2d898922..7e13a0bde 100644 --- a/lisp/gnus-html.el +++ b/lisp/gnus-html.el @@ -84,7 +84,7 @@ fit these criteria." (not (eq charset 'ascii))) (mm-decode-coding-region (point-min) (point-max) charset)) (call-process-region (point-min) (point-max) - "w3m" + "w3m" nil article-buffer nil "-halfdump" "-no-cookie" @@ -94,7 +94,7 @@ fit these criteria." "-o" "pre_conv=1" "-t" (format "%s" tab-width) "-cols" (format "%s" gnus-html-frame-width) - "-o" "display_image=off" + "-o" "display_image=on" "-T" "text/html")))) (gnus-html-wash-tags)))) @@ -104,6 +104,9 @@ fit these criteria." (let (tag parameters string start end images url) (mm-url-decode-entities) (goto-char (point-min)) + (while (re-search-forward " *\n" nil t) + (replace-match "" t t)) + (goto-char (point-min)) (while (re-search-forward "<\\([^ />]+\\)\\([^>]*\\)>" nil t) (setq tag (match-string 1) parameters (match-string 2) @@ -119,7 +122,7 @@ fit these criteria." ((equal tag "img_alt") (when (string-match "src=\"\\([^\"]+\\)" parameters) (setq url (match-string 1 parameters)) - (gnus-message 8 "Fetching image URL %s" url) + (gnus-message 8 "gnus-html-wash-tags: 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 @@ -136,26 +139,42 @@ fit these criteria." (delete-region start end) (gnus-put-image image (gnus-string-or string "*"))))) ;; Normal, external URL. - (unless (gnus-html-image-url-blocked-p url gnus-blocked-images) - (let ((file (gnus-html-image-id url))) - (if (file-exists-p file) - ;; It's already cached, so just insert it. - (let ((string (buffer-substring start end))) - ;; Delete the ALT text. - (delete-region start end) - (gnus-html-put-image file (point) string)) - ;; We don't have it, so schedule it for fetching - ;; asynchronously. - (push (list url - (set-marker (make-marker) start) - (point-marker)) - images))))))) + (unless (gnus-html-image-url-blocked-p + url + (if (buffer-live-p gnus-summary-buffer) + (with-current-buffer gnus-summary-buffer + gnus-blocked-images) + gnus-blocked-images)) + (let ((file (gnus-html-image-id url)) + width height) + (when (string-match "height=\"?\\([0-9]+\\)" parameters) + (setq height (string-to-number (match-string 1 parameters)))) + (when (string-match "width=\"?\\([0-9]+\\)" parameters) + (setq width (string-to-number (match-string 1 parameters)))) + ;; Don't fetch images that are really small. They're + ;; probably tracking pictures. + (when (and (or (null height) + (> height 4)) + (or (null width) + (> width 4))) + (if (file-exists-p file) + ;; It's already cached, so just insert it. + (let ((string (buffer-substring start end))) + ;; Delete the ALT text. + (delete-region start end) + (gnus-html-put-image file (point) string)) + ;; 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. ((or (equal tag "a") (equal tag "A")) (when (string-match "href=\"\\([^\"]+\\)" parameters) (setq url (match-string 1 parameters)) - (gnus-message 8 "Fetching link URL %s" url) + (gnus-message 8 "gnus-html-wash-tags: fetching link URL %s" url) (gnus-article-add-button start end 'browse-url url url) @@ -181,7 +200,8 @@ fit these criteria." (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) + (gnus-message 8 "gnus-html-schedule-image-fetching: buffer %s, images %s" + buffer images) (let* ((url (caar images)) (process (start-process "images" nil "curl" @@ -254,17 +274,16 @@ fit these criteria." (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))))) - (or - (cond ((> height window-height) - (create-image file 'imagemagick nil - :height window-height)) - ((> width window-width) - (create-image file 'imagemagick nil - :width window-width))) - image)))) + (when (> height window-height) + (setq image (or (create-image file 'imagemagick nil + :height window-height) + image)) + (when (> (car (image-size image t)) window-width) + (setq image (or + (create-image file 'imagemagick nil + :width window-width) + image)))) + image))) (defun gnus-html-prune-cache () (let ((total-size 0) @@ -284,13 +303,15 @@ fit these criteria." (decf total-size (cadr file)) (delete-file (nth 2 file))))))) - (defun gnus-html-image-url-blocked-p (url blocked-images) "Find out if URL is blocked by BLOCKED-IMAGES." (let ((ret (and blocked-images (string-match blocked-images url)))) - (when ret - (gnus-message 8 "Image URL %s is blocked by gnus-blocked-images regex %s" url blocked-images)) + (if ret + (gnus-message 8 "gnus-html-image-url-blocked-p: %s blocked by regex %s" + url blocked-images) + (gnus-message 9 "gnus-html-image-url-blocked-p: %s passes regex %s" + url blocked-images)) ret)) ;;;###autoload @@ -308,7 +329,7 @@ fit these criteria." (push (gnus-html-image-id url) urls) (push "-o" urls))))) (let ((process - (apply 'start-process + (apply 'start-process "images" nil "curl" "-s" "--create-dirs" "--location"