Re: w3m-expand-url (Re: w3m-anchor)

[TSUCHIYA Masatoshi <tsuchiya@xxxxxxxxxxxxxxxxxxxxxxx>]

>> On Tue, 09 Oct 2001 20:06:22 +0900
>> 「山」== yamaoka@namazu.org (Katsumi Yamaoka) said as follows:

土> (w3m-expand-url "http:file.html" "http://host/dir/")
土> --> "http://host/dir/file.html")

土> が、規格通りに扱えていないようです。

と指摘したのですが、RFC1808 の BNF 定義を参照すると、http:file.html と
いう書式が可能なのか、不可能なのか、よく分からなくなってしまいました。


山> 改変前の版でも同じ動作なので負い目が少し減りました (^^;;) が、これ
山> は凄いサンプルですねえ。

ですから、うまくいかなくて当然のサンプルだったかもしれません。ごめんな
さい。


土> ちょっと作業してみますので、しばらく待って頂けますか。

仕方がないので、真面目に BNF を調べて、完全に再実装しました。一応、私
の手元では一通りのテストを行いましたが、ちょっと不安なので、まだ commit
していません。少し叩いてみていただけないでしょうか。

(defsubst w3m-url-path-end (url &optional path-start)
  (let ((query-start (string-match "\\?" url path-start))
	(param-start (string-match ";" url path-start)))
    (if (and query-start param-start)
	(min query-start param-start)
      (or query-start param-start))))

(defun w3m-expand-url (url &optional base)
  "Convert URL to absolute, and canonicalize it."
  (save-match-data
    (unless base
      (setq base (or w3m-current-base-url w3m-current-url "")))
    (if (string-match "\\`#[^#]*\\'" url)
	;; URL consists of only fragment part.
	(concat (if (string-match "#[^#]*\\'" base)
		    (substring base 0 (match-beginning 0))
		  base)
		url)
      (let ((fragment
	     (if (string-match "#[^#]*\\'" url)
		 (prog1 (match-string 0 url)
		   (setq url (substring url 0 (match-beginning 0))))
	       ""))
	    (scheme
	     (when (string-match "\\`\\([a-zA-Z0-9\\+\\-\\.]+\\):" url)
	       (prog1 (match-string 1 url)
		 (setq url (substring url (match-end 0))))))
	    (base-scheme
	     (if (string-match
		  "\\`\\([a-zA-Z0-9\\+\\-\\.]+\\):/\\(/\\([^/]*\\)/\\)?" base)
		 (match-string 1 base)
	       (error "2nd argument must have an absolute spec: %s" base)))
	    (base-server
	     (or (match-string 3 base) ""))
	    (base-path-start
	     (if (match-beginning 2)
		 (match-end 3)
	       (1+ (match-end 1)))))
	(if (string-match "\\`/\\(/\\([^/]*\\)/\\)?" url)
	    ;; URL has an absolute spec.
	    (concat (or scheme base-scheme)
		    "://"
		    (or (match-string 2 url) base-server)
		    (if (match-end 2) (substring url (match-end 2)) url)
		    fragment)
	  ;; URL has a relative spec.
	  (when (string-match "#[^#]*\\'" base)
	    (setq base (substring base 0 (match-beginning 0))))
	  (setq base
		(file-name-directory
		 (substring base
			    base-path-start
			    (w3m-url-path-end base base-path-start))))
	  (let ((path-end (w3m-url-path-end url)))
	    (setq url
		  (if path-end
		      ;; scheme://server/path?query (expand only path)
		      (concat (w3m-expand-path-name
			       (concat base (substring url 0 path-end)))
			      (substring url path-end))
		    (w3m-expand-path-name (concat base url))))
	    ;; remove drive (for Win32 platform)
	    (when (string-match "\\`.:" url)
	      (setq url (substring url (match-end 0))))
	    (concat (or scheme base-scheme)
		    "://"
		    base-server
		    url
		    fragment)))))))
-- 
土屋 雅稔  ( TSUCHIYA Masatoshi )