Mercurial > emacs
changeset 110490:7c3194dcf52d
Small url-cache update.
* lisp/url/url-cache.el (url-cache-expire-time): New option.
(url-cache-expired): Rewrite.
author | Glenn Morris <rgm@gnu.org> |
---|---|
date | Wed, 22 Sep 2010 22:56:17 -0700 |
parents | b3141c4861e2 |
children | 3501c2b9e719 |
files | lisp/url/ChangeLog lisp/url/url-cache.el |
diffstat | 2 files changed, 24 insertions(+), 15 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/url/ChangeLog Thu Sep 23 03:57:10 2010 +0000 +++ b/lisp/url/ChangeLog Wed Sep 22 22:56:17 2010 -0700 @@ -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.
--- a/lisp/url/url-cache.el Thu Sep 23 03:57:10 2010 +0000 +++ b/lisp/url/url-cache.el Wed Sep 22 22:56:17 2010 -0700 @@ -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 @@ (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)