aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--etc/NEWS6
-rw-r--r--lisp/ChangeLog14
-rw-r--r--lisp/ffap.el210
-rw-r--r--lisp/url/ChangeLog14
-rw-r--r--lisp/url/url-parse.el64
-rw-r--r--lisp/url/url-util.el37
-rw-r--r--lisp/url/url-vars.el3
7 files changed, 205 insertions, 143 deletions
diff --git a/etc/NEWS b/etc/NEWS
index 10247eb1520..9c7cb834b8d 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -150,6 +150,12 @@ these commands now).
150** erc will look up server/channel names via auth-source and use the 150** erc will look up server/channel names via auth-source and use the
151channel keys found, if any. 151channel keys found, if any.
152 152
153** FFAP
154
155*** The option `ffap-url-unwrap-remote' can now be a list of strings,
156specifying URL types which should be converted to remote file names at
157the FFAP prompt. The default is now '("ftp").
158
153** Follow mode 159** Follow mode
154 160
155*** The obsolete variable `follow-mode-off-hook' has been removed. 161*** The obsolete variable `follow-mode-off-hook' has been removed.
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index f1429f9f875..e983957e285 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,17 @@
12012-05-10 Chong Yidong <cyd@gnu.org>
2
3 * ffap.el (ffap-url-unwrap-local): Make it work right (Bug#9131).
4 Use url-generic-parse-url, and handle host names and Windows
5 filenames properly.
6 (ffap-url-unwrap-remote): Use url-generic-parse-url.
7 (ffap-url-unwrap-remote): Accept list values, specifying a list of
8 URL schemes to work on.
9 (ffap--toggle-read-only): New function.
10 (ffap-read-only, ffap-read-only-other-window)
11 (ffap-read-only-other-frame): Use it.
12 (ffap-fixup-url): Don't check ffap-ftp-regexp, since it is not
13 necessary for ffap-url-unwrap-remote.
14
12012-05-10 Dave Abrahams <dave@boostpro.com> 152012-05-10 Dave Abrahams <dave@boostpro.com>
2 16
3 * cus-start.el (create-lockfiles): Add it. 17 * cus-start.el (create-lockfiles): Add it.
diff --git a/lisp/ffap.el b/lisp/ffap.el
index 905d7873dc2..a8455189cb9 100644
--- a/lisp/ffap.el
+++ b/lisp/ffap.el
@@ -105,6 +105,8 @@
105 105
106;;; Code: 106;;; Code:
107 107
108(require 'url-parse)
109
108(define-obsolete-variable-alias 'ffap-version 'emacs-version "23.2") 110(define-obsolete-variable-alias 'ffap-version 'emacs-version "23.2")
109 111
110(defgroup ffap nil 112(defgroup ffap nil
@@ -136,10 +138,7 @@ If nil, ffap doesn't do shell prompt stripping."
136 regexp) 138 regexp)
137 :group 'ffap) 139 :group 'ffap)
138 140
139(defcustom ffap-ftp-regexp 141(defcustom ffap-ftp-regexp "\\`/[^/:]+:"
140 ;; This used to test for ange-ftp or efs being present, but it should be
141 ;; harmless (and simpler) to give it this value unconditionally.
142 "\\`/[^/:]+:"
143 "File names matching this regexp are treated as remote ffap. 142 "File names matching this regexp are treated as remote ffap.
144If nil, ffap neither recognizes nor generates such names." 143If nil, ffap neither recognizes nor generates such names."
145 :type '(choice (const :tag "Disable" nil) 144 :type '(choice (const :tag "Disable" nil)
@@ -148,15 +147,20 @@ If nil, ffap neither recognizes nor generates such names."
148 :group 'ffap) 147 :group 'ffap)
149 148
150(defcustom ffap-url-unwrap-local t 149(defcustom ffap-url-unwrap-local t
151 "If non-nil, convert `file:' URL to local file name before prompting." 150 "If non-nil, convert some URLs to local file names before prompting.
151Only \"file:\" and \"ftp:\" URLs are converted, and only if they
152do not specify a host, or the host is either \"localhost\" or
153equal to `system-name'."
152 :type 'boolean 154 :type 'boolean
153 :group 'ffap) 155 :group 'ffap)
154 156
155(defcustom ffap-url-unwrap-remote t 157(defcustom ffap-url-unwrap-remote '("ftp")
156 "If non-nil, convert `ftp:' URL to remote file name before prompting. 158 "If non-nil, convert URLs to remote file names before prompting.
157This is ignored if `ffap-ftp-regexp' is nil." 159If the value is a list of strings, that specifies a list of URL
158 :type 'boolean 160schemes (e.g. \"ftp\"); in that case, only convert those URLs."
159 :group 'ffap) 161 :type '(choice (repeat string) boolean)
162 :group 'ffap
163 :version "24.2")
160 164
161(defcustom ffap-ftp-default-user "anonymous" 165(defcustom ffap-ftp-default-user "anonymous"
162 "User name in ftp file names generated by `ffap-host-to-path'. 166 "User name in ftp file names generated by `ffap-host-to-path'.
@@ -247,14 +251,14 @@ ffap most of the time."
247(defcustom ffap-file-finder 'find-file 251(defcustom ffap-file-finder 'find-file
248 "The command called by `find-file-at-point' to find a file." 252 "The command called by `find-file-at-point' to find a file."
249 :type 'function 253 :type 'function
250 :group 'ffap) 254 :group 'ffap
251(put 'ffap-file-finder 'risky-local-variable t) 255 :risky t)
252 256
253(defcustom ffap-directory-finder 'dired 257(defcustom ffap-directory-finder 'dired
254 "The command called by `dired-at-point' to find a directory." 258 "The command called by `dired-at-point' to find a directory."
255 :type 'function 259 :type 'function
256 :group 'ffap) 260 :group 'ffap
257(put 'ffap-directory-finder 'risky-local-variable t) 261 :risky t)
258 262
259(defcustom ffap-url-fetcher 263(defcustom ffap-url-fetcher
260 (if (fboundp 'browse-url) 264 (if (fboundp 'browse-url)
@@ -271,8 +275,28 @@ For a fancy alternative, get `ffap-url.el'."
271 (const browse-url-netscape) 275 (const browse-url-netscape)
272 (const browse-url-mosaic) 276 (const browse-url-mosaic)
273 function) 277 function)
278 :group 'ffap
279 :risky t)
280
281(defcustom ffap-next-regexp
282 ;; If you want ffap-next to find URL's only, try this:
283 ;; (and ffap-url-regexp (string-match "\\\\`" ffap-url-regexp)
284 ;; (concat "\\<" (substring ffap-url-regexp 2))))
285 ;;
286 ;; It pays to put a big fancy regexp here, since ffap-guesser is
287 ;; much more time-consuming than regexp searching:
288 "[/:.~[:alpha:]]/\\|@[[:alpha:]][-[:alnum:]]*\\."
289 "Regular expression governing movements of `ffap-next'."
290 :type 'regexp
274 :group 'ffap) 291 :group 'ffap)
275(put 'ffap-url-fetcher 'risky-local-variable t) 292
293(defcustom dired-at-point-require-prefix nil
294 "If non-nil, reverse the prefix argument to `dired-at-point'.
295This is nil so neophytes notice FFAP. Experts may prefer to
296disable FFAP most of the time."
297 :type 'boolean
298 :group 'ffap
299 :version "20.3")
276 300
277 301
278;;; Compatibility: 302;;; Compatibility:
@@ -293,18 +317,6 @@ For a fancy alternative, get `ffap-url.el'."
293;; then, broke it up into ffap-next-guess (noninteractive) and 317;; then, broke it up into ffap-next-guess (noninteractive) and
294;; ffap-next (a command). It now work on files as well as url's. 318;; ffap-next (a command). It now work on files as well as url's.
295 319
296(defcustom ffap-next-regexp
297 ;; If you want ffap-next to find URL's only, try this:
298 ;; (and ffap-url-regexp (string-match "\\\\`" ffap-url-regexp)
299 ;; (concat "\\<" (substring ffap-url-regexp 2))))
300 ;;
301 ;; It pays to put a big fancy regexp here, since ffap-guesser is
302 ;; much more time-consuming than regexp searching:
303 "[/:.~[:alpha:]]/\\|@[[:alpha:]][-[:alnum:]]*\\."
304 "Regular expression governing movements of `ffap-next'."
305 :type 'regexp
306 :group 'ffap)
307
308(defvar ffap-next-guess nil 320(defvar ffap-next-guess nil
309 "Last value returned by `ffap-next-guess'.") 321 "Last value returned by `ffap-next-guess'.")
310 322
@@ -606,28 +618,45 @@ Looks at `ffap-ftp-default-user', returns \"\" for \"localhost\"."
606 string))) 618 string)))
607 619
608;; Broke these out of ffap-fixup-url, for use of ffap-url package. 620;; Broke these out of ffap-fixup-url, for use of ffap-url package.
609(defsubst ffap-url-unwrap-local (url) 621(defun ffap-url-unwrap-local (url)
610 "Return URL as a local file, or nil. Ignores `ffap-url-regexp'." 622 "Return URL as a local file name, or nil."
611 (and (string-match "\\`\\(file\\|ftp\\):/?\\([^/]\\|\\'\\)" url) 623 (let* ((obj (url-generic-parse-url url))
612 (substring url (1+ (match-end 1))))) 624 (host (url-host obj))
613(defsubst ffap-url-unwrap-remote (url) 625 (filename (car (url-path-and-query obj))))
614 "Return URL as a remote file, or nil. Ignores `ffap-url-regexp'." 626 (when (and (member (url-type obj) '("ftp" "file"))
615 (and (string-match "\\`\\(ftp\\|file\\)://\\([^:/]+\\):?\\(/.*\\)" url) 627 (member host `("" "localhost" ,(system-name))))
616 (concat 628 ;; On Windows, "file:///C:/foo" should unwrap to "C:/foo"
617 (ffap-host-to-filename (substring url (match-beginning 2) (match-end 2))) 629 (if (and (memq system-type '(ms-dos windows-nt cygwin))
618 (substring url (match-beginning 3) (match-end 3))))) 630 (string-match "\\`/[a-zA-Z]:" filename))
619;; Test: (ffap-url-unwrap-remote "ftp://foo.com/bar.boz") 631 (substring filename 1)
632 filename))))
633
634(defun ffap-url-unwrap-remote (url)
635 "Return URL as a remote file name, or nil."
636 (let* ((obj (url-generic-parse-url url))
637 (scheme (url-type obj))
638 (valid-schemes (if (listp ffap-url-unwrap-remote)
639 ffap-url-unwrap-remote
640 '("ftp")))
641 (host (url-host obj))
642 (port (url-port-if-non-default obj))
643 (user (url-user obj))
644 (filename (car (url-path-and-query obj))))
645 (when (and (member scheme valid-schemes)
646 (string-match "\\`[a-zA-Z][-a-zA-Z0-9+.]*\\'" scheme)
647 (not (equal host "")))
648 (concat "/" scheme ":"
649 (if user (concat user "@"))
650 host
651 (if port (concat "#" (number-to-string port)))
652 ":" filename))))
620 653
621(defun ffap-fixup-url (url) 654(defun ffap-fixup-url (url)
622 "Clean up URL and return it, maybe as a file name." 655 "Clean up URL and return it, maybe as a file name."
623 (cond 656 (cond
624 ((not (stringp url)) nil) 657 ((not (stringp url)) nil)
625 ((and ffap-url-unwrap-local (ffap-url-unwrap-local url))) 658 ((and ffap-url-unwrap-local (ffap-url-unwrap-local url)))
626 ((and ffap-url-unwrap-remote ffap-ftp-regexp 659 ((and ffap-url-unwrap-remote (ffap-url-unwrap-remote url)))
627 (ffap-url-unwrap-remote url)))
628 ;; All this seems to do is remove any trailing "#anchor" part (Bug#898).
629;;; ((fboundp 'url-normalize-url) ; may autoload url (part of w3)
630;;; (url-normalize-url url))
631 (url))) 660 (url)))
632 661
633 662
@@ -1076,38 +1105,33 @@ Assumes the buffer has not changed."
1076 ;; ignore non-relative links, trim punctuation. The other will 1105 ;; ignore non-relative links, trim punctuation. The other will
1077 ;; actually look back if point is in whitespace, but I would rather 1106 ;; actually look back if point is in whitespace, but I would rather
1078 ;; ffap be less aggressive in such situations. 1107 ;; ffap be less aggressive in such situations.
1079 (and 1108 (when ffap-url-regexp
1080 ffap-url-regexp 1109 (or (and (eq major-mode 'w3-mode) ; In a w3 buffer button?
1081 (or 1110 (w3-view-this-url t))
1082 ;; In a w3 buffer button? 1111 ;; Is there a reason not to strip trailing colon?
1083 (and (eq major-mode 'w3-mode) 1112 (let ((name (ffap-string-at-point 'url)))
1084 ;; interface recommended by wmperry: 1113 (cond
1085 (w3-view-this-url t)) 1114 ((string-match "^url:" name) (setq name (substring name 4)))
1086 ;; Is there a reason not to strip trailing colon? 1115 ((and (string-match "\\`[^:</>@]+@[^:</>@]+[[:alnum:]]\\'" name)
1087 (let ((name (ffap-string-at-point 'url))) 1116 ;; "foo@bar": could be "mailto" or "news" (a Message-ID).
1088 (cond 1117 ;; Without "<>" it must be "mailto". Otherwise could be
1089 ((string-match "^url:" name) (setq name (substring name 4))) 1118 ;; either, so consult `ffap-foo-at-bar-prefix'.
1090 ((and (string-match "\\`[^:</>@]+@[^:</>@]+[[:alnum:]]\\'" name) 1119 (let ((prefix (if (and (equal (ffap-string-around) "<>")
1091 ;; "foo@bar": could be "mailto" or "news" (a Message-ID). 1120 ;; Expect some odd characters:
1092 ;; Without "<>" it must be "mailto". Otherwise could be 1121 (string-match "[$.0-9].*[$.0-9].*@" name))
1093 ;; either, so consult `ffap-foo-at-bar-prefix'. 1122 ;; Could be news:
1094 (let ((prefix (if (and (equal (ffap-string-around) "<>") 1123 ffap-foo-at-bar-prefix
1095 ;; Expect some odd characters: 1124 "mailto")))
1096 (string-match "[$.0-9].*[$.0-9].*@" name)) 1125 (and prefix (setq name (concat prefix ":" name))))))
1097 ;; Could be news: 1126 ((ffap-newsgroup-p name) (setq name (concat "news:" name)))
1098 ffap-foo-at-bar-prefix 1127 ((and (string-match "\\`[[:alnum:]]+\\'" name) ; <mic> <root> <nobody>
1099 "mailto"))) 1128 (equal (ffap-string-around) "<>")
1100 (and prefix (setq name (concat prefix ":" name)))))) 1129 ;; (ffap-user-p name):
1101 ((ffap-newsgroup-p name) (setq name (concat "news:" name))) 1130 (not (string-match "~" (expand-file-name (concat "~" name)))))
1102 ((and (string-match "\\`[[:alnum:]]+\\'" name) ; <mic> <root> <nobody> 1131 (setq name (concat "mailto:" name))))
1103 (equal (ffap-string-around) "<>") 1132
1104 ;; (ffap-user-p name): 1133 (if (ffap-url-p name)
1105 (not (string-match "~" (expand-file-name (concat "~" name)))) 1134 name)))))
1106 )
1107 (setq name (concat "mailto:" name)))
1108 )
1109 (and (ffap-url-p name) name)
1110 ))))
1111 1135
1112(defvar ffap-gopher-regexp 1136(defvar ffap-gopher-regexp
1113 "^.*\\<\\(Type\\|Name\\|Path\\|Host\\|Port\\) *= *\\(.*\\) *$" 1137 "^.*\\<\\(Type\\|Name\\|Path\\|Host\\|Port\\) *= *\\(.*\\) *$"
@@ -1342,8 +1366,6 @@ which may actually result in an URL rather than a filename."
1342 1366
1343 1367
1344;;; Highlighting (`ffap-highlight'): 1368;;; Highlighting (`ffap-highlight'):
1345;;
1346;; Based on overlay highlighting in Emacs 19.28 isearch.el.
1347 1369
1348(defvar ffap-highlight t 1370(defvar ffap-highlight t
1349 "If non-nil, ffap highlights the current buffer substring.") 1371 "If non-nil, ffap highlights the current buffer substring.")
@@ -1676,6 +1698,11 @@ Only intended for interactive use."
1676 (set-window-dedicated-p win wdp)) 1698 (set-window-dedicated-p win wdp))
1677 value)) 1699 value))
1678 1700
1701(defun ffap--toggle-read-only (buffer)
1702 (with-current-buffer buffer
1703 (with-no-warnings
1704 (toggle-read-only 1))))
1705
1679(defun ffap-read-only () 1706(defun ffap-read-only ()
1680 "Like `ffap', but mark buffer as read-only. 1707 "Like `ffap', but mark buffer as read-only.
1681Only intended for interactive use." 1708Only intended for interactive use."
@@ -1683,7 +1710,7 @@ Only intended for interactive use."
1683 (let ((value (call-interactively 'ffap))) 1710 (let ((value (call-interactively 'ffap)))
1684 (unless (or (bufferp value) (bufferp (car-safe value))) 1711 (unless (or (bufferp value) (bufferp (car-safe value)))
1685 (setq value (current-buffer))) 1712 (setq value (current-buffer)))
1686 (mapc (lambda (b) (with-current-buffer b (toggle-read-only 1))) 1713 (mapc #'ffap--toggle-read-only
1687 (if (listp value) value (list value))) 1714 (if (listp value) value (list value)))
1688 value)) 1715 value))
1689 1716
@@ -1692,7 +1719,7 @@ Only intended for interactive use."
1692Only intended for interactive use." 1719Only intended for interactive use."
1693 (interactive) 1720 (interactive)
1694 (let ((value (ffap-other-window))) 1721 (let ((value (ffap-other-window)))
1695 (mapc (lambda (b) (with-current-buffer b (toggle-read-only 1))) 1722 (mapc #'ffap--toggle-read-only
1696 (if (listp value) value (list value))) 1723 (if (listp value) value (list value)))
1697 value)) 1724 value))
1698 1725
@@ -1701,7 +1728,7 @@ Only intended for interactive use."
1701Only intended for interactive use." 1728Only intended for interactive use."
1702 (interactive) 1729 (interactive)
1703 (let ((value (ffap-other-frame))) 1730 (let ((value (ffap-other-frame)))
1704 (mapc (lambda (b) (with-current-buffer b (toggle-read-only 1))) 1731 (mapc #'ffap--toggle-read-only
1705 (if (listp value) value (list value))) 1732 (if (listp value) value (list value)))
1706 value)) 1733 value))
1707 1734
@@ -1743,8 +1770,7 @@ Only intended for interactive use."
1743(defun ffap-ro-mode-hook () 1770(defun ffap-ro-mode-hook ()
1744 "Bind `ffap-next' and `ffap-menu' to M-l and M-m, resp." 1771 "Bind `ffap-next' and `ffap-menu' to M-l and M-m, resp."
1745 (local-set-key "\M-l" 'ffap-next) 1772 (local-set-key "\M-l" 'ffap-next)
1746 (local-set-key "\M-m" 'ffap-menu) 1773 (local-set-key "\M-m" 'ffap-menu))
1747 )
1748 1774
1749(defun ffap-gnus-hook () 1775(defun ffap-gnus-hook ()
1750 "Bind `ffap-gnus-next' and `ffap-gnus-menu' to M-l and M-m, resp." 1776 "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 (interactive) (ffap-gnus-wrapper '(ffap-menu))) 1814 (interactive) (ffap-gnus-wrapper '(ffap-menu)))
1789 1815
1790 1816
1791(defcustom dired-at-point-require-prefix nil
1792 "If set, reverses the prefix argument to `dired-at-point'.
1793This is nil so neophytes notice ffap. Experts may prefer to disable
1794ffap most of the time."
1795 :type 'boolean
1796 :group 'ffap
1797 :version "20.3")
1798 1817
1799;;;###autoload 1818;;;###autoload
1800(defun dired-at-point (&optional filename) 1819(defun dired-at-point (&optional filename)
@@ -1901,7 +1920,7 @@ Only intended for interactive use."
1901;;; Hooks to put in `file-name-at-point-functions': 1920;;; Hooks to put in `file-name-at-point-functions':
1902 1921
1903;;;###autoload 1922;;;###autoload
1904(progn (defun ffap-guess-file-name-at-point () 1923(defun ffap-guess-file-name-at-point ()
1905 "Try to get a file name at point. 1924 "Try to get a file name at point.
1906This hook is intended to be put in `file-name-at-point-functions'." 1925This hook is intended to be put in `file-name-at-point-functions'."
1907 (when (fboundp 'ffap-guesser) 1926 (when (fboundp 'ffap-guesser)
@@ -1918,14 +1937,13 @@ This hook is intended to be put in `file-name-at-point-functions'."
1918 (when guess 1937 (when guess
1919 (if (file-directory-p guess) 1938 (if (file-directory-p guess)
1920 (file-name-as-directory guess) 1939 (file-name-as-directory guess)
1921 guess)))))) 1940 guess)))))
1922 1941
1923 1942
1924;;; Offer default global bindings (`ffap-bindings'): 1943;;; Offer default global bindings (`ffap-bindings'):
1925 1944
1926(defvar ffap-bindings 1945(defvar ffap-bindings
1927 '( 1946 '((global-set-key [S-mouse-3] 'ffap-at-mouse)
1928 (global-set-key [S-mouse-3] 'ffap-at-mouse)
1929 (global-set-key [C-S-mouse-3] 'ffap-menu) 1947 (global-set-key [C-S-mouse-3] 'ffap-menu)
1930 1948
1931 (global-set-key "\C-x\C-f" 'find-file-at-point) 1949 (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 (add-hook 'gnus-summary-mode-hook 'ffap-gnus-hook) 1963 (add-hook 'gnus-summary-mode-hook 'ffap-gnus-hook)
1946 (add-hook 'gnus-article-mode-hook 'ffap-gnus-hook) 1964 (add-hook 'gnus-article-mode-hook 'ffap-gnus-hook)
1947 (add-hook 'vm-mode-hook 'ffap-ro-mode-hook) 1965 (add-hook 'vm-mode-hook 'ffap-ro-mode-hook)
1948 (add-hook 'rmail-mode-hook 'ffap-ro-mode-hook) 1966 (add-hook 'rmail-mode-hook 'ffap-ro-mode-hook))
1949 ;; (setq dired-x-hands-off-my-keys t) ; the default
1950 )
1951 "List of binding forms evaluated by function `ffap-bindings'. 1967 "List of binding forms evaluated by function `ffap-bindings'.
1952A reasonable ffap installation needs just this one line: 1968A reasonable ffap installation needs just this one line:
1953 (ffap-bindings) 1969 (ffap-bindings)
diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog
index b3669a72ac3..c41df0e832b 100644
--- a/lisp/url/ChangeLog
+++ b/lisp/url/ChangeLog
@@ -1,3 +1,16 @@
12012-05-10 Chong Yidong <cyd@gnu.org>
2
3 * url-parse.el (url-path-and-query, url-port-if-non-default): New
4 functions.
5 (url-generic-parse-url): Don't set the portspec slot if it is not
6 specified; that is what `url-port' is for.
7 (url-port): Only require the scheme to be specified to call
8 url-scheme-get-property.
9
10 * url-util.el (url-encode-url): Use url-path-and-query.
11
12 * url-vars.el (url-mime-charset-string): Load mm-util lazily.
13
12012-05-09 Chong Yidong <cyd@gnu.org> 142012-05-09 Chong Yidong <cyd@gnu.org>
2 15
3 * url-util.el (url-encode-url): New function for URL quoting. 16 * url-util.el (url-encode-url): New function for URL quoting.
@@ -12,6 +25,7 @@
12 whole path and query inside the FILENAME slot. Improve docstring. 25 whole path and query inside the FILENAME slot. Improve docstring.
13 (url-recreate-url-attributes): Mark as obsolete. 26 (url-recreate-url-attributes): Mark as obsolete.
14 (url-recreate-url): Handle missing scheme and userinfo. 27 (url-recreate-url): Handle missing scheme and userinfo.
28 (url-path-and-query): New function.
15 29
16 * url-http.el (url-http-create-request): Ignore obsolete 30 * url-http.el (url-http-create-request): Ignore obsolete
17 attributes slot of url-object. 31 attributes slot of url-object.
diff --git a/lisp/url/url-parse.el b/lisp/url/url-parse.el
index 40183a4f533..18c5790313e 100644
--- a/lisp/url/url-parse.el
+++ b/lisp/url/url-parse.el
@@ -39,22 +39,52 @@
39 silent (use-cookies t)) 39 silent (use-cookies t))
40 40
41(defsubst url-port (urlobj) 41(defsubst url-port (urlobj)
42 "Return the port number for the URL specified by URLOBJ."
42 (or (url-portspec urlobj) 43 (or (url-portspec urlobj)
43 (if (url-fullness urlobj) 44 (if (url-type urlobj)
44 (url-scheme-get-property (url-type urlobj) 'default-port)))) 45 (url-scheme-get-property (url-type urlobj) 'default-port))))
45 46
46(defsetf url-port (urlobj) (port) `(setf (url-portspec ,urlobj) ,port)) 47(defsetf url-port (urlobj) (port) `(setf (url-portspec ,urlobj) ,port))
47 48
49(defun url-path-and-query (urlobj)
50 "Return the path and query components of URLOBJ.
51These two components are store together in the FILENAME slot of
52the object. The return value of this function is (PATH . QUERY),
53where each of PATH and QUERY are strings or nil."
54 (let ((name (url-filename urlobj))
55 path query)
56 (when name
57 (if (string-match "\\?" name)
58 (setq path (substring name 0 (match-beginning 0))
59 query (substring name (match-end 0)))
60 (setq path name)))
61 (if (equal path "") (setq path nil))
62 (if (equal query "") (setq query nil))
63 (cons path query)))
64
65(defun url-port-if-non-default (urlobj)
66 "Return the port number specified by URLOBJ, if it is not the default.
67If the specified port number is the default, return nil."
68 (let ((port (url-portspec urlobj))
69 type)
70 (and port
71 (or (null (setq type (url-type urlobj)))
72 (not (equal port (url-scheme-get-property type 'default-port))))
73 port)))
74
48;;;###autoload 75;;;###autoload
49(defun url-recreate-url (urlobj) 76(defun url-recreate-url (urlobj)
50 "Recreate a URL string from the parsed URLOBJ." 77 "Recreate a URL string from the parsed URLOBJ."
51 (let ((type (url-type urlobj)) 78 (let* ((type (url-type urlobj))
52 (user (url-user urlobj)) 79 (user (url-user urlobj))
53 (pass (url-password urlobj)) 80 (pass (url-password urlobj))
54 (host (url-host urlobj)) 81 (host (url-host urlobj))
55 (port (url-portspec urlobj)) 82 ;; RFC 3986: "omit the port component and its : delimiter if
56 (file (url-filename urlobj)) 83 ;; port is empty or if its value would be the same as that of
57 (frag (url-target urlobj))) 84 ;; the scheme's default."
85 (port (url-port-if-non-default urlobj))
86 (file (url-filename urlobj))
87 (frag (url-target urlobj)))
58 (concat (if type (concat type ":")) 88 (concat (if type (concat type ":"))
59 (if (url-fullness urlobj) "//") 89 (if (url-fullness urlobj) "//")
60 (if (or user pass) 90 (if (or user pass)
@@ -62,15 +92,7 @@
62 (if pass (concat ":" pass)) 92 (if pass (concat ":" pass))
63 "@")) 93 "@"))
64 host 94 host
65 ;; RFC 3986: "omit the port component and its : delimiter 95 (if port (format ":%d" (url-port urlobj)))
66 ;; if port is empty or if its value would be the same as
67 ;; that of the scheme's default."
68 (and port
69 (or (null type)
70 (not (equal port
71 (url-scheme-get-property type
72 'default-port))))
73 (format ":%d" (url-port urlobj)))
74 (or file "/") 96 (or file "/")
75 (if frag (concat "#" frag))))) 97 (if frag (concat "#" frag)))))
76 98
@@ -102,8 +124,8 @@ TARGET is the fragment identifier component (used to refer to a
102ATTRIBUTES is nil; this slot originally stored the attribute and 124ATTRIBUTES is nil; this slot originally stored the attribute and
103 value alists for IMAP URIs, but this feature was removed 125 value alists for IMAP URIs, but this feature was removed
104 since it conflicts with RFC 3986. 126 since it conflicts with RFC 3986.
105FULLNESS is non-nil iff the authority component of the URI is 127FULLNESS is non-nil iff the hierarchical sequence component of
106 present. 128 the URL starts with two slashes, \"//\".
107 129
108The parser follows RFC 3986, except that it also tries to handle 130The parser follows RFC 3986, except that it also tries to handle
109URIs that are not fully specified (e.g. lacking TYPE), and it 131URIs that are not fully specified (e.g. lacking TYPE), and it
@@ -174,10 +196,6 @@ parses to
174 (setq port (string-to-number port)))) 196 (setq port (string-to-number port))))
175 (setq host (downcase host))) 197 (setq host (downcase host)))
176 198
177 (and (null port)
178 scheme
179 (setq port (url-scheme-get-property scheme 'default-port)))
180
181 ;; Now point is on the / ? or # which terminates the 199 ;; Now point is on the / ? or # which terminates the
182 ;; authority, or at the end of the URI, or (if there is no 200 ;; authority, or at the end of the URI, or (if there is no
183 ;; authority) at the beginning of the absolute path. 201 ;; authority) at the beginning of the absolute path.
diff --git a/lisp/url/url-util.el b/lisp/url/url-util.el
index 4185c87918e..71bc84cab09 100644
--- a/lisp/url/url-util.el
+++ b/lisp/url/url-util.el
@@ -418,31 +418,26 @@ should return it unchanged."
418 (user (url-user obj)) 418 (user (url-user obj))
419 (pass (url-password obj)) 419 (pass (url-password obj))
420 (host (url-host obj)) 420 (host (url-host obj))
421 (file (url-filename obj)) 421 (path-and-query (url-path-and-query obj))
422 (frag (url-target obj)) 422 (path (car path-and-query))
423 path query) 423 (query (cdr path-and-query))
424 (frag (url-target obj)))
424 (if user 425 (if user
425 (setf (url-user obj) (url-hexify-string user))) 426 (setf (url-user obj) (url-hexify-string user)))
426 (if pass 427 (if pass
427 (setf (url-password obj) (url-hexify-string pass))) 428 (setf (url-password obj) (url-hexify-string pass)))
428 (when host 429 ;; No special encoding for IPv6 literals.
429 ;; No special encoding for IPv6 literals. 430 (and host
430 (unless (string-match "\\`\\[.*\\]\\'" host) 431 (not (string-match "\\`\\[.*\\]\\'" host))
431 (setf (url-host obj) 432 (setf (url-host obj)
432 (url-hexify-string host url-host-allowed-chars)))) 433 (url-hexify-string host url-host-allowed-chars)))
433 ;; Split FILENAME slot into its PATH and QUERY components, and 434
434 ;; encode them separately. The PATH component can contain 435 (if path
435 ;; unreserved characters, %-encodings, and /:@!$&'()*+,;= 436 (setq path (url-hexify-string path url-path-allowed-chars)))
436 (when file 437 (if query
437 (if (string-match "\\?" file) 438 (setq query (url-hexify-string query url-query-allowed-chars)))
438 (setq path (substring file 0 (match-beginning 0)) 439 (setf (url-filename obj) (if query (concat path "?" query) path))
439 query (substring file (match-end 0))) 440
440 (setq path file))
441 (setq path (url-hexify-string path url-path-allowed-chars))
442 (if query
443 (setq query (url-hexify-string query url-query-allowed-chars)))
444 (setf (url-filename obj)
445 (if query (concat path "?" query) path)))
446 (if frag 441 (if frag
447 (setf (url-target obj) 442 (setf (url-target obj)
448 (url-hexify-string frag url-query-allowed-chars))) 443 (url-hexify-string frag url-query-allowed-chars)))
diff --git a/lisp/url/url-vars.el b/lisp/url/url-vars.el
index 0d71910849f..6aa14b8bae1 100644
--- a/lisp/url/url-vars.el
+++ b/lisp/url/url-vars.el
@@ -21,8 +21,6 @@
21 21
22;;; Code: 22;;; Code:
23 23
24(require 'mm-util)
25
26(defconst url-version "Emacs" 24(defconst url-version "Emacs"
27 "Version number of URL package.") 25 "Version number of URL package.")
28 26
@@ -221,6 +219,7 @@ Should be an assoc list of headers/contents.")
221(defun url-mime-charset-string () 219(defun url-mime-charset-string ()
222 "Generate a list of preferred MIME charsets for HTTP requests. 220 "Generate a list of preferred MIME charsets for HTTP requests.
223Generated according to current coding system priorities." 221Generated according to current coding system priorities."
222 (require 'mm-util)
224 (if (fboundp 'sort-coding-systems) 223 (if (fboundp 'sort-coding-systems)
225 (let ((ordered (sort-coding-systems 224 (let ((ordered (sort-coding-systems
226 (let (accum) 225 (let (accum)