;;; url.el --- Uniform Resource Locator retrieval tool
;; Copyright (C) 1996, 1997, 1998, 1999, 2001, 2004,
-;; 2005 Free Software Foundation, Inc.
+;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: Bill Perry <wmperry@gnu.org>
;; Keywords: comm, data, processes, hypermedia
;;
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;;
;; GNU Emacs is distributed in the hope that it will be useful,
(require 'url-parse)
(require 'url-util)
-;; Fixme: customize? convert-standard-filename?
-;;;###autoload
-(defvar url-configuration-directory "~/.url")
+
+;; FIXME convert-standard-filename?
+(defcustom url-configuration-directory
+ (if (and (file-directory-p user-emacs-directory)
+ (not (file-directory-p "~/.url")))
+ (expand-file-name "url" user-emacs-directory)
+ "~/.url")
+ "Directory used by the URL package for cookies, history, etc."
+ :type 'directory
+ :group 'url)
(defun url-do-setup ()
"Setup the url package.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Retrieval functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defvar url-redirect-buffer nil
+ "New buffer into which the retrieval will take place.
+Sometimes while retrieving a URL, the URL library needs to use another buffer
+than the one returned initially by `url-retrieve'. In this case, it sets this
+variable in the original buffer as a forwarding pointer.")
+
+;;;###autoload
(defun url-retrieve (url callback &optional cbargs)
"Retrieve URL asynchronously and call CALLBACK with CBARGS when finished.
URL is either a string or a parsed URL.
CALLBACK is called when the object has been completely retrieved, with
the current buffer containing the object, and any MIME headers associated
-with it. Normally it gets the arguments in the list CBARGS.
-However, if what we find is a redirect, CALLBACK is given
-two additional args, `:redirect' and the redirected URL,
-followed by CBARGS.
+with it. It is called as (apply CALLBACK STATUS CBARGS).
+STATUS is a list with an even number of elements representing
+what happened during the request, with most recent events first,
+or an empty list if no events have occurred. Each pair is one of:
+
+\(:redirect REDIRECTED-TO) - the request was redirected to this URL
+\(:error (ERROR-SYMBOL . DATA)) - an error occurred. The error can be
+signaled with (signal ERROR-SYMBOL DATA).
Return the buffer URL will load into, or nil if the process has
-already completed."
+already completed (i.e. URL was a mailto URL or similar; in this case
+the callback is not called).
+
+The variables `url-request-data', `url-request-method' and
+`url-request-extra-headers' can be dynamically bound around the
+request; dynamic binding of other variables doesn't necessarily
+take effect."
+;;; XXX: There is code in Emacs that does dynamic binding
+;;; of the following variables around url-retrieve:
+;;; url-standalone-mode, url-gateway-unplugged, w3-honor-stylesheets,
+;;; url-confirmation-func, url-cookie-multiple-line,
+;;; url-cookie-{{,secure-}storage,confirmation}
+;;; url-standalone-mode and url-gateway-unplugged should work as
+;;; usual. url-confirmation-func is only used in nnwarchive.el and
+;;; webmail.el; the latter should be updated. Is
+;;; url-cookie-multiple-line needed anymore? The other url-cookie-*
+;;; are (for now) only used in synchronous retrievals.
+ (url-retrieve-internal url callback (cons nil cbargs)))
+
+(defun url-retrieve-internal (url callback cbargs)
+ "Internal function; external interface is `url-retrieve'.
+CBARGS is what the callback will actually receive - the first item is
+the list of events, as described in the docstring of `url-retrieve'."
(url-do-setup)
(url-gc-dead-buffers)
(if (stringp url)
(if buffer
(with-current-buffer buffer
(apply callback cbargs))))
- (url-history-update-url url (current-time))
+ (if url-history-track
+ (url-history-update-url url (current-time)))
buffer))
+;;;###autoload
(defun url-retrieve-synchronously (url)
"Retrieve URL synchronously.
Return the buffer containing the data, or nil if there are no data
(url-debug 'retrieval
"Spinning in url-retrieve-synchronously: %S (%S)"
retrieval-done asynch-buffer)
- (if (and proc (memq (process-status proc)
- '(closed exit signal failed)))
- ;; FIXME: It's not clear whether url-retrieve's callback is
- ;; guaranteed to be called or not. It seems that url-http
- ;; decides sometimes consciously not to call it, so it's not
- ;; clear that it's a bug, but even if we need to decide how
- ;; url-http can then warn us that the download has completed.
- ;; In the mean time, we use this here workaround.
- (setq retrieval-done t)
+ (if (buffer-local-value 'url-redirect-buffer asynch-buffer)
+ (setq proc (get-buffer-process
+ (setq asynch-buffer
+ (buffer-local-value 'url-redirect-buffer
+ asynch-buffer))))
+ (if (and proc (memq (process-status proc)
+ '(closed exit signal failed))
+ ;; Make sure another process hasn't been started.
+ (eq proc (or (get-buffer-process asynch-buffer) proc)))
+ ;; FIXME: It's not clear whether url-retrieve's callback is
+ ;; guaranteed to be called or not. It seems that url-http
+ ;; decides sometimes consciously not to call it, so it's not
+ ;; clear that it's a bug, but even then we need to decide how
+ ;; url-http can then warn us that the download has completed.
+ ;; In the mean time, we use this here workaround.
+ ;; XXX: The callback must always be called. Any
+ ;; exception is a bug that should be fixed, not worked
+ ;; around.
+ (progn ;; Call delete-process so we run any sentinel now.
+ (delete-process proc)
+ (setq retrieval-done t)))
;; We used to use `sit-for' here, but in some cases it wouldn't
;; work because apparently pending keyboard input would always
;; interrupt it before it got a chance to handle process input.
;; `sleep-for' was tried but it lead to other forms of
;; hanging. --Stef
- (unless (or (accept-process-output proc) (null proc))
+ (unless (or (with-local-quit
+ (accept-process-output proc))
+ (null proc))
;; accept-process-output returned nil, maybe because the process
- ;; exited (and may have been replaced with another).
- (setq proc (get-buffer-process asynch-buffer))))))
+ ;; exited (and may have been replaced with another). If we got
+ ;; a quit, just stop.
+ (when quit-flag
+ (delete-process proc))
+ (setq proc (and (not quit-flag)
+ (get-buffer-process asynch-buffer)))))))
asynch-buffer)))
(defun url-mm-callback (&rest ignored)
HCoop / bpt / emacs.git / blobdiff