Mercurial > emacs
changeset 83823:dd2bcc6758a0
* url-parse.el (url): Use defstruct rather than macros. Update all callers.
| author | Stefan Monnier <monnier@iro.umontreal.ca> |
|---|---|
| date | Fri, 31 Aug 2007 16:40:05 +0000 |
| parents | 8404d44e8ab8 |
| children | 2049b25f88ce |
| files | lisp/url/ChangeLog lisp/url/url-expand.el lisp/url/url-file.el lisp/url/url-mailto.el lisp/url/url-methods.el lisp/url/url-parse.el lisp/url/url-util.el |
| diffstat | 7 files changed, 54 insertions(+), 83 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/url/ChangeLog Fri Aug 31 15:39:18 2007 +0000 +++ b/lisp/url/ChangeLog Fri Aug 31 16:40:05 2007 +0000 @@ -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:
--- a/lisp/url/url-expand.el Fri Aug 31 15:39:18 2007 +0000 +++ b/lisp/url/url-expand.el Fri Aug 31 16:40:05 2007 +0000 @@ -106,24 +106,24 @@ (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 @@ (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
--- a/lisp/url/url-file.el Fri Aug 31 15:39:18 2007 +0000 +++ b/lisp/url/url-file.el Fri Aug 31 16:40:05 2007 +0000 @@ -127,10 +127,11 @@ ;; 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.
--- a/lisp/url/url-mailto.el Fri Aug 31 15:39:18 2007 +0000 +++ b/lisp/url/url-mailto.el Fri Aug 31 16:40:05 2007 +0000 @@ -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)
--- a/lisp/url/url-methods.el Fri Aug 31 15:39:18 2007 +0000 +++ b/lisp/url/url-methods.el Fri Aug 31 16:40:05 2007 +0000 @@ -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
--- a/lisp/url/url-parse.el Fri Aug 31 15:39:18 2007 +0000 +++ b/lisp/url/url-parse.el Fri Aug 31 16:40:05 2007 +0000 @@ -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)) - -(defmacro url-user (urlobj) - `(aref ,urlobj 1)) - -(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)) +(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-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)) +(defsubst url-port (urlobj) + (or (url-portspec urlobj) + (if (url-fullness urlobj) + (url-scheme-get-property (url-type urlobj) 'default-port)))) -(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 @@ ;; 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 @@ (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)
--- a/lisp/url/url-util.el Fri Aug 31 15:39:18 2007 +0000 +++ b/lisp/url/url-util.el Fri Aug 31 16:40:05 2007 +0000 @@ -168,7 +168,7 @@ 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 @@ (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))