From d1ddeb3c34a100f3d98fae6e1e5c24b8f6092a95 Mon Sep 17 00:00:00 2001
From: Lars Magne Ingebrigtsen <larsi@quimbies.gnus.org>
Date: Sun, 29 Aug 2010 03:47:06 +0200
Subject: [PATCH] Don't download pictures the user hasn't requested. Provide a
 function for pruning the size of the image cache.

---
 lisp/gnus-html.el | 58 +++++++++++++++++++++++++++++++++++------------
 1 file changed, 44 insertions(+), 14 deletions(-)

diff --git a/lisp/gnus-html.el b/lisp/gnus-html.el
index a5a0ae238..3ab16106b 100644
--- a/lisp/gnus-html.el
+++ b/lisp/gnus-html.el
@@ -28,6 +28,16 @@
 
 ;;; Code:
 
+(defcustom gnus-html-cache-directory (nnheader-concat gnus-directory "html-cache/")
+  "Where Gnus will cache images it downloads from the web."
+  :group 'gnus-art
+  :type 'directory)
+
+(defcustom gnus-html-cache-size 500000000
+  "The size of the Gnus image cache."
+  :group 'gnus-art
+  :type 'integer)
+
 ;;;###autoload
 (defun gnus-article-html (handle)
   (let ((article-buffer (current-buffer)))
@@ -59,19 +69,21 @@
        ((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)))))
+	  (when (or (null mm-w3m-safe-url-regexp)
+		    (string-match mm-w3m-safe-url-regexp 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)
@@ -102,7 +114,7 @@
 				     'buffer buffer))))
 
 (defun gnus-html-image-id (url)
-  (expand-file-name (sha1 url) "~/News/html-cache/"))
+  (expand-file-name (sha1 url) gnus-html-cache-directory))
 
 (defun gnus-html-curl-sentinel (process event)
   (when (string-match "finished" event)
@@ -119,4 +131,22 @@
       (when images
 	(gnus-html-schedule-image-fetching buffer images)))))
 
+(defun gnus-html-prune-cache ()
+  (let ((total-size 0)
+	files)
+    (dolist (file (directory-files gnus-html-cache-directory t nil t))
+      (let ((attributes (file-attributes file)))
+	(unless (nth 0 attributes)
+	  (incf total-size (nth 7 attributes))
+	  (push (list (time-to-seconds (nth 5 attributes))
+		      (nth 7 attributes) file)
+		files))))
+    (when (> total-size gnus-html-cache-size)
+      (setq files (sort files (lambda (f1 f2)
+				(< (car f1) (car f2)))))
+      (dolist (file files)
+	(when (> total-size gnus-html-cache-size)
+	  (decf total-size (cadr file))
+	  (delete-file (nth 2 file)))))))
+
 ;;; gnus-html.el ends here
-- 
2.25.1