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)