Mercurial > hg > xemacs-beta

comparison lisp/w3/url-parse.el @ 86:364816949b59 r20-0b93

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b93
author cvs
date Mon, 13 Aug 2007 09:09:02 +0200
parents 6a378aca36af
children
comparison
equal deleted inserted replaced
85:c661705957e0 86:364816949b59
1 ;;; url-parse.el --- Uniform Resource Locator parser 1 ;;; url-parse.el --- Uniform Resource Locator parser
2 ;; Author: wmperry 2 ;; Author: wmperry
3 ;; Created: 1997/01/10 00:13:05 3 ;; Created: 1997/01/23 16:48:58
4 ;; Version: 1.4 4 ;; Version: 1.6
5 ;; Keywords: comm, data, processes 5 ;; Keywords: comm, data, processes
6 6
7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8 ;;; Copyright (c) 1993-1996 by William M. Perry (wmperry@cs.indiana.edu) 8 ;;; Copyright (c) 1993-1996 by William M. Perry (wmperry@cs.indiana.edu)
9 ;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc. 9 ;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc.
106 (concat (car x) "=" (cdr x)) 106 (concat (car x) "=" (cdr x))
107 (car x)))) (url-attributes urlobj) ";"))))) 107 (car x)))) (url-attributes urlobj) ";")))))
108 108
109 (defun url-generic-parse-url (url) 109 (defun url-generic-parse-url (url)
110 "Return a vector of the parts of URL. 110 "Return a vector of the parts of URL.
111 Format is [protocol username password hostname portnumber file reference]" 111 Format is:
112 [proto username password hostname portnumber file reference attributes fullp]"
112 (cond 113 (cond
113 ((null url) 114 ((null url)
114 (make-vector 9 nil)) 115 (make-vector 9 nil))
115 ((or (not (string-match url-nonrelative-link url)) 116 ((or (not (string-match url-nonrelative-link url))
116 (= ?/ (string-to-char url))) 117 (= ?/ (string-to-char url)))
150 (progn 151 (progn
151 (setq full t) 152 (setq full t)
152 (forward-char 2) 153 (forward-char 2)
153 (setq save-pos (point)) 154 (setq save-pos (point))
154 (skip-chars-forward "^/") 155 (skip-chars-forward "^/")
155 (downcase-region save-pos (point))
156 (setq host (buffer-substring save-pos (point))) 156 (setq host (buffer-substring save-pos (point)))
157 (if (string-match "^\\([^@]+\\)@" host) 157 (if (string-match "^\\([^@]+\\)@" host)
158 (setq user (url-match host 1) 158 (setq user (url-match host 1)
159 host (substring host (match-end 0) nil))) 159 host (substring host (match-end 0) nil)))
160 (if (and user (string-match "\\([^:]+\\):\\(.*\\)" user)) 160 (if (and user (string-match "\\([^:]+\\):\\(.*\\)" user))
163 (if (string-match ":\\([0-9+]+\\)" host) 163 (if (string-match ":\\([0-9+]+\\)" host)
164 (setq port (url-match host 1) 164 (setq port (url-match host 1)
165 host (substring host 0 (match-beginning 0)))) 165 host (substring host 0 (match-beginning 0))))
166 (if (string-match ":$" host) 166 (if (string-match ":$" host)
167 (setq host (substring host 0 (match-beginning 0)))) 167 (setq host (substring host 0 (match-beginning 0))))
168 (setq save-pos (point)))) 168 (setq host (downcase host)
169 save-pos (point))))
169 ;; Now check for references 170 ;; Now check for references
170 (setq save-pos (point)) 171 (setq save-pos (point))
171 (skip-chars-forward "^#") 172 (skip-chars-forward "^#")
172 (if (eobp) 173 (if (eobp)
173 nil 174 nil