* url-parse.el (url): Use defstruct rather than macros. Update all callers.

diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog
index 46a2bb62a75247980efd77651ef25f647301af5b..7c03877a1617ba25efa794666f5a53673d63cb9d 100644 (file)
--- a/lisp/url/ChangeLog
+++ b/lisp/url/ChangeLog
@@ -1,3 +1,14 @@
+2007-08-31  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+       * url-parse.el (url): Use defstruct rather than macros.
+       (url-generic-parse-url):
+       * url-util.el (url-normalize-url, url-truncate-url-for-viewing):
+       * url-methods.el (url-scheme-register-proxy):
+       * url-mailto.el (url-mailto):
+       * url-file.el (url-file-build-filename):
+       * url-expand.el (url-identity-expander, url-default-expander):
+       Update all callers.
+
 2007-08-08  Glenn Morris  <rgm@gnu.org>
 
        * url-auth.el, url-cache.el, url-dav.el, url-file.el, vc-dav.el:

diff --git a/lisp/url/url-expand.el b/lisp/url/url-expand.el
index 7b3b105d951c3d113202a825418dcfd4944b6634..df4de29a619e367acf4d777d0ec79e79752ec6f8 100644 (file)
--- a/lisp/url/url-expand.el
+++ b/lisp/url/url-expand.el
@@ -106,24 +106,24 @@ path components followed by `..' are removed, along with the `..' itself."
       (url-recreate-url urlobj)))))
 
 (defun url-identity-expander (urlobj defobj)
-  (url-set-type urlobj (or (url-type urlobj) (url-type defobj))))
+  (setf (url-type urlobj) (or (url-type urlobj) (url-type defobj))))
 
 (defun url-default-expander (urlobj defobj)
   ;; The default expansion routine - urlobj is modified by side effect!
   (if (url-type urlobj)
       ;; Well, they told us the scheme, let's just go with it.
       nil
-    (url-set-type urlobj (or (url-type urlobj) (url-type defobj)))
-    (url-set-port urlobj (or (url-port urlobj)
-                            (and (string= (url-type urlobj)
-                                          (url-type defobj))
-                                 (url-port defobj))))
+    (setf (url-type urlobj) (or (url-type urlobj) (url-type defobj)))
+    (setf (url-port urlobj) (or (url-port urlobj)
+                                (and (string= (url-type urlobj)
+                                              (url-type defobj))
+                                     (url-port defobj))))
     (if (not (string= "file" (url-type urlobj)))
-       (url-set-host urlobj (or (url-host urlobj) (url-host defobj))))
+       (setf (url-host urlobj) (or (url-host urlobj) (url-host defobj))))
     (if (string= "ftp"  (url-type urlobj))
-       (url-set-user urlobj (or (url-user urlobj) (url-user defobj))))
+       (setf (url-user urlobj) (or (url-user urlobj) (url-user defobj))))
     (if (string= (url-filename urlobj) "")
-       (url-set-filename urlobj "/"))
+       (setf (url-filename urlobj) "/"))
     (if (string-match "^/" (url-filename urlobj))
        nil
       (let ((query nil)
@@ -136,9 +136,10 @@ path components followed by `..' are removed, along with the `..' itself."
          (setq file (url-filename urlobj)))
        (setq file (url-expander-remove-relative-links
                    (concat (url-basepath (url-filename defobj)) file)))
-       (url-set-filename urlobj (if query (concat file sepchar query) file))))))
+       (setf (url-filename urlobj)
+              (if query (concat file sepchar query) file))))))
 
 (provide 'url-expand)
 
-;;; arch-tag: 7b5f744b-b721-49da-be47-484631680a5a
+;; arch-tag: 7b5f744b-b721-49da-be47-484631680a5a
 ;;; url-expand.el ends here

diff --git a/lisp/url/url-file.el b/lisp/url/url-file.el
index 6e771c9cd6928f2637530230473027c1c66f5138..c361016856b26c7d26a93c5399a224ea7b57d931 100644 (file)
--- a/lisp/url/url-file.el
+++ b/lisp/url/url-file.el
@@ -127,10 +127,11 @@ to them."
     ;; straighten it out for us?
     ;; (if (and (file-directory-p filename)
     ;;          (not (string-match (format "%c$" directory-sep-char) filename)))
-    ;;     (url-set-filename url (format "%s%c" filename directory-sep-char)))
+    ;;     (setf (url-filename url)
+    ;;           (format "%s%c" filename directory-sep-char)))
     (if (and (file-directory-p filename)
             (not (string-match "/\\'" filename)))
-       (url-set-filename url (format "%s/" filename)))
+       (setf (url-filename url) (format "%s/" filename)))
 
 
     ;; If it is a directory, look for an index file first.

