Commit | Line | Data |
---|---|---|
8c8b8430 | 1 | ;;; url-parse.el --- Uniform Resource Locator parser |
ffc00a35 | 2 | |
df41da5e | 3 | ;; Copyright (c) 1996,1997,1998,1999,2004 Free Software Foundation, Inc. |
ffc00a35 | 4 | |
8c8b8430 SM |
5 | ;; Keywords: comm, data, processes |
6 | ||
ffc00a35 SM |
7 | ;; This file is part of GNU Emacs. |
8 | ;; | |
9 | ;; GNU Emacs is free software; you can redistribute it and/or modify | |
10 | ;; it under the terms of the GNU General Public License as published by | |
11 | ;; the Free Software Foundation; either version 2, or (at your option) | |
12 | ;; any later version. | |
13 | ;; | |
14 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
17 | ;; GNU General Public License for more details. | |
18 | ;; | |
19 | ;; You should have received a copy of the GNU General Public License | |
20 | ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
4fc5845f LK |
21 | ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
22 | ;; Boston, MA 02110-1301, USA. | |
ffc00a35 SM |
23 | |
24 | ;;; Commentary: | |
25 | ||
26 | ;;; Code: | |
27 | ||
8c8b8430 SM |
28 | (require 'url-vars) |
29 | ||
30 | (autoload 'url-scheme-get-property "url-methods") | |
31 | ||
32 | (defmacro url-type (urlobj) | |
33 | `(aref ,urlobj 0)) | |
34 | ||
35 | (defmacro url-user (urlobj) | |
36 | `(aref ,urlobj 1)) | |
37 | ||
38 | (defmacro url-password (urlobj) | |
39 | `(aref ,urlobj 2)) | |
40 | ||
41 | (defmacro url-host (urlobj) | |
42 | `(aref ,urlobj 3)) | |
43 | ||
44 | (defmacro url-port (urlobj) | |
45 | `(or (aref ,urlobj 4) | |
46 | (if (url-fullness ,urlobj) | |
47 | (url-scheme-get-property (url-type ,urlobj) 'default-port)))) | |
48 | ||
49 | (defmacro url-filename (urlobj) | |
50 | `(aref ,urlobj 5)) | |
51 | ||
52 | (defmacro url-target (urlobj) | |
53 | `(aref ,urlobj 6)) | |
54 | ||
55 | (defmacro url-attributes (urlobj) | |
56 | `(aref ,urlobj 7)) | |
57 | ||
58 | (defmacro url-fullness (urlobj) | |
59 | `(aref ,urlobj 8)) | |
60 | ||
61 | (defmacro url-set-type (urlobj type) | |
62 | `(aset ,urlobj 0 ,type)) | |
63 | ||
64 | (defmacro url-set-user (urlobj user) | |
65 | `(aset ,urlobj 1 ,user)) | |
66 | ||
67 | (defmacro url-set-password (urlobj pass) | |
68 | `(aset ,urlobj 2 ,pass)) | |
69 | ||
70 | (defmacro url-set-host (urlobj host) | |
71 | `(aset ,urlobj 3 ,host)) | |
72 | ||
73 | (defmacro url-set-port (urlobj port) | |
74 | `(aset ,urlobj 4 ,port)) | |
75 | ||
76 | (defmacro url-set-filename (urlobj file) | |
77 | `(aset ,urlobj 5 ,file)) | |
78 | ||
79 | (defmacro url-set-target (urlobj targ) | |
80 | `(aset ,urlobj 6 ,targ)) | |
81 | ||
82 | (defmacro url-set-attributes (urlobj targ) | |
83 | `(aset ,urlobj 7 ,targ)) | |
84 | ||
85 | (defmacro url-set-full (urlobj val) | |
86 | `(aset ,urlobj 8 ,val)) | |
87 | ||
88 | ;;;###autoload | |
89 | (defun url-recreate-url (urlobj) | |
61bbdf64 | 90 | "Recreate a URL string from the parsed URLOBJ." |
8c8b8430 SM |
91 | (concat (url-type urlobj) ":" (if (url-host urlobj) "//" "") |
92 | (if (url-user urlobj) | |
93 | (concat (url-user urlobj) | |
94 | (if (url-password urlobj) | |
95 | (concat ":" (url-password urlobj))) | |
96 | "@")) | |
97 | (url-host urlobj) | |
98 | (if (and (url-port urlobj) | |
99 | (not (equal (url-port urlobj) | |
100 | (url-scheme-get-property (url-type urlobj) 'default-port)))) | |
101 | (format ":%d" (url-port urlobj))) | |
102 | (or (url-filename urlobj) "/") | |
103 | (if (url-target urlobj) | |
104 | (concat "#" (url-target urlobj))) | |
105 | (if (url-attributes urlobj) | |
106 | (concat ";" | |
107 | (mapconcat | |
108 | (function | |
109 | (lambda (x) | |
110 | (if (cdr x) | |
111 | (concat (car x) "=" (cdr x)) | |
112 | (car x)))) (url-attributes urlobj) ";"))))) | |
113 | ||
114 | ;;;###autoload | |
115 | (defun url-generic-parse-url (url) | |
116 | "Return a vector of the parts of URL. | |
117 | Format is: | |
61bbdf64 | 118 | \[TYPE USER PASSWORD HOST PORT FILE TARGET ATTRIBUTES FULL\]" |
8c8b8430 SM |
119 | (cond |
120 | ((null url) | |
121 | (make-vector 9 nil)) | |
122 | ((or (not (string-match url-nonrelative-link url)) | |
123 | (= ?/ (string-to-char url))) | |
124 | (let ((retval (make-vector 9 nil))) | |
125 | (url-set-filename retval url) | |
126 | (url-set-full retval nil) | |
127 | retval)) | |
128 | (t | |
129 | (save-excursion | |
130 | (set-buffer (get-buffer-create " *urlparse*")) | |
131 | (set-syntax-table url-parse-syntax-table) | |
132 | (let ((save-pos nil) | |
133 | (prot nil) | |
134 | (user nil) | |
135 | (pass nil) | |
136 | (host nil) | |
137 | (port nil) | |
138 | (file nil) | |
139 | (refs nil) | |
140 | (attr nil) | |
141 | (full nil) | |
142 | (inhibit-read-only t)) | |
143 | (erase-buffer) | |
144 | (insert url) | |
145 | (goto-char (point-min)) | |
146 | (setq save-pos (point)) | |
147 | (if (not (looking-at "//")) | |
148 | (progn | |
149 | (skip-chars-forward "a-zA-Z+.\\-") | |
150 | (downcase-region save-pos (point)) | |
151 | (setq prot (buffer-substring save-pos (point))) | |
152 | (skip-chars-forward ":") | |
153 | (setq save-pos (point)))) | |
154 | ||
155 | ;; We are doing a fully specified URL, with hostname and all | |
156 | (if (looking-at "//") | |
157 | (progn | |
158 | (setq full t) | |
159 | (forward-char 2) | |
160 | (setq save-pos (point)) | |
161 | (skip-chars-forward "^/") | |
162 | (setq host (buffer-substring save-pos (point))) | |
163 | (if (string-match "^\\([^@]+\\)@" host) | |
164 | (setq user (match-string 1 host) | |
165 | host (substring host (match-end 0) nil))) | |
166 | (if (and user (string-match "\\([^:]+\\):\\(.*\\)" user)) | |
167 | (setq pass (match-string 2 user) | |
168 | user (match-string 1 user))) | |
169 | (if (string-match ":\\([0-9+]+\\)" host) | |
216d3806 | 170 | (setq port (string-to-number (match-string 1 host)) |
8c8b8430 SM |
171 | host (substring host 0 (match-beginning 0)))) |
172 | (if (string-match ":$" host) | |
173 | (setq host (substring host 0 (match-beginning 0)))) | |
174 | (setq host (downcase host) | |
175 | save-pos (point)))) | |
176 | ||
177 | (if (not port) | |
178 | (setq port (url-scheme-get-property prot 'default-port))) | |
179 | ||
180 | ;; Gross hack to preserve ';' in data URLs | |
181 | ||
182 | (setq save-pos (point)) | |
183 | ||
184 | (if (string= "data" prot) | |
185 | (goto-char (point-max)) | |
186 | ;; Now check for references | |
187 | (skip-chars-forward "^#") | |
188 | (if (eobp) | |
189 | nil | |
190 | (delete-region | |
191 | (point) | |
192 | (progn | |
193 | (skip-chars-forward "#") | |
194 | (setq refs (buffer-substring (point) (point-max))) | |
195 | (point-max)))) | |
196 | (goto-char save-pos) | |
197 | (skip-chars-forward "^;") | |
198 | (if (not (eobp)) | |
199 | (setq attr (url-parse-args (buffer-substring (point) (point-max)) t) | |
200 | attr (nreverse attr)))) | |
201 | ||
202 | (setq file (buffer-substring save-pos (point))) | |
203 | (if (and host (string-match "%[0-9][0-9]" host)) | |
204 | (setq host (url-unhex-string host))) | |
205 | (vector prot user pass host port file refs attr full)))))) | |
206 | ||
207 | (provide 'url-parse) | |
e5566bd5 | 208 | |
ffc00a35 SM |
209 | ;; arch-tag: f338325f-71ab-4bee-93cc-78fb9a03d403 |
210 | ;;; url-parse.el ends here |