X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/84eb0351d8be4811897c8cf62a69757ff5d14001..1c960c45ac19595af7a4a741da7837d2057d977a:/lisp/url/url-cache.el

diff --git a/lisp/url/url-cache.el b/lisp/url/url-cache.el
index 1615920e64..6559de4deb 100644
--- a/lisp/url/url-cache.el
+++ b/lisp/url/url-cache.el
@@ -1,6 +1,6 @@
 ;;; url-cache.el --- Uniform Resource Locator retrieval tool
 
-;; Copyright (C) 1996-1999, 2004-2011  Free Software Foundation, Inc.
+;; Copyright (C) 1996-1999, 2004-2012  Free Software Foundation, Inc.
 
 ;; Keywords: comm, data, processes, hypermedia
 
@@ -192,6 +192,7 @@ Very fast if you have an `md5' primitive function, suitably fast otherwise."
 (defun url-cache-extract (fnam)
   "Extract FNAM from the local disk cache."
   (erase-buffer)
+  (set-buffer-multibyte nil)
   (insert-file-contents-literally fnam))
 
 (defun url-cache-expired (url &optional expire-time)
@@ -208,6 +209,34 @@ If `url-standalone-mode' is non-nil, cached items never expire."
 	    (seconds-to-time (or expire-time url-cache-expire-time)))
 	   (current-time))))))
 
+(defun url-cache-prune-cache (&optional directory)
+  "Remove all expired files from the cache.
+`url-cache-expire-time' says how old a file has to be to be
+considered \"expired\"."
+  (let ((current-time (current-time))
+	(total-files 0)
+	(deleted-files 0))
+    (setq directory (or directory url-cache-directory))
+    (when (file-exists-p directory)
+      (dolist (file (directory-files directory t))
+	(unless (member (file-name-nondirectory file) '("." ".."))
+	  (setq total-files (1+ total-files))
+	  (cond
+	   ((file-directory-p file)
+	    (when (url-cache-prune-cache file)
+	      (setq deleted-files (1+ deleted-files))))
+	   ((time-less-p
+	     (time-add
+	      (nth 5 (file-attributes file))
+	      (seconds-to-time url-cache-expire-time))
+	     current-time)
+	    (delete-file file)
+	    (setq deleted-files (1+ deleted-files))))))
+      (if (< deleted-files total-files)
+	  nil
+	(delete-directory directory)
+	t))))
+
 (provide 'url-cache)
 
 ;;; url-cache.el ends here