Fetch and cache images.

diff --git a/lisp/gnus-html.el b/lisp/gnus-html.el
index 7bef46c..a5a0ae2 100644 (file)
--- a/lisp/gnus-html.el
+++ b/lisp/gnus-html.el
@@ -43,7 +43,7 @@
       (gnus-html-wash-tags))))
 
 (defun gnus-html-wash-tags ()
-  (let (tag parameters string start end)
+  (let (tag parameters string start end images)
     ;;(subst-char-in-region (point-min) (point-max) ?_ ? )
     (goto-char (point-min))
     (while (re-search-forward "<\\([^ />]+\\)\\([^>]*\\)>" nil t)
@@ -57,8 +57,21 @@
       (cond
        ;; Fetch and insert a picture.
        ((equal tag "img_alt")
-       ;;
-       )
+       (when (string-match "src=\"\\([^\"]+\\)" parameters)
+         (setq parameters (match-string 1 parameters))
+         (let ((file (gnus-html-image-id parameters)))
+           (if (file-exists-p file)
+               ;; It's already cached, so just insert it.
+               (progn
+                 (put-image (create-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)))))
        ;; Add a link.
        ((equal tag "a")
        (when (string-match "href=\"\\([^\"]+\\)" parameters)
@@ -73,6 +86,37 @@
        ;; Whatever.  Just ignore the tag.
        (t
        ))
-      (goto-char start))))
+      (goto-char start))
+    (when images
+      (gnus-html-schedule-image-fetching (current-buffer) images))))
+
+(defun gnus-html-schedule-image-fetching (buffer images)
+  (let* ((url (caar images))
+        (process (start-process
+                  "images" nil "curl"
+                  "-s" "--create-dirs"
+                  "-o" (gnus-html-image-id url)
+                  url)))
+    (set-process-sentinel process 'gnus-html-curl-sentinel)
+    (set-process-plist process (list 'images images
+                                    'buffer buffer))))
+
+(defun gnus-html-image-id (url)
+  (expand-file-name (sha1 url) "~/News/html-cache/"))
+
+(defun gnus-html-curl-sentinel (process event)
+  (when (string-match "finished" event)
+    (let* ((images (getf (process-plist process) 'images))
+          (buffer (getf (process-plist process) 'buffer))
+          (spec (pop images))
+          (file (gnus-html-image-id (car spec))))
+      (when (file-exists-p file)
+       (save-excursion
+         (set-buffer buffer)
+         (let ((buffer-read-only nil))
+           (delete-region (cadr spec) (caddr spec))
+           (put-image (create-image file) (cadr spec)))))
+      (when images
+       (gnus-html-schedule-image-fetching buffer images)))))
 
 ;;; gnus-html.el ends here