X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fmm-url.el;h=f1c032c8e2009f2bec17ca631ed996fe834e1f6f;hb=9b741e050b400987d68ff761c6cc3276c932839c;hp=23ddee0c0987c5aed99272707c66dcb8edb88977;hpb=7064878d80c116f154853a32b3851403815b054b;p=elisp%2Fgnus.git-
diff --git a/lisp/mm-url.el b/lisp/mm-url.el
index 23ddee0..f1c032c 100644
--- a/lisp/mm-url.el
+++ b/lisp/mm-url.el
@@ -32,6 +32,7 @@
(eval-when-compile (require 'cl))
(require 'mm-util)
+(require 'gnus)
(eval-and-compile
(autoload 'exec-installed-p "path-util"))
@@ -78,6 +79,13 @@
;;; Internal variables
+(defvar mm-url-package-name
+ (gnus-replace-in-string
+ (gnus-replace-in-string gnus-version " v.*$" "")
+ " " "-"))
+
+(defvar mm-url-package-version gnus-version-number)
+
;; Stolen from w3.
(defvar mm-url-html-entities
'(
@@ -266,7 +274,11 @@ This is taken from RFC 2396.")
(insert-file-contents (substring url (1- (match-end 0))))
(mm-url-insert-file-contents-external url))
(mm-url-load-url)
- (let ((name buffer-file-name))
+ (let ((name buffer-file-name)
+ (url-package-name (or mm-url-package-name
+ url-package-name))
+ (url-package-version (or mm-url-package-version
+ url-package-version)))
(prog1
(url-insert-file-contents url)
(save-excursion
@@ -285,20 +297,38 @@ This is taken from RFC 2396.")
args (append mm-url-arguments (list url))))
(apply 'call-process program nil t nil args)))
+(defvar mm-url-timeout 30
+ "The number of seconds before timing out an URL fetch.")
+
+(defvar mm-url-retries 10
+ "The number of retries after timing out when fetching an URL.")
+
(defun mm-url-insert (url &optional follow-refresh)
"Insert the contents from an URL in the current buffer.
If FOLLOW-REFRESH is non-nil, redirect refresh url in META."
- (if follow-refresh
- (save-restriction
- (narrow-to-region (point) (point))
- (mm-url-insert-file-contents url)
- (goto-char (point-min))
- (when (re-search-forward
- "]*URL=\\([^\"]+\\)\"" nil t)
- (let ((url (match-string 1)))
- (delete-region (point-min) (point-max))
- (mm-url-insert url t))))
- (mm-url-insert-file-contents url)))
+ (let ((times mm-url-retries)
+ (done nil)
+ (first t)
+ result)
+ (while (and (not (zerop (decf times)))
+ (not done))
+ (with-timeout (mm-url-timeout)
+ (unless first
+ (message "Trying again (%s)..." (- mm-url-retries times)))
+ (setq first nil)
+ (if follow-refresh
+ (save-restriction
+ (narrow-to-region (point) (point))
+ (mm-url-insert-file-contents url)
+ (goto-char (point-min))
+ (when (re-search-forward
+ "]*URL=\\([^\"]+\\)\"" nil t)
+ (let ((url (match-string 1)))
+ (delete-region (point-min) (point-max))
+ (setq result (mm-url-insert url t)))))
+ (setq result (mm-url-insert-file-contents url)))
+ (setq done t)))
+ result))
(defun mm-url-decode-entities ()
"Decode all HTML entities."