Commit 9f9aa044 authored by Chong Yidong's avatar Chong Yidong
Browse files

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
parent 97107e2e
...@@ -150,6 +150,12 @@ these commands now). ...@@ -150,6 +150,12 @@ these commands now).
** erc will look up server/channel names via auth-source and use the ** erc will look up server/channel names via auth-source and use the
channel keys found, if any. 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 ** Follow mode
*** The obsolete variable `follow-mode-off-hook' has been removed. *** The obsolete variable `follow-mode-off-hook' has been removed.
......
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> 2012-05-10 Dave Abrahams <dave@boostpro.com>
* cus-start.el (create-lockfiles): Add it. * cus-start.el (create-lockfiles): Add it.
......
...@@ -105,6 +105,8 @@ ...@@ -105,6 +105,8 @@
;;; Code: ;;; Code:
(require 'url-parse)
(define-obsolete-variable-alias 'ffap-version 'emacs-version "23.2") (define-obsolete-variable-alias 'ffap-version 'emacs-version "23.2")
(defgroup ffap nil (defgroup ffap nil
...@@ -136,10 +138,7 @@ If nil, ffap doesn't do shell prompt stripping." ...@@ -136,10 +138,7 @@ If nil, ffap doesn't do shell prompt stripping."
regexp) regexp)
:group 'ffap) :group 'ffap)
(defcustom ffap-ftp-regexp (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.
"\\`/[^/:]+:"
"File names matching this regexp are treated as remote ffap. "File names matching this regexp are treated as remote ffap.
If nil, ffap neither recognizes nor generates such names." If nil, ffap neither recognizes nor generates such names."
:type '(choice (const :tag "Disable" nil) :type '(choice (const :tag "Disable" nil)
...@@ -148,15 +147,20 @@ If nil, ffap neither recognizes nor generates such names." ...@@ -148,15 +147,20 @@ If nil, ffap neither recognizes nor generates such names."
:group 'ffap) :group 'ffap)
(defcustom ffap-url-unwrap-local t (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 :type 'boolean
:group 'ffap) :group 'ffap)
(defcustom ffap-url-unwrap-remote t (defcustom ffap-url-unwrap-remote '("ftp")
"If non-nil, convert `ftp:' URL to remote file name before prompting. "If non-nil, convert URLs to remote file names before prompting.
This is ignored if `ffap-ftp-regexp' is nil." If the value is a list of strings, that specifies a list of URL
:type 'boolean schemes (e.g. \"ftp\"); in that case, only convert those URLs."
:group 'ffap) :type '(choice (repeat string) boolean)
:group 'ffap
:version "24.2")
(defcustom ffap-ftp-default-user "anonymous" (defcustom ffap-ftp-default-user "anonymous"
"User name in ftp file names generated by `ffap-host-to-path'. "User name in ftp file names generated by `ffap-host-to-path'.
...@@ -247,14 +251,14 @@ ffap most of the time." ...@@ -247,14 +251,14 @@ ffap most of the time."
(defcustom ffap-file-finder 'find-file (defcustom ffap-file-finder 'find-file
"The command called by `find-file-at-point' to find a file." "The command called by `find-file-at-point' to find a file."
:type 'function :type 'function
:group 'ffap) :group 'ffap
(put 'ffap-file-finder 'risky-local-variable t) :risky t)
(defcustom ffap-directory-finder 'dired (defcustom ffap-directory-finder 'dired
"The command called by `dired-at-point' to find a directory." "The command called by `dired-at-point' to find a directory."
:type 'function :type 'function
:group 'ffap) :group 'ffap
(put 'ffap-directory-finder 'risky-local-variable t) :risky t)
(defcustom ffap-url-fetcher (defcustom ffap-url-fetcher
(if (fboundp 'browse-url) (if (fboundp 'browse-url)
...@@ -271,8 +275,28 @@ For a fancy alternative, get `ffap-url.el'." ...@@ -271,8 +275,28 @@ For a fancy alternative, get `ffap-url.el'."
(const browse-url-netscape) (const browse-url-netscape)
(const browse-url-mosaic) (const browse-url-mosaic)
function) 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) :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: ;;; Compatibility:
...@@ -293,18 +317,6 @@ For a fancy alternative, get `ffap-url.el'." ...@@ -293,18 +317,6 @@ For a fancy alternative, get `ffap-url.el'."
;; then, broke it up into ffap-next-guess (noninteractive) and ;; then, broke it up into ffap-next-guess (noninteractive) and
;; ffap-next (a command). It now work on files as well as url's. ;; 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 (defvar ffap-next-guess nil
"Last value returned by `ffap-next-guess'.") "Last value returned by `ffap-next-guess'.")
...@@ -606,28 +618,45 @@ Looks at `ffap-ftp-default-user', returns \"\" for \"localhost\"." ...@@ -606,28 +618,45 @@ Looks at `ffap-ftp-default-user', returns \"\" for \"localhost\"."
string))) string)))
;; Broke these out of ffap-fixup-url, for use of ffap-url package. ;; Broke these out of ffap-fixup-url, for use of ffap-url package.
(defsubst ffap-url-unwrap-local (url) (defun ffap-url-unwrap-local (url)
"Return URL as a local file, or nil. Ignores `ffap-url-regexp'." "Return URL as a local file name, or nil."
(and (string-match "\\`\\(file\\|ftp\\):/?\\([^/]\\|\\'\\)" url) (let* ((obj (url-generic-parse-url url))
(substring url (1+ (match-end 1))))) (host (url-host obj))
(defsubst ffap-url-unwrap-remote (url) (filename (car (url-path-and-query obj))))
"Return URL as a remote file, or nil. Ignores `ffap-url-regexp'." (when (and (member (url-type obj) '("ftp" "file"))
(and (string-match "\\`\\(ftp\\|file\\)://\\([^:/]+\\):?\\(/.*\\)" url) (member host `("" "localhost" ,(system-name))))
(concat ;; On Windows, "file:///C:/foo" should unwrap to "C:/foo"
(ffap-host-to-filename (substring url (match-beginning 2) (match-end 2))) (if (and (memq system-type '(ms-dos windows-nt cygwin))
(substring url (match-beginning 3) (match-end 3))))) (string-match "\\`/[a-zA-Z]:" filename))
;; Test: (ffap-url-unwrap-remote "ftp://foo.com/bar.boz") (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) (defun ffap-fixup-url (url)
"Clean up URL and return it, maybe as a file name." "Clean up URL and return it, maybe as a file name."
(cond (cond
((not (stringp url)) nil) ((not (stringp url)) nil)
((and ffap-url-unwrap-local (ffap-url-unwrap-local url))) ((and ffap-url-unwrap-local (ffap-url-unwrap-local url)))
((and ffap-url-unwrap-remote ffap-ftp-regexp ((and ffap-url-unwrap-remote (ffap-url-unwrap-remote url)))
(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))
(url))) (url)))
...@@ -1076,38 +1105,33 @@ Assumes the buffer has not changed." ...@@ -1076,38 +1105,33 @@ Assumes the buffer has not changed."
;; ignore non-relative links, trim punctuation. The other will ;; ignore non-relative links, trim punctuation. The other will
;; actually look back if point is in whitespace, but I would rather ;; actually look back if point is in whitespace, but I would rather
;; ffap be less aggressive in such situations. ;; ffap be less aggressive in such situations.
(and (when ffap-url-regexp
ffap-url-regexp (or (and (eq major-mode 'w3-mode) ; In a w3 buffer button?
(or (w3-view-this-url t))
;; In a w3 buffer button? ;; Is there a reason not to strip trailing colon?
(and (eq major-mode 'w3-mode) (let ((name (ffap-string-at-point 'url)))
;; interface recommended by wmperry: (cond
(w3-view-this-url t)) ((string-match "^url:" name) (setq name (substring name 4)))
;; Is there a reason not to strip trailing colon? ((and (string-match "\\`[^:</>@]+@[^:</>@]+[[:alnum:]]\\'" name)
(let ((name (ffap-string-at-point 'url))) ;; "foo@bar": could be "mailto" or "news" (a Message-ID).
(cond ;; Without "<>" it must be "mailto". Otherwise could be
((string-match "^url:" name) (setq name (substring name 4))) ;; either, so consult `ffap-foo-at-bar-prefix'.
((and (string-match "\\`[^:</>@]+@[^:</>@]+[[:alnum:]]\\'" name) (let ((prefix (if (and (equal (ffap-string-around) "<>")
;; "foo@bar": could be "mailto" or "news" (a Message-ID). ;; Expect some odd characters:
;; Without "<>" it must be "mailto". Otherwise could be (string-match "[$.0-9].*[$.0-9].*@" name))
;; either, so consult `ffap-foo-at-bar-prefix'. ;; Could be news:
(let ((prefix (if (and (equal (ffap-string-around) "<>") ffap-foo-at-bar-prefix
;; Expect some odd characters: "mailto")))
(string-match "[$.0-9].*[$.0-9].*@" name)) (and prefix (setq name (concat prefix ":" name))))))
;; Could be news: ((ffap-newsgroup-p name) (setq name (concat "news:" name)))
ffap-foo-at-bar-prefix ((and (string-match "\\`[[:alnum:]]+\\'" name) ; <mic> <root> <nobody>
"mailto"))) (equal (ffap-string-around) "<>")
(and prefix (setq name (concat prefix ":" name)))))) ;; (ffap-user-p name):
((ffap-newsgroup-p name) (setq name (concat "news:" name))) (not (string-match "~" (expand-file-name (concat "~" name)))))
((and (string-match "\\`[[:alnum:]]+\\'" name) ; <mic> <root> <nobody> (setq name (concat "mailto:" name))))
(equal (ffap-string-around) "<>")
;; (ffap-user-p name): (if (ffap-url-p name)
(not (string-match "~" (expand-file-name (concat "~" name)))) name)))))
)
(setq name (concat "mailto:" name)))
)
(and (ffap-url-p name) name)
))))
(defvar ffap-gopher-regexp (defvar ffap-gopher-regexp
"^.*\\<\\(Type\\|Name\\|Path\\|Host\\|Port\\) *= *\\(.*\\) *$" "^.*\\<\\(Type\\|Name\\|Path\\|Host\\|Port\\) *= *\\(.*\\) *$"
...@@ -1342,8 +1366,6 @@ which may actually result in an URL rather than a filename." ...@@ -1342,8 +1366,6 @@ which may actually result in an URL rather than a filename."
;;; Highlighting (`ffap-highlight'): ;;; Highlighting (`ffap-highlight'):
;;
;; Based on overlay highlighting in Emacs 19.28 isearch.el.
(defvar ffap-highlight t (defvar ffap-highlight t
"If non-nil, ffap highlights the current buffer substring.") "If non-nil, ffap highlights the current buffer substring.")
...@@ -1676,6 +1698,11 @@ Only intended for interactive use." ...@@ -1676,6 +1698,11 @@ Only intended for interactive use."
(set-window-dedicated-p win wdp)) (set-window-dedicated-p win wdp))
value)) value))
(defun ffap--toggle-read-only (buffer)
(with-current-buffer buffer
(with-no-warnings
(toggle-read-only 1))))
(defun ffap-read-only () (defun ffap-read-only ()
"Like `ffap', but mark buffer as read-only. "Like `ffap', but mark buffer as read-only.
Only intended for interactive use." Only intended for interactive use."
...@@ -1683,7 +1710,7 @@ Only intended for interactive use." ...@@ -1683,7 +1710,7 @@ Only intended for interactive use."
(let ((value (call-interactively 'ffap))) (let ((value (call-interactively 'ffap)))
(unless (or (bufferp value) (bufferp (car-safe value))) (unless (or (bufferp value) (bufferp (car-safe value)))
(setq value (current-buffer))) (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))) (if (listp value) value (list value)))
value)) value))
...@@ -1692,7 +1719,7 @@ Only intended for interactive use." ...@@ -1692,7 +1719,7 @@ Only intended for interactive use."
Only intended for interactive use." Only intended for interactive use."
(interactive) (interactive)
(let ((value (ffap-other-window))) (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))) (if (listp value) value (list value)))
value)) value))
...@@ -1701,7 +1728,7 @@ Only intended for interactive use." ...@@ -1701,7 +1728,7 @@ Only intended for interactive use."
Only intended for interactive use." Only intended for interactive use."
(interactive) (interactive)
(let ((value (ffap-other-frame))) (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))) (if (listp value) value (list value)))
value)) value))
...@@ -1743,8 +1770,7 @@ Only intended for interactive use." ...@@ -1743,8 +1770,7 @@ Only intended for interactive use."
(defun ffap-ro-mode-hook () (defun ffap-ro-mode-hook ()
"Bind `ffap-next' and `ffap-menu' to M-l and M-m, resp." "Bind `ffap-next' and `ffap-menu' to M-l and M-m, resp."
(local-set-key "\M-l" 'ffap-next) (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 () (defun ffap-gnus-hook ()
"Bind `ffap-gnus-next' and `ffap-gnus-menu' to M-l and M-m, resp." "Bind `ffap-gnus-next' and `ffap-gnus-menu' to M-l and M-m, resp."
...@@ -1788,13 +1814,6 @@ Only intended for interactive use." ...@@ -1788,13 +1814,6 @@ Only intended for interactive use."
(interactive) (ffap-gnus-wrapper '(ffap-menu))) (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 ;;;###autoload
(defun dired-at-point (&optional filename) (defun dired-at-point (&optional filename)
...@@ -1901,7 +1920,7 @@ Only intended for interactive use." ...@@ -1901,7 +1920,7 @@ Only intended for interactive use."
;;; Hooks to put in `file-name-at-point-functions': ;;; Hooks to put in `file-name-at-point-functions':
;;;###autoload ;;;###autoload
(progn (defun ffap-guess-file-name-at-point () (defun ffap-guess-file-name-at-point ()
"Try to get a 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'." This hook is intended to be put in `file-name-at-point-functions'."
(when (fboundp 'ffap-guesser) (when (fboundp 'ffap-guesser)
...@@ -1918,14 +1937,13 @@ This hook is intended to be put in `file-name-at-point-functions'." ...@@ -1918,14 +1937,13 @@ This hook is intended to be put in `file-name-at-point-functions'."
(when guess (when guess
(if (file-directory-p guess) (if (file-directory-p guess)
(file-name-as-directory guess) (file-name-as-directory guess)
guess)))))) guess)))))
;;; Offer default global bindings (`ffap-bindings'): ;;; Offer default global bindings (`ffap-bindings'):
(defvar 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-S-mouse-3] 'ffap-menu)
(global-set-key "\C-x\C-f" 'find-file-at-point) (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'." ...@@ -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-summary-mode-hook 'ffap-gnus-hook)
(add-hook 'gnus-article-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 'vm-mode-hook 'ffap-ro-mode-hook)
(add-hook 'rmail-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
)
"List of binding forms evaluated by function `ffap-bindings'. "List of binding forms evaluated by function `ffap-bindings'.
A reasonable ffap installation needs just this one line: A reasonable ffap installation needs just this one line:
(ffap-bindings) (ffap-bindings)
......
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> 2012-05-09 Chong Yidong <cyd@gnu.org>
* url-util.el (url-encode-url): New function for URL quoting. * url-util.el (url-encode-url): New function for URL quoting.
...@@ -12,6 +25,7 @@ ...@@ -12,6 +25,7 @@
whole path and query inside the FILENAME slot. Improve docstring. whole path and query inside the FILENAME slot. Improve docstring.
(url-recreate-url-attributes): Mark as obsolete. (url-recreate-url-attributes): Mark as obsolete.
(url-recreate-url): Handle missing scheme and userinfo. (url-recreate-url): Handle missing scheme and userinfo.
(url-path-and-query): New function.
* url-http.el (url-http-create-request): Ignore obsolete * url-http.el (url-http-create-request): Ignore obsolete
attributes slot of url-object. attributes slot of url-object.
......
...@@ -39,22 +39,52 @@ ...@@ -39,22 +39,52 @@
silent (use-cookies t)) silent (use-cookies t))
(defsubst url-port (urlobj) (defsubst url-port (urlobj)
"Return the port number for the URL specified by URLOBJ."
(or (url-portspec urlobj) (or (url-portspec urlobj)
(if (url-fullness urlobj) (if (url-type urlobj)
(url-scheme-get-property (url-type urlobj) 'default-port)))) (url-scheme-get-property (url-type urlobj) 'default-port))))
(defsetf url-port (urlobj) (port) `(setf (url-portspec ,urlobj) ,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 ;;;###autoload
(defun url-recreate-url (urlobj) (defun url-recreate-url (urlobj)
"Recreate a URL string from the parsed URLOBJ." "Recreate a URL string from the parsed URLOBJ."
(let ((type (url-type urlobj)) (let* ((type (url-type urlobj))
(user (url-user urlobj)) (user (url-user urlobj))
(pass (url-password urlobj)) (pass (url-password urlobj))
(host (url-host urlobj)) (host (url-host urlobj))
(port (url-portspec urlobj)) ;; RFC 3986: "omit the port component and its : delimiter if
(file (url-filename urlobj)) ;; port is empty or if its value would be the same as that of
(frag (url-target urlobj))) ;; the scheme's default."
(port (url-port-if-non-default urlobj))
(file (url-filename urlobj))
(frag (url-target urlobj)))
(concat (if type (concat type ":")) (concat (if type (concat type ":"))
(if (url-fullness urlobj) "//") (if (url-fullness urlobj) "//")
(if (or user pass) (if (or user pass)
...@@ -62,15 +92,7 @@ ...@@ -62,15 +92,7 @@
(if pass (concat ":" pass)) (if pass (concat ":" pass))
"@")) "@"))
host host
;; RFC 3986: "omit the port component and its : delimiter (if port (format ":%d" (url-port urlobj)))
;; 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)))
(or file "/") (or file "/")
(if frag (concat "#" frag))))) (if frag (concat "#" frag)))))
...@@ -102,8 +124,8 @@ TARGET is the fragment identifier component (used to refer to a ...@@ -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 ATTRIBUTES is nil; this slot originally stored the attribute and
value alists for IMAP URIs, but this feature was removed value alists for IMAP URIs, but this feature was removed
since it conflicts with RFC 3986. since it conflicts with RFC 3986.
FULLNESS is non-nil iff the authority component of the URI is FULLNESS is non-nil iff the hierarchical sequence component of
present. the URL starts with two slashes, \"//\".
The parser follows RFC 3986, except that it also tries to handle The parser follows RFC 3986, except that it also tries to handle
URIs that are not fully specified (e.g. lacking TYPE), and it URIs that are not fully specified (e.g. lacking TYPE), and it
...@@ -174,10 +196,6 @@ parses to ...@@ -174,10 +196,6 @@ parses to
(setq port (string-to-number port)))) (setq port (string-to-number port))))
(setq host (downcase host))) (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 ;; Now point is on the / ? or # which terminates the
;; authority, or at the end of the URI, or (if there is no ;; authority, or at the end of the URI, or (if there is no
;; authority) at the beginning of the absolute path. ;; authority) at the beginning of the absolute path.
......
...@@ -418,31 +418,26 @@ should return it unchanged." ...@@ -418,31 +418,26 @@ should return it unchanged."
(user (url-user obj))