Merge from emacs-23

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

diff --git a/lisp/url/url-cache.el b/lisp/url/url-cache.el
index 4e6a64fb99d5924f9a5595546d78909ad31c0cfb..be2931e090a555da4e32533c5e2472a9d04e867f 100644 (file)
--- a/lisp/url/url-cache.el
+++ b/lisp/url/url-cache.el
@@ -28,10 +28,17 @@
 
 (defcustom url-cache-directory
   (expand-file-name "cache" url-configuration-directory)
-  "*The directory where cache files should be stored."
+  "The directory where cache files should be stored."
   :type 'directory
   :group 'url-file)
 
+(defcustom url-cache-expire-time 3600
+  "Default maximum time in seconds before cache files expire.
+Used by the function `url-cache-expired'."
+  :version "24.1"
+  :type 'integer
+  :group 'url-cache)
+
 ;; Cache manager
 (defun url-cache-file-writable-p (file)
   "Follows the documentation of `file-writable-p', unlike `file-writable-p'."
@@ -68,6 +75,12 @@ FILE can be created or overwritten."
             (let ((coding-system-for-write 'binary))
               (write-region (point-min) (point-max) fname nil 5))))))
 
+(defun url-fetch-from-cache (url)
+  "Fetch URL from cache and return a buffer with the content."
+  (with-current-buffer (generate-new-buffer " *temp*")
+    (url-cache-extract (url-cache-create-filename url))
+    (current-buffer)))
+
 ;;;###autoload
 (defun url-is-cached (url)
   "Return non-nil if the URL is cached.
@@ -82,8 +95,7 @@ The actual return value is the last modification time of the cache file."
 (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
@@ -91,8 +103,7 @@ The actual return value is the last modification time of the cache file."
               (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)))
@@ -141,8 +152,7 @@ The actual return value is the last modification time of the cache file."
 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))
@@ -153,8 +163,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
@@ -163,7 +172,7 @@ Very fast if you have an `md5' primitive function, suitably fast otherwise."
                                url-cache-directory))))))
 
 (defcustom url-cache-creation-function 'url-cache-create-filename-using-md5
-  "*What function to use to create a cached filename."
+  "What function to use to create a cached filename."
   :type '(choice (const :tag "MD5 of filename (low collision rate)"
                        :value url-cache-create-filename-using-md5)
                 (const :tag "Human readable filenames (higher collision rate)"
@@ -172,7 +181,13 @@ 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)
@@ -180,22 +195,19 @@ Very fast if you have an `md5' primitive function, suitably fast otherwise."
   (erase-buffer)
   (insert-file-contents-literally fnam))
 
-;;;###autoload
-(defun url-cache-expired (url mod)
-  "Return t if a cached file has expired."
-  (let* ((urlobj (if (vectorp url) url (url-generic-parse-url url)))
-        (type (url-type urlobj)))
-    (cond
-     (url-standalone-mode
-      (not (file-exists-p (url-cache-create-filename url))))
-     ((string= type "http")
-      t)
-     ((member type '("file" "ftp"))
-      (if (or (equal mod '(0 0)) (not mod))
-         t
-       (or (> (nth 0 mod) (nth 0 (current-time)))
-           (> (nth 1 mod) (nth 1 (current-time))))))
-     (t nil))))
+(defun url-cache-expired (url &optional expire-time)
+  "Return non-nil if a cached URL is older than EXPIRE-TIME seconds.
+The default value of EXPIRE-TIME is `url-cache-expire-time'.
+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)))
+      (or (not cache-time)
+         (time-less-p
+          (time-add
+           cache-time
+           (seconds-to-time (or expire-time url-cache-expire-time)))
+          (current-time))))))
 
 (provide 'url-cache)