(gnus-continuum-version): Make inactive, since it doesn't really

[gnus] / lisp / gnus-html.el

diff --git a/lisp/gnus-html.el b/lisp/gnus-html.el
index f796bde..fee9eee 100644 (file)
--- a/lisp/gnus-html.el
+++ b/lisp/gnus-html.el
@@ -39,11 +39,17 @@
 (require 'browse-url)
 
 (defcustom gnus-html-image-cache-ttl (days-to-time 7)
-  "Time in seconds used to cache the image on disk."
+  "Time used to determine if we should use images from the cache."
   :version "24.1"
   :group 'gnus-art
   :type 'integer)
 
+(defcustom gnus-html-image-automatic-caching t
+  "Whether automatically cache retrieve images."
+  :version "24.1"
+  :group 'gnus-art
+  :type 'boolean)
+
 (defcustom gnus-html-frame-width 70
   "What width to use when rendering HTML."
   :version "24.1"
@@ -56,7 +62,7 @@
   :group 'gnus-art
   :type 'regexp)
 
-(defcustom gnus-max-image-proportion 0.7
+(defcustom gnus-max-image-proportion 0.9
   "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,
@@ -82,9 +88,32 @@ fit these criteria."
     (define-key map [tab] 'widget-forward)
     map))
 
+(eval-and-compile
+  (defalias 'gnus-html-encode-url-chars
+    (if (fboundp 'browse-url-url-encode-chars)
+       'browse-url-url-encode-chars
+      (lambda (text chars)
+       "URL-encode the chars in TEXT that match CHARS.
+CHARS is a regexp-like character alternative (e.g., \"[)$]\")."
+       (let ((encoded-text (copy-sequence text))
+             (s 0))
+         (while (setq s (string-match chars encoded-text s))
+           (setq encoded-text
+                 (replace-match (format "%%%x"
+                                        (string-to-char
+                                         (match-string 0 encoded-text)))
+                                t t encoded-text)
+                 s (1+ s)))
+         encoded-text))))
+  ;; XEmacs does not have window-inside-pixel-edges
+  (defalias 'gnus-window-inside-pixel-edges
+    (if (fboundp 'window-inside-pixel-edges)
+        'window-inside-pixel-edges
+      'window-pixel-edges)))
+
 (defun gnus-html-encode-url (url)
   "Encode URL."
-  (browse-url-url-encode-chars url "[)$ ]"))
+  (gnus-html-encode-url-chars url "[)$ ]"))
 
 (defun gnus-html-cache-expired (url ttl)
   "Check if URL is cached for more than TTL."
@@ -197,7 +226,7 @@ fit these criteria."
                    :keymap gnus-html-image-map
                    :button-keymap gnus-html-image-map)
                   (let ((overlay (gnus-make-overlay start end))
-                        (spec (list url alt-text)))
+                        (spec (list url start end alt-text)))
                     (gnus-overlay-put overlay 'local-map gnus-html-image-map)
                     (gnus-overlay-put overlay 'gnus-image spec)
                     (gnus-put-text-property
@@ -345,14 +374,17 @@ Use ALT-TEXT for the image string."
                   (list buffer image))))
 
 (defun gnus-html-image-fetched (status buffer image)
-  (url-store-in-cache (current-buffer))
-  (when (and (or (search-forward "\n\n" nil t)
-                 (search-forward "\r\n\r\n" nil t))
-             (buffer-live-p buffer))
-    (let ((data (buffer-substring (point) (point-max))))
-      (with-current-buffer buffer
-        (let ((inhibit-read-only t))
-          (gnus-html-put-image data (car image) (cadr image))))))
+  "Callback function called when image has been fetched."
+  (unless (plist-get status :error)
+    (when gnus-html-image-automatic-caching
+      (url-store-in-cache (current-buffer)))
+    (when (and (or (search-forward "\n\n" nil t)
+                   (search-forward "\r\n\r\n" nil t))
+               (buffer-live-p buffer))
+      (let ((data (buffer-substring (point) (point-max))))
+        (with-current-buffer buffer
+          (let ((inhibit-read-only t))
+            (gnus-html-put-image data (car image) (cadr image)))))))
   (kill-buffer (current-buffer)))
 
 (defun gnus-html-get-image-data (url)
@@ -423,7 +455,7 @@ Return a string with image data."
       image
     (let* ((width (car size))
           (height (cdr size))
-          (edges (window-inside-pixel-edges (get-buffer-window (current-buffer))))
+          (edges (gnus-window-inside-pixel-edges (get-buffer-window (current-buffer))))
           (window-width (truncate (* gnus-max-image-proportion
                                      (- (nth 2 edges) (nth 0 edges)))))
           (window-height (truncate (* gnus-max-image-proportion
@@ -468,7 +500,7 @@ This only works if the article in question is HTML."
     (let ((blocked-images (with-current-buffer summary
                             gnus-blocked-images)))
       (save-match-data
-       (while (re-search-forward "<img.*src=[\"']\\([^\"']+\\)" nil t)
+       (while (re-search-forward "<img[^>]+src=[\"']\\([^\"']+\\)" nil t)
          (let ((url (gnus-html-encode-url (match-string 1))))
            (unless (gnus-html-image-url-blocked-p url blocked-images)
               (when (gnus-html-cache-expired url gnus-html-image-cache-ttl)