From: Julien Danjou <julien@danjou.info>
Date: Thu, 23 Sep 2010 05:56:17 +0000 (-0700)
Subject: Small url-cache update.
X-Git-Tag: emacs-pretest-24.0.90~104^2~275^2~438^2~47^2~42^2~90
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=18d68e52f698880940afc3debd0072cb07e7e135;p=emacs.git

Small url-cache update.
* lisp/url/url-cache.el (url-cache-expire-time): New option.
(url-cache-expired): Rewrite.
---

diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog
index 9bc9d3110f8..f19c639e930 100644
--- a/lisp/url/ChangeLog
+++ b/lisp/url/ChangeLog
@@ -1,3 +1,8 @@
+2010-09-23  Julien Danjou  <julien@danjou.info>
+
+	* url-cache.el (url-cache-expire-time): New option.
+	(url-cache-expired): Rewrite.
+
 2010-09-19  Julien Danjou  <julien@danjou.info>
 
 	* url-cache.el (url-fetch-from-cache): New function.
diff --git a/lisp/url/url-cache.el b/lisp/url/url-cache.el
index 28d0af761ea..834ad7c2530 100644
--- a/lisp/url/url-cache.el
+++ b/lisp/url/url-cache.el
@@ -32,6 +32,12 @@
   :type 'directory
   :group 'url-file)
 
+(defcustom url-cache-expire-time 3600
+  "Maximum time in seconds to keep the documents cached."
+  :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'."
@@ -186,21 +192,19 @@ Very fast if you have an `md5' primitive function, suitably fast otherwise."
   (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 t if a cached URL is more than EXPIRE-TIME old.
+If EXPIRE-TIME is not set, `url-cache-expire-time' is used instead."
+  (cond (url-standalone-mode
+	 (not (file-exists-p (url-cache-create-filename url))))
+	(t (let ((cache-time (url-is-cached url)))
+	     (if cache-time
+		 (time-less-p
+		  (time-add
+		   (url-is-cached url)
+		   (seconds-to-time (or expire-time url-cache-expire-time)))
+		  (current-time))
+	       t)))))
 
 (provide 'url-cache)