Cleanups and improvements for FFAP and URL.
* ffap.el (ffap-url-unwrap-local): Make it work right. Use url-generic-parse-url, and handle host names and Windows filenames properly. (ffap-url-unwrap-remote): Use url-generic-parse-url. (ffap-url-unwrap-remote): Accept list values, specifying a list of URL schemes to work on. (ffap--toggle-read-only): New function. (ffap-read-only, ffap-read-only-other-window) (ffap-read-only-other-frame): Use it. (ffap-fixup-url): Don't check ffap-ftp-regexp, since it is not necessary for ffap-url-unwrap-remote. * url-parse.el (url-path-and-query, url-port-if-non-default): New functions. (url-generic-parse-url): Don't set the portspec slot if it is not specified; that is what `url-port' is for. (url-port): Only require the scheme to be specified to call url-scheme-get-property. * url-util.el (url-encode-url): Use url-path-and-query. * url-vars.el (url-mime-charset-string): Load mm-util lazily. Fixes: debbugs:9131
This commit is contained in:
Chong Yidong
parent
97107e2e53
commit
9f9aa0448a
7 changed files with 205 additions and 143 deletions
6
etc/NEWS
6
etc/NEWS
|
|
@ -150,6 +150,12 @@ these commands now).
|
|||
** erc will look up server/channel names via auth-source and use the
|
||||
channel keys found, if any.
|
||||
|
||||
** FFAP
|
||||
|
||||
*** The option `ffap-url-unwrap-remote' can now be a list of strings,
|
||||
specifying URL types which should be converted to remote file names at
|
||||
the FFAP prompt. The default is now '("ftp").
|
||||
|
||||
** Follow mode
|
||||
|
||||
*** The obsolete variable `follow-mode-off-hook' has been removed.
|
||||
|
|
|
|||
|
|
@ -1,3 +1,17 @@
|
|||
2012-05-10 Chong Yidong <cyd@gnu.org>
|
||||
|
||||
* ffap.el (ffap-url-unwrap-local): Make it work right (Bug#9131).
|
||||
Use url-generic-parse-url, and handle host names and Windows
|
||||
filenames properly.
|
||||
(ffap-url-unwrap-remote): Use url-generic-parse-url.
|
||||
(ffap-url-unwrap-remote): Accept list values, specifying a list of
|
||||
URL schemes to work on.
|
||||
(ffap--toggle-read-only): New function.
|
||||
(ffap-read-only, ffap-read-only-other-window)
|
||||
(ffap-read-only-other-frame): Use it.
|
||||
(ffap-fixup-url): Don't check ffap-ftp-regexp, since it is not
|
||||
necessary for ffap-url-unwrap-remote.
|
||||
|
||||
2012-05-10 Dave Abrahams <dave@boostpro.com>
|
||||
|
||||
* cus-start.el (create-lockfiles): Add it.
|
||||
|
|
|
|||
210
lisp/ffap.el
210
lisp/ffap.el
|
|
@ -105,6 +105,8 @@
|
|||
|
||||
;;; Code:
|
||||
|
||||
(require 'url-parse)
|
||||
|
||||
(define-obsolete-variable-alias 'ffap-version 'emacs-version "23.2")
|
||||
|
||||
(defgroup ffap nil
|
||||
|
|
@ -136,10 +138,7 @@ If nil, ffap doesn't do shell prompt stripping."
|
|||
regexp)
|
||||
:group 'ffap)
|
||||
|
||||
(defcustom ffap-ftp-regexp
|
||||
;; This used to test for ange-ftp or efs being present, but it should be
|
||||
;; harmless (and simpler) to give it this value unconditionally.
|
||||
"\\`/[^/:]+:"
|
||||
(defcustom ffap-ftp-regexp "\\`/[^/:]+:"
|
||||
"File names matching this regexp are treated as remote ffap.
|
||||
If nil, ffap neither recognizes nor generates such names."
|
||||
:type '(choice (const :tag "Disable" nil)
|
||||
|
|
@ -148,15 +147,20 @@ If nil, ffap neither recognizes nor generates such names."
|
|||
:group 'ffap)
|
||||
|
||||
(defcustom ffap-url-unwrap-local t
|
||||
"If non-nil, convert `file:' URL to local file name before prompting."
|
||||
"If non-nil, convert some URLs to local file names before prompting.
|
||||
Only \"file:\" and \"ftp:\" URLs are converted, and only if they
|
||||
do not specify a host, or the host is either \"localhost\" or
|
||||
equal to `system-name'."
|
||||
:type 'boolean
|
||||
:group 'ffap)
|
||||
|
||||
(defcustom ffap-url-unwrap-remote t
|
||||
"If non-nil, convert `ftp:' URL to remote file name before prompting.
|
||||
This is ignored if `ffap-ftp-regexp' is nil."
|
||||
:type 'boolean
|
||||
:group 'ffap)
|
||||
(defcustom ffap-url-unwrap-remote '("ftp")
|
||||
"If non-nil, convert URLs to remote file names before prompting.
|
||||
If the value is a list of strings, that specifies a list of URL
|
||||
schemes (e.g. \"ftp\"); in that case, only convert those URLs."
|
||||
:type '(choice (repeat string) boolean)
|
||||
:group 'ffap
|
||||
:version "24.2")
|
||||
|
||||
(defcustom ffap-ftp-default-user "anonymous"
|
||||
"User name in ftp file names generated by `ffap-host-to-path'.
|
||||
|
|
@ -247,14 +251,14 @@ ffap most of the time."
|
|||
(defcustom ffap-file-finder 'find-file
|
||||
"The command called by `find-file-at-point' to find a file."
|
||||
:type 'function
|
||||
:group 'ffap)
|
||||
(put 'ffap-file-finder 'risky-local-variable t)
|
||||
:group 'ffap
|
||||
:risky t)
|
||||
|
||||
(defcustom ffap-directory-finder 'dired
|
||||
"The command called by `dired-at-point' to find a directory."
|
||||
:type 'function
|
||||
:group 'ffap)
|
||||
(put 'ffap-directory-finder 'risky-local-variable t)
|
||||
:group 'ffap
|
||||
:risky t)
|
||||
|
||||
(defcustom ffap-url-fetcher
|
||||
(if (fboundp 'browse-url)
|
||||
|
|
@ -271,8 +275,28 @@ For a fancy alternative, get `ffap-url.el'."
|
|||
(const browse-url-netscape)
|
||||
(const browse-url-mosaic)
|
||||
function)
|
||||
:group 'ffap
|
||||
:risky t)
|
||||
|
||||
(defcustom ffap-next-regexp
|
||||
;; If you want ffap-next to find URL's only, try this:
|
||||
;; (and ffap-url-regexp (string-match "\\\\`" ffap-url-regexp)
|
||||
;; (concat "\\<" (substring ffap-url-regexp 2))))
|
||||
;;
|
||||
;; It pays to put a big fancy regexp here, since ffap-guesser is
|
||||
;; much more time-consuming than regexp searching:
|
||||
"[/:.~[:alpha:]]/\\|@[[:alpha:]][-[:alnum:]]*\\."
|
||||
"Regular expression governing movements of `ffap-next'."
|
||||
:type 'regexp
|
||||
:group 'ffap)
|
||||
(put 'ffap-url-fetcher 'risky-local-variable t)
|
||||
|
||||
(defcustom dired-at-point-require-prefix nil
|
||||
"If non-nil, reverse the prefix argument to `dired-at-point'.
|
||||
This is nil so neophytes notice FFAP. Experts may prefer to
|
||||
disable FFAP most of the time."
|
||||
:type 'boolean
|
||||
:group 'ffap
|
||||
:version "20.3")
|
||||
|
||||
|
||||
;;; Compatibility:
|
||||
|
|
@ -293,18 +317,6 @@ For a fancy alternative, get `ffap-url.el'."
|
|||
;; then, broke it up into ffap-next-guess (noninteractive) and
|
||||
;; ffap-next (a command). It now work on files as well as url's.
|
||||
|
||||
(defcustom ffap-next-regexp
|
||||
;; If you want ffap-next to find URL's only, try this:
|
||||
;; (and ffap-url-regexp (string-match "\\\\`" ffap-url-regexp)
|
||||
;; (concat "\\<" (substring ffap-url-regexp 2))))
|
||||
;;
|
||||
;; It pays to put a big fancy regexp here, since ffap-guesser is
|
||||
;; much more time-consuming than regexp searching:
|
||||
"[/:.~[:alpha:]]/\\|@[[:alpha:]][-[:alnum:]]*\\."
|
||||
"Regular expression governing movements of `ffap-next'."
|
||||
:type 'regexp
|
||||
:group 'ffap)
|
||||
|
||||
(defvar ffap-next-guess nil
|
||||
"Last value returned by `ffap-next-guess'.")
|
||||
|
||||
|
|
@ -606,28 +618,45 @@ Looks at `ffap-ftp-default-user', returns \"\" for \"localhost\"."
|
|||
string)))
|
||||
|
||||
;; Broke these out of ffap-fixup-url, for use of ffap-url package.
|
||||
(defsubst ffap-url-unwrap-local (url)
|
||||
"Return URL as a local file, or nil. Ignores `ffap-url-regexp'."
|
||||
(and (string-match "\\`\\(file\\|ftp\\):/?\\([^/]\\|\\'\\)" url)
|
||||
(substring url (1+ (match-end 1)))))
|
||||
(defsubst ffap-url-unwrap-remote (url)
|
||||
"Return URL as a remote file, or nil. Ignores `ffap-url-regexp'."
|
||||
(and (string-match "\\`\\(ftp\\|file\\)://\\([^:/]+\\):?\\(/.*\\)" url)
|
||||
(concat
|
||||
(ffap-host-to-filename (substring url (match-beginning 2) (match-end 2)))
|
||||
(substring url (match-beginning 3) (match-end 3)))))
|
||||
;; Test: (ffap-url-unwrap-remote "ftp://foo.com/bar.boz")
|
||||
(defun ffap-url-unwrap-local (url)
|
||||
"Return URL as a local file name, or nil."
|
||||
(let* ((obj (url-generic-parse-url url))
|
||||
(host (url-host obj))
|
||||
(filename (car (url-path-and-query obj))))
|
||||
(when (and (member (url-type obj) '("ftp" "file"))
|
||||
(member host `("" "localhost" ,(system-name))))
|
||||
;; On Windows, "file:///C:/foo" should unwrap to "C:/foo"
|
||||
(if (and (memq system-type '(ms-dos windows-nt cygwin))
|
||||
(string-match "\\`/[a-zA-Z]:" filename))
|
||||
(substring filename 1)
|
||||
filename))))
|
||||
|
||||
(defun ffap-url-unwrap-remote (url)
|
||||
"Return URL as a remote file name, or nil."
|
||||
(let* ((obj (url-generic-parse-url url))
|
||||
(scheme (url-type obj))
|
||||
(valid-schemes (if (listp ffap-url-unwrap-remote)
|
||||
ffap-url-unwrap-remote
|
||||
'("ftp")))
|
||||
(host (url-host obj))
|
||||
(port (url-port-if-non-default obj))
|
||||
(user (url-user obj))
|
||||
(filename (car (url-path-and-query obj))))
|
||||
(when (and (member scheme valid-schemes)
|
||||
(string-match "\\`[a-zA-Z][-a-zA-Z0-9+.]*\\'" scheme)
|
||||
(not (equal host "")))
|
||||
(concat "/" scheme ":"
|
||||
(if user (concat user "@"))
|
||||
host
|
||||
(if port (concat "#" (number-to-string port)))
|
||||
":" filename))))
|
||||
|
||||
(defun ffap-fixup-url (url)
|
||||
"Clean up URL and return it, maybe as a file name."
|
||||
(cond
|
||||
((not (stringp url)) nil)
|
||||
((and ffap-url-unwrap-local (ffap-url-unwrap-local url)))
|
||||
((and ffap-url-unwrap-remote ffap-ftp-regexp
|
||||
(ffap-url-unwrap-remote url)))
|
||||
;; All this seems to do is remove any trailing "#anchor" part (Bug#898).
|
||||
;;; ((fboundp 'url-normalize-url) ; may autoload url (part of w3)
|
||||
;;; (url-normalize-url url))
|
||||
((and ffap-url-unwrap-local (ffap-url-unwrap-local url)))
|
||||
((and ffap-url-unwrap-remote (ffap-url-unwrap-remote url)))
|
||||
(url)))
|
||||
|
||||
|
||||
|
|
@ -1076,38 +1105,33 @@ Assumes the buffer has not changed."
|
|||
;; ignore non-relative links, trim punctuation. The other will
|
||||
;; actually look back if point is in whitespace, but I would rather
|
||||
;; ffap be less aggressive in such situations.
|
||||
(and
|
||||
ffap-url-regexp
|
||||
(or
|
||||
;; In a w3 buffer button?
|
||||
(and (eq major-mode 'w3-mode)
|
||||
;; interface recommended by wmperry:
|
||||
(w3-view-this-url t))
|
||||
;; Is there a reason not to strip trailing colon?
|
||||
(let ((name (ffap-string-at-point 'url)))
|
||||
(cond
|
||||
((string-match "^url:" name) (setq name (substring name 4)))
|
||||
((and (string-match "\\`[^:</>@]+@[^:</>@]+[[:alnum:]]\\'" name)
|
||||
;; "foo@bar": could be "mailto" or "news" (a Message-ID).
|
||||
;; Without "<>" it must be "mailto". Otherwise could be
|
||||
;; either, so consult `ffap-foo-at-bar-prefix'.
|
||||
(let ((prefix (if (and (equal (ffap-string-around) "<>")
|
||||
;; Expect some odd characters:
|
||||
(string-match "[$.0-9].*[$.0-9].*@" name))
|
||||
;; Could be news:
|
||||
ffap-foo-at-bar-prefix
|
||||
"mailto")))
|
||||
(and prefix (setq name (concat prefix ":" name))))))
|
||||
((ffap-newsgroup-p name) (setq name (concat "news:" name)))
|
||||
((and (string-match "\\`[[:alnum:]]+\\'" name) ; <mic> <root> <nobody>
|
||||
(equal (ffap-string-around) "<>")
|
||||
;; (ffap-user-p name):
|
||||
(not (string-match "~" (expand-file-name (concat "~" name))))
|
||||
)
|
||||
(setq name (concat "mailto:" name)))
|
||||
)
|
||||
(and (ffap-url-p name) name)
|
||||
))))
|
||||
(when ffap-url-regexp
|
||||
(or (and (eq major-mode 'w3-mode) ; In a w3 buffer button?
|
||||
(w3-view-this-url t))
|
||||
;; Is there a reason not to strip trailing colon?
|
||||
(let ((name (ffap-string-at-point 'url)))
|
||||
(cond
|
||||
((string-match "^url:" name) (setq name (substring name 4)))
|
||||
((and (string-match "\\`[^:</>@]+@[^:</>@]+[[:alnum:]]\\'" name)
|
||||
;; "foo@bar": could be "mailto" or "news" (a Message-ID).
|
||||
;; Without "<>" it must be "mailto". Otherwise could be
|
||||
;; either, so consult `ffap-foo-at-bar-prefix'.
|
||||
(let ((prefix (if (and (equal (ffap-string-around) "<>")
|
||||
;; Expect some odd characters:
|
||||
(string-match "[$.0-9].*[$.0-9].*@" name))
|
||||
;; Could be news:
|
||||
ffap-foo-at-bar-prefix
|
||||
"mailto")))
|
||||
(and prefix (setq name (concat prefix ":" name))))))
|
||||
((ffap-newsgroup-p name) (setq name (concat "news:" name)))
|
||||
((and (string-match "\\`[[:alnum:]]+\\'" name) ; <mic> <root> <nobody>
|
||||
(equal (ffap-string-around) "<>")
|
||||
;; (ffap-user-p name):
|
||||
(not (string-match "~" (expand-file-name (concat "~" name)))))
|
||||
(setq name (concat "mailto:" name))))
|
||||
|
||||
(if (ffap-url-p name)
|
||||
name)))))
|
||||
|
||||
(defvar ffap-gopher-regexp
|
||||
"^.*\\<\\(Type\\|Name\\|Path\\|Host\\|Port\\) *= *\\(.*\\) *$"
|
||||
|
|
@ -1342,8 +1366,6 @@ which may actually result in an URL rather than a filename."
|
|||
|
||||
|
||||
;;; Highlighting (`ffap-highlight'):
|
||||
;;
|
||||
;; Based on overlay highlighting in Emacs 19.28 isearch.el.
|
||||
|
||||
(defvar ffap-highlight t
|
||||
"If non-nil, ffap highlights the current buffer substring.")
|
||||
|
|
@ -1676,6 +1698,11 @@ Only intended for interactive use."
|
|||
(set-window-dedicated-p win wdp))
|
||||
value))
|
||||
|
||||
(defun ffap--toggle-read-only (buffer)
|
||||
(with-current-buffer buffer
|
||||
(with-no-warnings
|
||||
(toggle-read-only 1))))
|
||||
|
||||
(defun ffap-read-only ()
|
||||
"Like `ffap', but mark buffer as read-only.
|
||||
Only intended for interactive use."
|
||||
|
|
@ -1683,7 +1710,7 @@ Only intended for interactive use."
|
|||
(let ((value (call-interactively 'ffap)))
|
||||
(unless (or (bufferp value) (bufferp (car-safe value)))
|
||||
(setq value (current-buffer)))
|
||||
(mapc (lambda (b) (with-current-buffer b (toggle-read-only 1)))
|
||||
(mapc #'ffap--toggle-read-only
|
||||
(if (listp value) value (list value)))
|
||||
value))
|
||||
|
||||
|
|
@ -1692,7 +1719,7 @@ Only intended for interactive use."
|
|||
Only intended for interactive use."
|
||||
(interactive)
|
||||
(let ((value (ffap-other-window)))
|
||||
(mapc (lambda (b) (with-current-buffer b (toggle-read-only 1)))
|
||||
(mapc #'ffap--toggle-read-only
|
||||
(if (listp value) value (list value)))
|
||||
value))
|
||||
|
||||
|
|
@ -1701,7 +1728,7 @@ Only intended for interactive use."
|
|||
Only intended for interactive use."
|
||||
(interactive)
|
||||
(let ((value (ffap-other-frame)))
|
||||
(mapc (lambda (b) (with-current-buffer b (toggle-read-only 1)))
|
||||
(mapc #'ffap--toggle-read-only
|
||||
(if (listp value) value (list value)))
|
||||
value))
|
||||
|
||||
|
|
@ -1743,8 +1770,7 @@ Only intended for interactive use."
|
|||
(defun ffap-ro-mode-hook ()
|
||||
"Bind `ffap-next' and `ffap-menu' to M-l and M-m, resp."
|
||||
(local-set-key "\M-l" 'ffap-next)
|
||||
(local-set-key "\M-m" 'ffap-menu)
|
||||
)
|
||||
(local-set-key "\M-m" 'ffap-menu))
|
||||
|
||||
(defun ffap-gnus-hook ()
|
||||
"Bind `ffap-gnus-next' and `ffap-gnus-menu' to M-l and M-m, resp."
|
||||
|
|
@ -1788,13 +1814,6 @@ Only intended for interactive use."
|
|||
(interactive) (ffap-gnus-wrapper '(ffap-menu)))
|
||||
|
||||
|
||||
(defcustom dired-at-point-require-prefix nil
|
||||
"If set, reverses the prefix argument to `dired-at-point'.
|
||||
This is nil so neophytes notice ffap. Experts may prefer to disable
|
||||
ffap most of the time."
|
||||
:type 'boolean
|
||||
:group 'ffap
|
||||
:version "20.3")
|
||||
|
||||
;;;###autoload
|
||||
(defun dired-at-point (&optional filename)
|
||||
|
|
@ -1901,7 +1920,7 @@ Only intended for interactive use."
|
|||
;;; Hooks to put in `file-name-at-point-functions':
|
||||
|
||||
;;;###autoload
|
||||
(progn (defun ffap-guess-file-name-at-point ()
|
||||
(defun ffap-guess-file-name-at-point ()
|
||||
"Try to get a file name at point.
|
||||
This hook is intended to be put in `file-name-at-point-functions'."
|
||||
(when (fboundp 'ffap-guesser)
|
||||
|
|
@ -1918,14 +1937,13 @@ This hook is intended to be put in `file-name-at-point-functions'."
|
|||
(when guess
|
||||
(if (file-directory-p guess)
|
||||
(file-name-as-directory guess)
|
||||
guess))))))
|
||||
guess)))))
|
||||
|
||||
|
||||
;;; Offer default global bindings (`ffap-bindings'):
|
||||
|
||||
(defvar ffap-bindings
|
||||
'(
|
||||
(global-set-key [S-mouse-3] 'ffap-at-mouse)
|
||||
'((global-set-key [S-mouse-3] 'ffap-at-mouse)
|
||||
(global-set-key [C-S-mouse-3] 'ffap-menu)
|
||||
|
||||
(global-set-key "\C-x\C-f" 'find-file-at-point)
|
||||
|
|
@ -1945,9 +1963,7 @@ This hook is intended to be put in `file-name-at-point-functions'."
|
|||
(add-hook 'gnus-summary-mode-hook 'ffap-gnus-hook)
|
||||
(add-hook 'gnus-article-mode-hook 'ffap-gnus-hook)
|
||||
(add-hook 'vm-mode-hook 'ffap-ro-mode-hook)
|
||||
(add-hook 'rmail-mode-hook 'ffap-ro-mode-hook)
|
||||
;; (setq dired-x-hands-off-my-keys t) ; the default
|
||||
)
|
||||
(add-hook 'rmail-mode-hook 'ffap-ro-mode-hook))
|
||||
"List of binding forms evaluated by function `ffap-bindings'.
|
||||
A reasonable ffap installation needs just this one line:
|
||||
(ffap-bindings)
|
||||
|
|
|
|||
|
|
@ -1,3 +1,16 @@
|
|||
2012-05-10 Chong Yidong <cyd@gnu.org>
|
||||
|
||||
* url-parse.el (url-path-and-query, url-port-if-non-default): New
|
||||
functions.
|
||||
(url-generic-parse-url): Don't set the portspec slot if it is not
|
||||
specified; that is what `url-port' is for.
|
||||
(url-port): Only require the scheme to be specified to call
|
||||
url-scheme-get-property.
|
||||
|
||||
* url-util.el (url-encode-url): Use url-path-and-query.
|
||||
|
||||
* url-vars.el (url-mime-charset-string): Load mm-util lazily.
|
||||
|
||||
2012-05-09 Chong Yidong <cyd@gnu.org>
|
||||
|
||||
* url-util.el (url-encode-url): New function for URL quoting.
|
||||
|
|
@ -12,6 +25,7 @@
|
|||
whole path and query inside the FILENAME slot. Improve docstring.
|
||||
(url-recreate-url-attributes): Mark as obsolete.
|
||||
(url-recreate-url): Handle missing scheme and userinfo.
|
||||
(url-path-and-query): New function.
|
||||
|
||||
* url-http.el (url-http-create-request): Ignore obsolete
|
||||
attributes slot of url-object.
|
||||
|
|
|
|||
|
|
@ -39,22 +39,52 @@
|
|||
silent (use-cookies t))
|
||||
|
||||
(defsubst url-port (urlobj)
|
||||
"Return the port number for the URL specified by URLOBJ."
|
||||
(or (url-portspec urlobj)
|
||||
(if (url-fullness urlobj)
|
||||
(if (url-type urlobj)
|
||||
(url-scheme-get-property (url-type urlobj) 'default-port))))
|
||||
|
||||
(defsetf url-port (urlobj) (port) `(setf (url-portspec ,urlobj) ,port))
|
||||
|
||||
(defun url-path-and-query (urlobj)
|
||||
"Return the path and query components of URLOBJ.
|
||||
These two components are store together in the FILENAME slot of
|
||||
the object. The return value of this function is (PATH . QUERY),
|
||||
where each of PATH and QUERY are strings or nil."
|
||||
(let ((name (url-filename urlobj))
|
||||
path query)
|
||||
(when name
|
||||
(if (string-match "\\?" name)
|
||||
(setq path (substring name 0 (match-beginning 0))
|
||||
query (substring name (match-end 0)))
|
||||
(setq path name)))
|
||||
(if (equal path "") (setq path nil))
|
||||
(if (equal query "") (setq query nil))
|
||||
(cons path query)))
|
||||
|
||||
(defun url-port-if-non-default (urlobj)
|
||||
"Return the port number specified by URLOBJ, if it is not the default.
|
||||
If the specified port number is the default, return nil."
|
||||
(let ((port (url-portspec urlobj))
|
||||
type)
|
||||
(and port
|
||||
(or (null (setq type (url-type urlobj)))
|
||||
(not (equal port (url-scheme-get-property type 'default-port))))
|
||||
port)))
|
||||
|
||||
;;;###autoload
|
||||
(defun url-recreate-url (urlobj)
|
||||
"Recreate a URL string from the parsed URLOBJ."
|
||||
(let ((type (url-type urlobj))
|
||||
(user (url-user urlobj))
|
||||
(pass (url-password urlobj))
|
||||
(host (url-host urlobj))
|
||||
(port (url-portspec urlobj))
|
||||
(file (url-filename urlobj))
|
||||
(frag (url-target urlobj)))
|
||||
(let* ((type (url-type urlobj))
|
||||
(user (url-user urlobj))
|
||||
(pass (url-password urlobj))
|
||||
(host (url-host urlobj))
|
||||
;; RFC 3986: "omit the port component and its : delimiter if
|
||||
;; port is empty or if its value would be the same as that of
|
||||
;; the scheme's default."
|
||||
(port (url-port-if-non-default urlobj))
|
||||
(file (url-filename urlobj))
|
||||
(frag (url-target urlobj)))
|
||||
(concat (if type (concat type ":"))
|
||||
(if (url-fullness urlobj) "//")
|
||||
(if (or user pass)
|
||||
|
|
@ -62,15 +92,7 @@
|
|||
(if pass (concat ":" pass))
|
||||
"@"))
|
||||
host
|
||||
;; RFC 3986: "omit the port component and its : delimiter
|
||||
;; if port is empty or if its value would be the same as
|
||||
;; that of the scheme's default."
|
||||
(and port
|
||||
(or (null type)
|
||||
(not (equal port
|
||||
(url-scheme-get-property type
|
||||
'default-port))))
|
||||
(format ":%d" (url-port urlobj)))
|
||||
(if port (format ":%d" (url-port urlobj)))
|
||||
(or file "/")
|
||||
(if frag (concat "#" frag)))))
|
||||
|
||||
|
|
@ -102,8 +124,8 @@ TARGET is the fragment identifier component (used to refer to a
|
|||
ATTRIBUTES is nil; this slot originally stored the attribute and
|
||||
value alists for IMAP URIs, but this feature was removed
|
||||
since it conflicts with RFC 3986.
|
||||
FULLNESS is non-nil iff the authority component of the URI is
|
||||
present.
|
||||
FULLNESS is non-nil iff the hierarchical sequence component of
|
||||
the URL starts with two slashes, \"//\".
|
||||
|
||||
The parser follows RFC 3986, except that it also tries to handle
|
||||
URIs that are not fully specified (e.g. lacking TYPE), and it
|
||||
|
|
@ -174,10 +196,6 @@ parses to
|
|||
(setq port (string-to-number port))))
|
||||
(setq host (downcase host)))
|
||||
|
||||
(and (null port)
|
||||
scheme
|
||||
(setq port (url-scheme-get-property scheme 'default-port)))
|
||||
|
||||
;; Now point is on the / ? or # which terminates the
|
||||
;; authority, or at the end of the URI, or (if there is no
|
||||
;; authority) at the beginning of the absolute path.
|
||||
|
|
|
|||
|
|
@ -418,31 +418,26 @@ should return it unchanged."
|
|||
(user (url-user obj))
|
||||
(pass (url-password obj))
|
||||
(host (url-host obj))
|
||||
(file (url-filename obj))
|
||||
(frag (url-target obj))
|
||||
path query)
|
||||
(path-and-query (url-path-and-query obj))
|
||||
(path (car path-and-query))
|
||||
(query (cdr path-and-query))
|
||||
(frag (url-target obj)))
|
||||
(if user
|
||||
(setf (url-user obj) (url-hexify-string user)))
|
||||
(if pass
|
||||
(setf (url-password obj) (url-hexify-string pass)))
|
||||
(when host
|
||||
;; No special encoding for IPv6 literals.
|
||||
(unless (string-match "\\`\\[.*\\]\\'" host)
|
||||
(setf (url-host obj)
|
||||
(url-hexify-string host url-host-allowed-chars))))
|
||||
;; Split FILENAME slot into its PATH and QUERY components, and
|
||||
;; encode them separately. The PATH component can contain
|
||||
;; unreserved characters, %-encodings, and /:@!$&'()*+,;=
|
||||
(when file
|
||||
(if (string-match "\\?" file)
|
||||
(setq path (substring file 0 (match-beginning 0))
|
||||
query (substring file (match-end 0)))
|
||||
(setq path file))
|
||||
(setq path (url-hexify-string path url-path-allowed-chars))
|
||||
(if query
|
||||
(setq query (url-hexify-string query url-query-allowed-chars)))
|
||||
(setf (url-filename obj)
|
||||
(if query (concat path "?" query) path)))
|
||||
;; No special encoding for IPv6 literals.
|
||||
(and host
|
||||
(not (string-match "\\`\\[.*\\]\\'" host))
|
||||
(setf (url-host obj)
|
||||
(url-hexify-string host url-host-allowed-chars)))
|
||||
|
||||
(if path
|
||||
(setq path (url-hexify-string path url-path-allowed-chars)))
|
||||
(if query
|
||||
(setq query (url-hexify-string query url-query-allowed-chars)))
|
||||
(setf (url-filename obj) (if query (concat path "?" query) path))
|
||||
|
||||
(if frag
|
||||
(setf (url-target obj)
|
||||
(url-hexify-string frag url-query-allowed-chars)))
|
||||
|
|
|
|||
|
|
@ -21,8 +21,6 @@
|
|||
|
||||
;;; Code:
|
||||
|
||||
(require 'mm-util)
|
||||
|
||||
(defconst url-version "Emacs"
|
||||
"Version number of URL package.")
|
||||
|
||||
|
|
@ -221,6 +219,7 @@ Should be an assoc list of headers/contents.")
|
|||
(defun url-mime-charset-string ()
|
||||
"Generate a list of preferred MIME charsets for HTTP requests.
|
||||
Generated according to current coding system priorities."
|
||||
(require 'mm-util)
|
||||
(if (fboundp 'sort-coding-systems)
|
||||
(let ((ordered (sort-coding-systems
|
||||
(let (accum)
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue