put-image doesn't take the same parameters as gnus-put-image, so

[gnus] / lisp / gnus-html.el

diff --git a/lisp/gnus-html.el b/lisp/gnus-html.el
index c8aec16..eb35aca 100644 (file)
--- a/lisp/gnus-html.el
+++ b/lisp/gnus-html.el
@@ -105,7 +105,8 @@
        (when (string-match "href=\"\\([^\"]+\\)" parameters)
          (setq parameters (match-string 1 parameters))
          (gnus-article-add-button start end
-                                  'browse-url parameters)
+                                  'browse-url parameters
+                                  parameters)
          (let ((overlay (gnus-make-overlay start end)))
            (gnus-overlay-put overlay 'evaporate t)
            (gnus-overlay-put overlay 'gnus-button-url parameters)
@@ -129,8 +130,10 @@
                   "images" nil "curl"
                   "-s" "--create-dirs"
                   "--location"
+                  "--max-time" "60"
                   "-o" (gnus-html-image-id url)
                   url)))
+    (process-kill-without-query process)
     (set-process-sentinel process 'gnus-html-curl-sentinel)
     (set-process-plist process (list 'images images
                                     'buffer buffer))))
@@ -165,12 +168,14 @@
             ;; Kludge to avoid displaying 30x30 gif images, which
             ;; seems to be a signal of a broken image.
             (not (and (eq (getf (cdr image) :type) 'gif)
-                      (= (car (image-size image t)) 30))))
+                      (= (car (image-size image t)) 30)
+                      (= (cdr (image-size image t)) 30))))
        (progn
          (put-image image point)
          t)
-      (put-image (find-image '((:type xpm :file "lock-broken.xpm")))
-                point)
+      (when (fboundp 'find-image)
+       (put-image (find-image '((:type xpm :file "lock-broken.xpm")))
+                  point))
       nil)))
 
 (defun gnus-html-prune-cache ()
@@ -191,21 +196,31 @@
          (decf total-size (cadr file))
          (delete-file (nth 2 file)))))))
 
-(defun gnus-html-prefetch-images ()
-  (save-match-data
-    (let (urls)
-      (while (re-search-forward "<img.*src=[\"']\\([^\"']+\\)" nil t)
-       (let ((url (match-string 1)))
-         (when (or (null mm-w3m-safe-url-regexp)
-                   (string-match mm-w3m-safe-url-regexp url))
-           (unless (file-exists-p (gnus-html-image-id url))
-             (push url urls)
-             (push (gnus-html-image-id url) urls)
-             (push "-o" urls)))))
-      (apply 'start-process 
-            "images" nil "curl"
-            "-s" "--create-dirs"
-            "--location"
-            urls))))
+;;;###autoload
+(defun gnus-html-prefetch-images (summary)
+  (let (safe-url-regexp urls)
+    (when (buffer-live-p summary)
+      (save-excursion
+       (set-buffer summary)
+       (setq safe-url-regexp mm-w3m-safe-url-regexp))
+      (save-match-data
+       (while (re-search-forward "<img.*src=[\"']\\([^\"']+\\)" nil t)
+         (let ((url (match-string 1)))
+           (when (or (null safe-url-regexp)
+                     (string-match safe-url-regexp url))
+             (unless (file-exists-p (gnus-html-image-id url))
+               (push url urls)
+               (push (gnus-html-image-id url) urls)
+               (push "-o" urls)))))
+       (let ((process
+              (apply 'start-process 
+                     "images" nil "curl"
+                     "-s" "--create-dirs"
+                     "--location"
+                     "--max-time" "60"
+                     urls)))
+         (process-kill-without-query process))))))
+
+(provide 'gnus-html)
 
 ;;; gnus-html.el ends here