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:
parent
7c1bfeccb0
commit
d18ec89f1c
@ -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:
|
||||
|
@ -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
|
||||
|
@ -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.
|
||||
|
@ -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)
|
||||
|
@ -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
|
||||
|
@ -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)
|
||||
|
||||
|
@ -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))
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user