summaryrefslogtreecommitdiff
path: root/lisp/url
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/url')
-rw-r--r--lisp/url/ChangeLog.12
-rw-r--r--lisp/url/url-auth.el8
-rw-r--r--lisp/url/url-cookie.el10
-rw-r--r--lisp/url/url-dav.el17
-rw-r--r--lisp/url/url-handlers.el10
-rw-r--r--lisp/url/url-history.el16
-rw-r--r--lisp/url/url-http.el25
-rw-r--r--lisp/url/url-mailto.el6
-rw-r--r--lisp/url/url-news.el7
-rw-r--r--lisp/url/url-proxy.el10
-rw-r--r--lisp/url/url-util.el9
-rw-r--r--lisp/url/url-vars.el9
-rw-r--r--lisp/url/url.el135
13 files changed, 116 insertions, 148 deletions
diff --git a/lisp/url/ChangeLog.1 b/lisp/url/ChangeLog.1
index 5a3bf3afd1a..cdd37a64cdd 100644
--- a/lisp/url/ChangeLog.1
+++ b/lisp/url/ChangeLog.1
@@ -2337,7 +2337,7 @@
recurse when retrieving the property lists. Returns an assoc
list keyed off of the resource, the cdr of which is a property list.
(url-dav-datatype-attribute): We support the XML-Data note
- (http://www.w3.org/TR/1998/NOTE-XML-data) to figure out what the
+ (https://www.w3.org/TR/1998/NOTE-XML-data) to figure out what the
datatypes of attributes are. Currently only date, dateTime, int,
number, float, boolean, and uri are supported.
diff --git a/lisp/url/url-auth.el b/lisp/url/url-auth.el
index f291414e81b..06cfacc99d6 100644
--- a/lisp/url/url-auth.el
+++ b/lisp/url/url-auth.el
@@ -102,10 +102,10 @@ instead of the filename inheritance method."
(byserv
(setq retval (cdr-safe (assoc file byserv)))
(if (and (not retval)
- (string-match "/" file))
+ (string-search "/" file))
(while (and byserv (not retval))
(setq data (car (car byserv)))
- (if (or (not (string-match "/" data)) ; It's a realm - take it!
+ (if (or (not (string-search "/" data)) ; It's a realm - take it!
(and
(>= (length file) (length data))
(string= data (substring file 0 (length data)))))
@@ -251,12 +251,12 @@ a match."
(assoc dirkey keylist)
;; No exact match found. Continue to look for partial match if
;; dirkey is not a realm.
- (and (string-match "/" dirkey)
+ (and (string-search "/" dirkey)
(let (match)
(while (and (null match) keylist)
(if (or
;; Any realm candidate matches. Why?
- (not (string-match "/" (caar keylist)))
+ (not (string-search "/" (caar keylist)))
;; Parent directory matches.
(string-prefix-p (caar keylist) dirkey))
(setq match (car keylist))
diff --git a/lisp/url/url-cookie.el b/lisp/url/url-cookie.el
index 085159cb500..60388df2554 100644
--- a/lisp/url/url-cookie.el
+++ b/lisp/url/url-cookie.el
@@ -60,7 +60,7 @@
(defcustom url-cookie-multiple-line nil
"If nil, HTTP requests put all cookies for the server on one line.
-Some web servers, such as http://www.hotmail.com/, only accept cookies
+Some web servers, such as https://www.hotmail.com/, only accept cookies
when they are on one line. This is broken behavior, but just try
telling Microsoft that."
:type 'boolean
@@ -358,10 +358,10 @@ i.e. 1970-1-1) are loaded as expiring one year from now instead."
Default is 1 hour. Note that if you change this variable outside of
the `customize' interface after `url-do-setup' has been run, you need
to run the `url-cookie-setup-save-timer' function manually."
- :set #'(lambda (var val)
- (set-default var val)
- (if (bound-and-true-p url-setup-done)
- (url-cookie-setup-save-timer)))
+ :set (lambda (var val)
+ (set-default var val)
+ (if (bound-and-true-p url-setup-done)
+ (url-cookie-setup-save-timer)))
:type 'integer
:group 'url-cookie)
diff --git a/lisp/url/url-dav.el b/lisp/url/url-dav.el
index edb1c1de9fc..192b1ac4f41 100644
--- a/lisp/url/url-dav.el
+++ b/lisp/url/url-dav.el
@@ -43,22 +43,11 @@
(defvar url-http-response-status)
(defvar url-http-end-of-headers)
-(defun url-intersection (l1 l2)
- "Return a list of the elements occurring in both of the lists L1 and L2."
- (if (null l2)
- l2
- (let (result)
- (while l1
- (if (member (car l1) l2)
- (setq result (cons (pop l1) result))
- (pop l1)))
- (nreverse result))))
-
;;;###autoload
(defun url-dav-supported-p (url)
"Return WebDAV protocol version supported by URL.
Returns nil if WebDAV is not supported."
- (url-intersection url-dav-supported-protocols
+ (seq-intersection url-dav-supported-protocols
(plist-get (url-http-options url) 'dav)))
(defun url-dav-node-text (node)
@@ -910,7 +899,9 @@ Returns nil if URL contains no name starting with FILE."
t)))
-;;; Miscellaneous stuff.
+;;; Obsolete.
+
+(define-obsolete-function-alias 'url-intersection #'seq-intersection "28.1")
(provide 'url-dav)
diff --git a/lisp/url/url-handlers.el b/lisp/url/url-handlers.el
index 68556d6aa9c..ed0402a5137 100644
--- a/lisp/url/url-handlers.el
+++ b/lisp/url/url-handlers.el
@@ -102,7 +102,15 @@
;;;###autoload
(define-minor-mode url-handler-mode
- "Toggle using `url' library for URL filenames (URL Handler mode)."
+ "Handle URLs as if they were file names throughout Emacs.
+After switching on this minor mode, Emacs file primitives handle
+URLs. For instance:
+
+ (file-exists-p \"https://www.gnu.org/\")
+ => t
+
+and `C-x C-f https://www.gnu.org/ RET' will give you the HTML at
+that URL in a buffer."
:global t :group 'url
;; Remove old entry, if any.
(setq file-name-handler-alist
diff --git a/lisp/url/url-history.el b/lisp/url/url-history.el
index 10238a46607..5dd1f099136 100644
--- a/lisp/url/url-history.el
+++ b/lisp/url/url-history.el
@@ -38,10 +38,10 @@
If non-nil, the URL package will keep track of all the URLs visited.
If set to t, then the list is saved to disk at the end of each Emacs
session."
- :set #'(lambda (var val)
- (set-default var val)
- (and (bound-and-true-p url-setup-done)
- (url-history-setup-save-timer)))
+ :set (lambda (var val)
+ (set-default var val)
+ (and (bound-and-true-p url-setup-done)
+ (url-history-setup-save-timer)))
:type '(choice (const :tag "off" nil)
(const :tag "on" t)
(other :tag "within session" session))
@@ -59,10 +59,10 @@ is parsed at startup and used to provide URL completion."
Default is 1 hour. Note that if you change this variable outside of
the `customize' interface after `url-do-setup' has been run, you need
to run the `url-history-setup-save-timer' function manually."
- :set #'(lambda (var val)
- (set-default var val)
- (if (bound-and-true-p url-setup-done)
- (url-history-setup-save-timer)))
+ :set (lambda (var val)
+ (set-default var val)
+ (if (bound-and-true-p url-setup-done)
+ (url-history-setup-save-timer)))
:type 'integer
:group 'url-history)
diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el
index 8cebd4e79f6..ba13a17a8fc 100644
--- a/lisp/url/url-http.el
+++ b/lisp/url/url-http.el
@@ -1292,7 +1292,7 @@ passing it an updated value of CBARGS as arguments. The first
element in CBARGS should be a plist describing what has happened
so far during the request, as described in the docstring of
`url-retrieve' (if in doubt, specify nil). The current buffer
-then CALLBACK is executed is the retrieval buffer.
+when CALLBACK is executed is the retrieval buffer.
Optional arg RETRY-BUFFER, if non-nil, specifies the buffer of a
previous `url-http' call, which is being re-attempted.
@@ -1494,17 +1494,18 @@ The return value of this function is the retrieval buffer."
;; Sometimes we get a zero-length data chunk after the process has
;; been changed to 'free', which means it has no buffer associated
;; with it. Do nothing if there is no buffer, or 0 length data.
- (and (process-buffer proc)
- (/= (length data) 0)
- (with-current-buffer (process-buffer proc)
- (url-http-debug "Calling after change function `%s' for `%S'" url-http-after-change-function proc)
- (funcall url-http-after-change-function
- (point-max)
- (progn
- (goto-char (point-max))
- (insert data)
- (point-max))
- (length data)))))
+ (let ((b (process-buffer proc)))
+ (when (and (buffer-live-p b) (not (zerop (length data))))
+ (with-current-buffer b
+ (url-http-debug "Calling after change function `%s' for `%S'"
+ url-http-after-change-function proc)
+ (funcall url-http-after-change-function
+ (point-max)
+ (progn
+ (goto-char (point-max))
+ (insert data)
+ (point-max))
+ (length data))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; file-name-handler stuff from here on out
diff --git a/lisp/url/url-mailto.el b/lisp/url/url-mailto.el
index 72884c07cc9..4fd631d2955 100644
--- a/lisp/url/url-mailto.el
+++ b/lisp/url/url-mailto.el
@@ -1,4 +1,4 @@
-;;; url-mail.el --- Mail Uniform Resource Locator retrieval code -*- lexical-binding: t; -*-
+;;; url-mailto.el --- Mail Uniform Resource Locator retrieval code -*- lexical-binding: t; -*-
;; Copyright (C) 1996-1999, 2004-2021 Free Software Foundation, Inc.
@@ -104,8 +104,8 @@
(or (search-forward (concat "\n" mail-header-separator "\n") nil t)
(goto-char (point-max)))
(insert (mapconcat
- #'(lambda (string)
- (replace-regexp-in-string "\r\n" "\n" string))
+ (lambda (string)
+ (string-replace "\r\n" "\n" string))
(cdar args) "\n")))
(url-mail-goto-field (caar args))
;; (setq func (intern-soft (concat "mail-" (caar args))))
diff --git a/lisp/url/url-news.el b/lisp/url/url-news.el
index 585a28291ae..4fe909cadbc 100644
--- a/lisp/url/url-news.el
+++ b/lisp/url/url-news.el
@@ -27,11 +27,6 @@
(require 'nntp)
(autoload 'gnus-group-read-ephemeral-group "gnus-group")
-;; Unused.
-;;; (defgroup url-news nil
-;;; "News related options."
-;;; :group 'url)
-
(defun url-news-open-host (host port user pass)
(if (fboundp 'nnheader-init-server-buffer)
(nnheader-init-server-buffer))
@@ -111,7 +106,7 @@
(article (url-unhex-string (url-filename url))))
(url-news-open-host host port (url-user url) (url-password url))
(cond
- ((string-match "@" article) ; Its a specific article
+ ((string-search "@" article) ; Its a specific article
(setq buf (url-news-fetch-message-id host article)))
((string= article "") ; List all newsgroups
(gnus))
diff --git a/lisp/url/url-proxy.el b/lisp/url/url-proxy.el
index 8436c7a4be2..c89c1b6bc3e 100644
--- a/lisp/url/url-proxy.el
+++ b/lisp/url/url-proxy.el
@@ -49,14 +49,12 @@
;; Not sure how I should handle gracefully degrading from one proxy to
;; another, so for now just deal with the first one
;; (while proxies
- (if (listp proxies)
- (setq proxy (car proxies))
- (setq proxy proxies))
+ (setq proxy (if (listp proxies) (car proxies) proxies))
(cond
- ((string-match "^direct" proxy) nil)
- ((string-match "^proxy +" proxy)
+ ((string-match "^DIRECT" proxy) nil)
+ ((string-match "^PROXY +" proxy)
(concat "http://" (substring proxy (match-end 0)) "/"))
- ((string-match "^socks +" proxy)
+ ((string-match "^SOCKS +" proxy)
(concat "socks://" (substring proxy (match-end 0))))
(t
(display-warning 'url (format "Unknown proxy directive: %s" proxy) :error)
diff --git a/lisp/url/url-util.el b/lisp/url/url-util.el
index 7c913bcb1a9..113ac2833bc 100644
--- a/lisp/url/url-util.el
+++ b/lisp/url/url-util.el
@@ -252,7 +252,7 @@ Will not do anything if `url-show-status' is nil."
(while pairs
(setq cur (car pairs)
pairs (cdr pairs))
- (unless (string-match "=" cur)
+ (unless (string-search "=" cur)
(setq cur (concat cur "=")))
(when (string-match "=" cur)
@@ -335,10 +335,13 @@ instead of just \"key\" as in the example above."
;;;###autoload
(defun url-unhex-string (str &optional allow-newlines)
- "Remove %XX embedded spaces, etc in a URL.
+ "Decode %XX sequences in a percent-encoded URL.
If optional second argument ALLOW-NEWLINES is non-nil, then allow the
decoding of carriage returns and line feeds in the string, which is normally
-forbidden in URL encoding."
+forbidden in URL encoding.
+
+The resulting string in general requires decoding using an
+appropriate coding-system; see `decode-coding-string'."
(setq str (or str ""))
(let ((tmp "")
(case-fold-search t))
diff --git a/lisp/url/url-vars.el b/lisp/url/url-vars.el
index 8c836f8f64d..2aa2e7912f5 100644
--- a/lisp/url/url-vars.el
+++ b/lisp/url/url-vars.el
@@ -22,10 +22,6 @@
;;; Code:
-(defconst url-version "Emacs"
- "Version number of URL package.")
-(make-obsolete-variable 'url-version nil "28.1")
-
(defgroup url nil
"Uniform Resource Locator tool."
:version "22.1"
@@ -427,6 +423,11 @@ Should be one of:
This should be set, e.g. by mail user agents rendering HTML to avoid
`bugs' which call home.")
+;; Obsolete
+
+(defconst url-version "Emacs" "Version number of URL package.")
+(make-obsolete-variable 'url-version 'emacs-version "28.1")
+
(provide 'url-vars)
;;; url-vars.el ends here
diff --git a/lisp/url/url.el b/lisp/url/url.el
index 8daf9f0a8e8..ccc95a6eec4 100644
--- a/lisp/url/url.el
+++ b/lisp/url/url.el
@@ -208,9 +208,10 @@ URL-encoded before it's used."
(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))
+ (when url-using-proxy
+ (setf asynch t
+ loader #'url-proxy
+ (url-asynchronous url) t))
(if asynch
(let ((url-current-object url))
(setq buffer (funcall loader url callback cbargs)))
@@ -234,85 +235,55 @@ If INHIBIT-COOKIES is non-nil, refuse to store cookies. If
TIMEOUT is passed, it should be a number that says (in seconds)
how long to wait for a response before giving up."
(url-do-setup)
-
- (let ((retrieval-done nil)
- (start-time (current-time))
- (url-asynchronous nil)
- (asynch-buffer nil)
- (timed-out 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)))
- nil silent inhibit-cookies))
- (if (null asynch-buffer)
- ;; We do not need to do anything, it was a mailto or something
- ;; similar that takes processing completely outside of the URL
- ;; package.
- nil
- (let ((proc (get-buffer-process asynch-buffer)))
- ;; If the access method was synchronous, `retrieval-done' should
- ;; hopefully already be set to t. If it is nil, and `proc' is also
- ;; nil, it implies that the async process is not running in
- ;; asynch-buffer. This happens e.g. for FTP files. In such a case
- ;; url-file.el should probably set something like a `url-process'
- ;; buffer-local variable so we can find the exact process that we
- ;; should be waiting for. In the mean time, we'll just wait for any
- ;; process output.
- (while (and (not retrieval-done)
- (or (not timeout)
- (not (setq timed-out
- (time-less-p timeout
- (time-since start-time))))))
- (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))
- ;; 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 (with-local-quit
- (accept-process-output proc 1))
- (null proc))
- ;; accept-process-output returned nil, maybe because the process
- ;; 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))))))
- ;; On timeouts, make sure we kill any pending processes.
- ;; There may be more than one if we had a redirect.
- (when timed-out
- (when (process-live-p proc)
- (delete-process proc))
- (when-let ((aproc (get-buffer-process asynch-buffer)))
- (when (process-live-p aproc)
- (delete-process aproc))))))
- asynch-buffer))
+ (let* (url-asynchronous
+ data-buffer
+ (callback (lambda (&rest _args)
+ (setq data-buffer (current-buffer))
+ (url-debug 'retrieval
+ "Synchronous fetching done (%S)"
+ data-buffer)))
+ (start-time (current-time))
+ (proc-buffer (url-retrieve url callback nil silent
+ inhibit-cookies)))
+ (if (not proc-buffer)
+ (url-debug 'retrieval "Synchronous fetching unnecessary %s" url)
+ (unwind-protect
+ (catch 'done
+ (while (not data-buffer)
+ (when (and timeout (time-less-p timeout
+ (time-since start-time)))
+ (url-debug 'retrieval "Timed out %s (after %ss)" url
+ (float-time (time-since start-time)))
+ (throw 'done 'timeout))
+ (url-debug 'retrieval
+ "Spinning in url-retrieve-synchronously: nil (%S)"
+ proc-buffer)
+ (when-let ((redirect-buffer
+ (buffer-local-value 'url-redirect-buffer
+ proc-buffer)))
+ (unless (eq redirect-buffer proc-buffer)
+ (url-debug
+ 'retrieval "Redirect in url-retrieve-synchronously: %S -> %S"
+ proc-buffer redirect-buffer)
+ (let (kill-buffer-query-functions)
+ (kill-buffer proc-buffer))
+ ;; Accommodate hack in commit 55d1d8b.
+ (setq proc-buffer redirect-buffer)))
+ (when-let ((proc (get-buffer-process proc-buffer)))
+ (when (memq (process-status proc)
+ '(closed exit signal failed))
+ ;; Process sentinel vagaries occasionally cause
+ ;; url-retrieve to fail calling callback.
+ (unless data-buffer
+ (url-debug 'retrieval "Dead process %s" url)
+ (throw 'done 'exception))))
+ ;; Querying over consumer internet in the US takes 100
+ ;; ms, so split the difference.
+ (accept-process-output nil 0.05)))
+ (unless (eq data-buffer proc-buffer)
+ (let (kill-buffer-query-functions)
+ (kill-buffer proc-buffer)))))
+ data-buffer))
;; url-mm-callback called from url-mm, which requires mm-decode.
(declare-function mm-dissect-buffer "mm-decode"
generated by cgit v1.2.3 (git 2.39.1) at 2024-05-18 02:11:15 +0000