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

4 files changed, 72 insertions, 46 deletions

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 @@
+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.
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 @@
   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.
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."
 	 (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)))
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 @@
 
 ;;; 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)