1
0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-11-25 07:28:20 +00:00

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

This commit is contained in:
Stefan Monnier 2007-08-31 16:40:05 +00:00
parent 7c1bfeccb0
commit d18ec89f1c
7 changed files with 54 additions and 83 deletions

View File

@ -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:

View File

@ -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

View File

@ -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.

View File

@ -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)

View File

@ -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

View File

@ -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)

View File

@ -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))