diff lisp/w3/url.el @ 16:0293115a14e9 r19-15b91

Import from CVS: tag r19-15b91
author cvs
date Mon, 13 Aug 2007 08:49:20 +0200
parents 9ee227acff29
children 859a2309aef8
line wrap: on
line diff
--- a/lisp/w3/url.el	Mon Aug 13 08:48:43 2007 +0200
+++ b/lisp/w3/url.el	Mon Aug 13 08:49:20 2007 +0200
@@ -1,18 +1,18 @@
 ;;; url.el --- Uniform Resource Locator retrieval tool
 ;; Author: wmperry
-;; Created: 1996/12/19 21:53:03
-;; Version: 1.40
+;; Created: 1997/01/29 14:32:36
+;; Version: 1.48
 ;; Keywords: comm, data, processes, hypermedia
 
 ;;; LCD Archive Entry:
 ;;; url|William M. Perry|wmperry@cs.indiana.edu|
-;;; Major mode for manipulating URLs|
-;;; 1996/12/19 21:53:03|1.40|Location Undetermined
+;;; Functions for retrieving/manipulating URLs|
+;;; 1997/01/29 14:32:36|1.48|Location Undetermined
 ;;;
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Copyright (c) 1993-1996 by William M. Perry (wmperry@cs.indiana.edu)
-;;; Copyright (c) 1996 Free Software Foundation, Inc.
+;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc.
 ;;;
 ;;; This file is not part of GNU Emacs, but the same permissions apply.
 ;;;
