]> code.delx.au - gnu-emacs/blobdiff - lisp/url/url-cache.el
* lisp/url/url-misc.el (url-do-terminal-emulator): Use make-term
[gnu-emacs] / lisp / url / url-cache.el
index 1615920e64ca506f78a490f327f612d02c9e7a1d..6559de4deb721bb9f0a42b487dff3ff3c84f37a8 100644 (file)
@@ -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