diff --git a/lisp/url/url-mailto.el b/lisp/url/url-mailto.el
index 10d08b9633ff355a426990a8409cc782666b871c..4b15d07245b0155786779c6fe169b4965da1a55c 100644 (file)
--- a/lisp/url/url-mailto.el
+++ b/lisp/url/url-mailto.el
@@ -66,7 +66,7 @@
   (if (url-user url)
       ;; malformed mailto URL (mailto://wmperry@gnu.org) instead of
       ;; mailto:wmperry@gnu.org
-      (url-set-filename url (concat (url-user url) "@" (url-filename url))))
+      (setf (url-filename url) (concat (url-user url) "@" (url-filename url))))
   (setq url (url-filename url))
   (let (to args source-url subject func headers-start)
     (if (string-match (regexp-quote "?") url)

diff --git a/lisp/url/url-methods.el b/lisp/url/url-methods.el
index 89c36bec73735ff010bf3684d3dd55e7c55a0d07..94dcd49f00d757353950b55eda47688137357876 100644 (file)
--- a/lisp/url/url-methods.el
+++ b/lisp/url/url-methods.el
@@ -89,19 +89,19 @@
      ;; First check if its something like hostname:port
      ((string-match "^\\([^:]+\\):\\([0-9]+\\)$" env-proxy)
       (setq urlobj (url-generic-parse-url nil)) ; Get a blank object
-      (url-set-type urlobj "http")
-      (url-set-host urlobj (match-string 1 env-proxy))
-      (url-set-port urlobj (string-to-number (match-string 2 env-proxy))))
+      (setf (url-type urlobj) "http")
+      (setf (url-host urlobj) (match-string 1 env-proxy))
+      (setf (url-port urlobj) (string-to-number (match-string 2 env-proxy))))
      ;; Then check if its a fully specified URL
      ((string-match url-nonrelative-link env-proxy)
       (setq urlobj (url-generic-parse-url env-proxy))
-      (url-set-type urlobj "http")
-      (url-set-target urlobj nil))
+      (setf (url-type urlobj) "http")
+      (setf (url-target urlobj) nil))
      ;; Finally, fall back on the assumption that its just a hostname
      (t
       (setq urlobj (url-generic-parse-url nil)) ; Get a blank object
-      (url-set-type urlobj "http")
-      (url-set-host urlobj env-proxy)))
+      (setf (url-type urlobj) "http")
+      (setf (url-host urlobj) env-proxy)))
 
      (if (and (not cur-proxy) urlobj)
         (progn

diff --git a/lisp/url/url-parse.el b/lisp/url/url-parse.el
index 3dfc7ac86a206366fd88845efa1d9b2cc487f991..9f3437f401c7a8468a37f2c667484bc110b77531 100644 (file)
--- a/lisp/url/url-parse.el
+++ b/lisp/url/url-parse.el
@@ -27,64 +27,24 @@
 ;;; Code:
 
 (require 'url-vars)
+(eval-when-compile (require 'cl))
 
 (autoload 'url-scheme-get-property "url-methods")
 
-(defmacro url-type (urlobj)
-  `(aref ,urlobj 0))
+(defstruct (url
+            (:constructor nil)
+            (:constructor url-parse-make-urlobj
+                          (&optional type user password host portspec filename
+                                     target attributes fullness))
+            (:copier nil))
+  type user password host portspec filename target attributes fullness)
 
-(defmacro url-user (urlobj)
-  `(aref ,urlobj 1))
+(defsubst url-port (urlobj)
+  (or (url-portspec urlobj)
+      (if (url-fullness urlobj)
+          (url-scheme-get-property (url-type urlobj) 'default-port))))
 
-(defmacro url-password (urlobj)
-  `(aref ,urlobj 2))
-
-(defmacro url-host (urlobj)
-  `(aref ,urlobj 3))
-
-(defmacro url-port (urlobj)
-  `(or (aref ,urlobj 4)
-      (if (url-fullness ,urlobj)
-         (url-scheme-get-property (url-type ,urlobj) 'default-port))))
-
-(defmacro url-filename (urlobj)
-  `(aref ,urlobj 5))
-
-(defmacro url-target (urlobj)
-  `(aref ,urlobj 6))
-
-(defmacro url-attributes (urlobj)
-  `(aref ,urlobj 7))
-
-(defmacro url-fullness (urlobj)
-  `(aref ,urlobj 8))
-
-(defmacro url-set-type (urlobj type)
-  `(aset ,urlobj 0 ,type))
-
-(defmacro url-set-user (urlobj user)
-  `(aset ,urlobj 1 ,user))
-
-(defmacro url-set-password (urlobj pass)
-  `(aset ,urlobj 2 ,pass))
-
-(defmacro url-set-host (urlobj host)
-  `(aset ,urlobj 3 ,host))
-
-(defmacro url-set-port (urlobj port)
-  `(aset ,urlobj 4 ,port))
-
-(defmacro url-set-filename (urlobj file)
-  `(aset ,urlobj 5 ,file))
-
-(defmacro url-set-target (urlobj targ)
-  `(aset ,urlobj 6 ,targ))
-
-(defmacro url-set-attributes (urlobj targ)
-  `(aset ,urlobj 7 ,targ))
-
-(defmacro url-set-full (urlobj val)
-  `(aset ,urlobj 8 ,val))
+(defsetf url-port (urlobj) (port) `(setf (url-portspec ,urlobj) ,port))
 
 ;;;###autoload
 (defun url-recreate-url (urlobj)
@@ -123,17 +83,14 @@ Format is:
   ;; See RFC 3986.
   (cond
    ((null url)
-    (make-vector 9 nil))
+    (url-parse-make-urlobj))
    ((or (not (string-match url-nonrelative-link url))
        (= ?/ (string-to-char url)))
     ;; This isn't correct, as a relative URL can be a fragment link
     ;; (e.g. "#foo") and many other things (see section 4.2).
     ;; However, let's not fix something that isn't broken, especially
     ;; when close to a release.
-    (let ((retval (make-vector 9 nil)))
-      (url-set-filename retval url)
-      (url-set-full retval nil)
-      retval))
+    (url-parse-make-urlobj nil nil nil nil nil url))
    (t
     (with-temp-buffer
       (set-syntax-table url-parse-syntax-table)
@@ -214,7 +171,8 @@ Format is:
        (setq file (buffer-substring save-pos (point)))
        (if (and host (string-match "%[0-9][0-9]" host))
            (setq host (url-unhex-string host)))
-       (vector prot user pass host port file refs attr full))))))
+       (url-parse-make-urlobj
+         prot user pass host port file refs attr full))))))
 
 (provide 'url-parse)
 

diff --git a/lisp/url/url-util.el b/lisp/url/url-util.el
index fa971da5d17d578be2a7d6c056e9376657e52049..5b5b43a7db7b75888f06d44d34ccb3d56f49638f 100644 (file)
--- a/lisp/url/url-util.el
+++ b/lisp/url/url-util.el
@@ -168,7 +168,7 @@ Strips out default port numbers, etc."
          type (url-type data))
     (if (member type '("www" "about" "mailto" "info"))
        (setq retval url)
-      (url-set-target data nil)
+      (setf (url-target data) nil)
       (setq retval (url-recreate-url data)))
     retval))
 
@@ -421,13 +421,13 @@ WIDTH defaults to the current frame width."
                  (string-match "/" fname))
        (setq fname (substring fname (match-end 0) nil)
              modified (1+ modified))
-       (url-set-filename urlobj fname)
+       (setf (url-filename urlobj) fname)
        (setq url (url-recreate-url urlobj)
              str-width (length url)))
       (if (> modified 1)
          (setq fname (concat "/.../" fname))
        (setq fname (concat "/" fname)))
-      (url-set-filename urlobj fname)
+      (setf (url-filename urlobj) fname)
       (setq url (url-recreate-url urlobj)))
     url))