(eval-when-compile (require 'cl))
(eval-when-compile
(require 'mm-decode)
(require 'mm-view))
(require 'mailcap)
(require 'url-vars)
(require 'url-cookie)
(require 'url-history)
(require 'url-expand)
(require 'url-privacy)
(require 'url-methods)
(require 'url-proxy)
(require 'url-parse)
(require 'url-util)
(defvar url-configuration-directory
(cond
((file-directory-p "~/.url") "~/.url")
((file-directory-p "~/.emacs.d") "~/.emacs.d/url")
(t "~/.url")))
(defun url-do-setup ()
"Setup the url package.
This is to avoid conflict with user settings if URL is dumped with
Emacs."
(unless url-setup-done
(mailcap-parse-mailcaps)
(mailcap-parse-mimetypes)
(url-register-auth-scheme "basic" nil 4)
(url-register-auth-scheme "digest" nil 7)
(setq url-cookie-file
(or url-cookie-file
(expand-file-name "cookies" url-configuration-directory)))
(setq url-history-file
(or url-history-file
(expand-file-name "history" url-configuration-directory)))
(url-history-parse-history)
(url-history-setup-save-timer)
(url-cookie-setup-save-timer)
(url-cookie-parse-file url-cookie-file)
(let ((noproxy (and (not (assoc "no_proxy" url-proxy-services))
(or (getenv "NO_PROXY")
(getenv "no_PROXY")
(getenv "no_proxy")))))
(if noproxy
(setq url-proxy-services
(cons (cons "no_proxy"
(concat "\\("
(mapconcat
(lambda (x)
(cond
((= x ?,) "\\|")
((= x ? ) "")
((= x ?.) (regexp-quote "."))
((= x ?*) ".*")
((= x ??) ".")
(t (char-to-string x))))
noproxy "") "\\)"))
url-proxy-services))))
(url-setup-privacy-info)
(run-hooks 'url-load-hook)
(setq url-setup-done t)))
(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.")
(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. 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 (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."
(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)
(set-text-properties 0 (length url) nil url))
(if (not (vectorp url))
(setq url (url-generic-parse-url url)))
(if (not (functionp callback))
(error "Must provide a callback function to url-retrieve"))
(unless (url-type url)
(error "Bad url: %s" (url-recreate-url url)))
(let ((loader (url-scheme-get-property (url-type url) 'loader))
(url-using-proxy (if (url-host url)
(url-find-proxy-for-url url (url-host url))))
(buffer nil)
(asynch (url-scheme-get-property (url-type url) 'asynchronous-p)))
(if url-using-proxy
(setq asynch t
loader 'url-proxy))
(if asynch
(setq buffer (funcall loader url callback cbargs))
(setq buffer (funcall loader url))
(if buffer
(with-current-buffer buffer
(apply callback cbargs))))
(if url-history-track
(url-history-update-url url (current-time)))
buffer))
(defun url-retrieve-synchronously (url)
"Retrieve URL synchronously.
Return the buffer containing the data, or nil if there are no data
associated with it (the case for dired, info, or mailto URLs that need
no further processing). URL is either a string or a parsed URL."
(url-do-setup)
(lexical-let ((retrieval-done nil)
(asynch-buffer nil))
(setq asynch-buffer
(url-retrieve url (lambda (&rest ignored)
(url-debug 'retrieval "Synchronous fetching done (%S)" (current-buffer))
(setq retrieval-done t
asynch-buffer (current-buffer)))))
(if (null asynch-buffer)
nil
(let ((proc (get-buffer-process asynch-buffer)))
(while (not retrieval-done)
(url-debug 'retrieval
"Spinning in url-retrieve-synchronously: %S (%S)"
retrieval-done asynch-buffer)
(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))
(eq proc (or (get-buffer-process asynch-buffer) proc)))
(setq retrieval-done t))
(unless (or (with-local-quit
(accept-process-output proc))
(null proc))
(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)
(let ((handle (mm-dissect-buffer t)))
(url-mark-buffer-as-dead (current-buffer))
(with-current-buffer
(generate-new-buffer (url-recreate-url url-current-object))
(if (eq (mm-display-part handle) 'external)
(progn
(set-process-sentinel
(get-buffer-process (cdr (mm-handle-undisplayer handle)))
`(lambda (proc event)
(mm-destroy-parts (quote ,handle))))
(message "Viewing externally")
(kill-buffer (current-buffer)))
(display-buffer (current-buffer))
(add-hook 'kill-buffer-hook
`(lambda () (mm-destroy-parts ',handle))
nil
t)))))
(defun url-mm-url (url)
"Retrieve URL and pass to the appropriate viewing application."
(require 'mm-decode)
(require 'mm-view)
(url-retrieve url 'url-mm-callback nil))
(defvar url-dead-buffer-list nil)
(defun url-mark-buffer-as-dead (buff)
(push buff url-dead-buffer-list))
(defun url-gc-dead-buffers ()
(let ((buff))
(while (setq buff (pop url-dead-buffer-list))
(if (buffer-live-p buff)
(kill-buffer buff)))))
(cond
((fboundp 'display-warning)
(defalias 'url-warn 'display-warning))
((fboundp 'warn)
(defun url-warn (class message &optional level)
(warn "(%s/%s) %s" class (or level 'warning) message)))
(t
(defun url-warn (class message &optional level)
(with-current-buffer (get-buffer-create "*URL-WARNINGS*")
(goto-char (point-max))
(save-excursion
(insert (format "(%s/%s) %s\n" class (or level 'warning) message)))
(display-buffer (current-buffer))))))
(provide 'url)