* lisp/url/url-misc.el (url-do-terminal-emulator): Use make-term

[gnu-emacs] / lisp / url / url-cache.el

diff --git a/lisp/url/url-cache.el b/lisp/url/url-cache.el
index 22095eb631d3f07ed62419aa15bf5c2cc5b17dc6..6559de4deb721bb9f0a42b487dff3ff3c84f37a8 100644 (file)
--- a/lisp/url/url-cache.el
+++ b/lisp/url/url-cache.el
@@ -1,7 +1,6 @@
 ;;; url-cache.el --- Uniform Resource Locator retrieval tool
 
-;; Copyright (C) 1996, 1997, 1998, 1999, 2004, 2005, 2006, 2007, 2008,
-;;   2009, 2010  Free Software Foundation, Inc.
+;; Copyright (C) 1996-1999, 2004-2012  Free Software Foundation, Inc.
 
 ;; Keywords: comm, data, processes, hypermedia
 
@@ -33,7 +32,8 @@
   :group 'url-file)
 
 (defcustom url-cache-expire-time 3600
-  "Maximum time in seconds to keep the documents cached."
+  "Default maximum time in seconds before cache files expire.
+Used by the function `url-cache-expired'."
   :version "24.1"
   :type 'integer
   :group 'url-cache)
@@ -82,7 +82,8 @@ FILE can be created or overwritten."
 
 ;;;###autoload
 (defun url-is-cached (url)
-  "Return non-nil if the URL is cached."
+  "Return non-nil if the URL is cached.
+The actual return value is the last modification time of the cache file."
   (let* ((fname (url-cache-create-filename url))
         (attribs (file-attributes fname)))
     (and fname                         ; got a filename
@@ -93,8 +94,7 @@ FILE can be created or overwritten."
 (defun url-cache-create-filename-human-readable (url)
   "Return a filename in the local cache for URL."
   (if url
-      (let* ((url (if (vectorp url) (url-recreate-url url) url))
-            (urlobj (url-generic-parse-url url))
+      (let* ((urlobj (url-generic-parse-url url))
             (protocol (url-type urlobj))
             (hostname (url-host urlobj))
             (host-components
@@ -102,8 +102,7 @@ FILE can be created or overwritten."
               (user-real-login-name)
               (cons (or protocol "file")
                     (reverse (split-string (or hostname "localhost")
-                                           (eval-when-compile
-                                             (regexp-quote ".")))))))
+                                           "\\.")))))
             (fname    (url-filename urlobj)))
        (if (and fname (/= (length fname) 0) (= (aref fname 0) ?/))
            (setq fname (substring fname 1 nil)))
@@ -152,8 +151,7 @@ FILE can be created or overwritten."
 Very fast if you have an `md5' primitive function, suitably fast otherwise."
   (require 'md5)
   (if url
-      (let* ((url (if (vectorp url) (url-recreate-url url) url))
-            (checksum (md5 url))
+      (let* ((checksum (md5 url))
             (urlobj (url-generic-parse-url url))
             (protocol (url-type urlobj))
             (hostname (url-host urlobj))
@@ -164,8 +162,7 @@ Very fast if you have an `md5' primitive function, suitably fast otherwise."
                     (nreverse
                      (delq nil
                            (split-string (or hostname "localhost")
-                                         (eval-when-compile
-                                           (regexp-quote "."))))))))
+                                         "\\."))))))
             (fname    (url-filename urlobj)))
        (and fname
             (expand-file-name checksum
@@ -183,12 +180,19 @@ Very fast if you have an `md5' primitive function, suitably fast otherwise."
   :group 'url-cache)
 
 (defun url-cache-create-filename (url)
-  (funcall url-cache-creation-function url))
+  (funcall url-cache-creation-function
+           ;; We need to parse+recreate in order to remove the default port
+           ;; if it has been specified: e.g. http://www.example.com:80 will
+           ;; be transcoded as http://www.example.com
+           (url-recreate-url
+            (if (vectorp url) url
+              (url-generic-parse-url url)))))
 
 ;;;###autoload
 (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)
@@ -198,14 +202,41 @@ If `url-standalone-mode' is non-nil, cached items never expire."
   (if url-standalone-mode
       (not (file-exists-p (url-cache-create-filename url)))
     (let ((cache-time (url-is-cached url)))
-      (and cache-time
-          (time-less-p
-           (time-add
-            cache-time
-            (seconds-to-time (or expire-time url-cache-expire-time)))
-           (current-time))))))
+      (or (not cache-time)
+         (time-less-p
+          (time-add
+           cache-time
+           (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)
 
-;; arch-tag: 95b050a6-8e81-4f23-8e63-191b9d1d657c
 ;;; url-cache.el ends here