mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2025-01-01 11:14:55 +00:00
Small url-cache update.
* lisp/url/url-cache.el (url-cache-expire-time): New option. (url-cache-expired): Rewrite.
This commit is contained in:
parent
7676efad0e
commit
18d68e52f6
@ -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.
|
||||
|
@ -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)
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user