@@ -36,11 +36,7 @@
 (require 'cl)
 (require 'url-vars)
 (require 'url-parse)
-(require 'urlauth)
-(require 'url-cookie)
 (require 'mm)
-(require 'md5)
-(require 'base64)
 (require 'mule-sysdp)
 (or (featurep 'efs)
     (featurep 'efs-auto)
@@ -91,6 +87,7 @@
 (autoload 'url-info "url-misc")
 (autoload 'url-shttp "url-http")
 (autoload 'url-https "url-http")
+(autoload 'url-data "url-misc")
 (autoload 'url-finger "url-misc")
 (autoload 'url-rlogin "url-misc")
 (autoload 'url-telnet "url-misc")
@@ -102,9 +99,7 @@
 (autoload 'url-decode-pgp/pem "url-pgp")
 (autoload 'url-wais "url-wais")
 
-(autoload 'url-save-newsrc "url-news")
-(autoload 'url-news-generate-reply-form "url-news")
-(autoload 'url-parse-newsrc "url-news")
+(autoload 'url-open-stream "url-gw")
 (autoload 'url-mime-response-p "url-http")
 (autoload 'url-parse-mime-headers "url-http")
 (autoload 'url-handle-refresh-header "url-http")
@@ -112,6 +107,16 @@
 (autoload 'url-create-message-id "url-http")
 (autoload 'url-create-multipart-request "url-http")
 (autoload 'url-parse-viewer-types "url-http")
+
+(autoload 'url-get-authentication "url-auth")
+(autoload 'url-register-auth-scheme "url-auth")
+(autoload 'url-cookie-write-file "url-cookie")
+(autoload 'url-cookie-retrieve "url-cookie")
+(autoload 'url-cookie-generate-header-lines "url-cookie")
+(autoload 'url-cookie-handle-set-cookie "url-cookie")
+
+(require 'md5)
+(require 'base64)
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; File-name-handler-alist functions
@@ -592,6 +597,8 @@
       (let ((buf (current-buffer))
 	    (url-working-buffer (cdr (url-retrieve url))))
 	(setq-default url-be-asynchronous old-asynch)
+	(set-buffer url-working-buffer)
+	(url-uncompress)
 	(set-buffer buf)
 	(insert-buffer url-working-buffer)
 	(setq buffer-file-name url)
@@ -743,18 +750,10 @@
     (apply 'message args)))
 
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Gateway Support
-;;; ---------------
-;;; Fairly good/complete gateway support
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (defun url-kill-process (proc)
   "Kill the process PROC - knows about all the various gateway types,
 and acts accordingly."
-  (cond
-   ((eq url-gateway-method 'native) (delete-process proc))
-   ((eq url-gateway-method 'program) (kill-process proc))
-   (t (error "Unknown url-gateway-method %s" url-gateway-method))))
+  (delete-process proc))
 
 (defun url-accept-process-output (proc)
   "Allow any pending output from subprocesses to be read by Emacs.
@@ -765,91 +764,7 @@
 
 (defun url-process-status (proc)
   "Return the process status of a url buffer"
-  (cond
-   ((memq url-gateway-method '(native ssl program)) (process-status proc))
-   (t (error "Unkown url-gateway-method %s" url-gateway-method))))  
-
-(defun url-open-stream (name buffer host service)
-  "Open a stream to a host"
-  (let ((tmp-gateway-method (if (and url-gateway-local-host-regexp
-				     (not (eq 'ssl url-gateway-method))
-				     (string-match
-				      url-gateway-local-host-regexp
-				      host))
-				'native
-			      url-gateway-method))
-	(tcp-binary-process-output-services (if (stringp service)
-						(list service)
-					      (list service
-						    (int-to-string service)))))
-    (and (eq url-gateway-method 'tcp)
-	 (require 'tcp)
-	 (setq url-gateway-method 'native
-	       tmp-gateway-method 'native))
-    (cond
-     ((eq tmp-gateway-method 'ssl)
-      (open-ssl-stream name buffer host service))
-     ((eq tmp-gateway-method 'native)
-      (if url-broken-resolution
-	  (setq host
-		(cond
-		 ((featurep 'ange-ftp) (ange-ftp-nslookup-host host))
-		 ((featurep 'efs) (efs-nslookup-host host))
-		 ((featurep 'efs-auto) (efs-nslookup-host host))
-		 (t host))))
-      (let ((max-retries url-connection-retries)
-	    (cur-retries 0)
-	    (retry t)
-	    (errobj nil)
-	    (conn nil))
-	(while (and (not conn) retry)
-	  (condition-case errobj
-	      (setq conn (open-network-stream name buffer host service))
-	    (error
-	     (url-save-error errobj)
-	     (save-window-excursion
-	       (save-excursion
-		 (switch-to-buffer-other-window " *url-error*")
-		 (shrink-window-if-larger-than-buffer)
-		 (goto-char (point-min))
-		 (if (and (re-search-forward "in use" nil t)
-			  (< cur-retries max-retries))
-		     (progn
-		       (setq retry t
-			     cur-retries (1+ cur-retries))
-		       (sleep-for 0.5))
-		   (setq cur-retries 0
-			 retry (funcall url-confirmation-func
-					(concat "Connection to " host
-						" failed, retry? "))))
-		 (kill-buffer (current-buffer)))))))
-	(if (not conn)
-	    (error "Unable to connect to %s:%s" host service)
-	  (mule-inhibit-code-conversion conn)
-	  conn)))
-     ((eq tmp-gateway-method 'program)
-      (let ((proc (start-process name buffer url-gateway-telnet-program host
-				 (int-to-string service)))
-	    (tmp nil))
-	(save-excursion
-	  (set-buffer buffer)
-	  (setq tmp (point))
-	  (while (not (progn
-			(goto-char (point-min))
-			(re-search-forward 
-			 url-gateway-telnet-ready-regexp nil t)))
-	    (url-accept-process-output proc))
-	  (delete-region tmp (point))
-	  (goto-char (point-min))
-	  (if (re-search-forward "connect:" nil t)
-	      (progn
-		(condition-case ()
-		    (delete-process proc)
-		  (error nil))
-		(url-replace-regexp ".*connect:.*" "")
-		nil)
-	    proc))))
-     (t (error "Unknown url-gateway-method %s" url-gateway-method)))))
+  (process-status proc))
 
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -974,6 +889,7 @@
     (url-register-protocol 'news       nil 'url-identity-expander "119")
     (url-register-protocol 'nntp       nil 'url-identity-expander "119")
     (url-register-protocol 'irc        nil 'url-identity-expander "6667")
+    (url-register-protocol 'data       nil 'url-identity-expander)
     (url-register-protocol 'rlogin)
     (url-register-protocol 'shttp      nil nil "80")
     (url-register-protocol 'telnet)
@@ -1425,7 +1341,9 @@
 path components followed by `..' are removed, along with the `..' itself."
   (if url
       (setq url (mapconcat (function (lambda (x)
-				       (if (= x ?\n) "" (char-to-string x))))
+				       (if (memq x '(?  ?\n ?\r))
+					   ""
+					 (char-to-string x))))
 			   (url-strip-leading-spaces
 			    (url-eat-trailing-space url)) "")))
   (cond