diff lisp/w3/url-misc.el @ 82:6a378aca36af r20-0b91

Import from CVS: tag r20-0b91
author cvs
date Mon, 13 Aug 2007 09:07:36 +0200
parents 0293115a14e9
children 859a2309aef8
line wrap: on
line diff
--- a/lisp/w3/url-misc.el	Mon Aug 13 09:06:45 2007 +0200
+++ b/lisp/w3/url-misc.el	Mon Aug 13 09:07:36 2007 +0200
@@ -1,11 +1,12 @@
 ;;; url-misc.el --- Misc Uniform Resource Locator retrieval code
 ;; Author: wmperry
-;; Created: 1996/10/09 19:00:59
-;; Version: 1.3
+;; Created: 1997/01/21 21:14:56
+;; Version: 1.9
 ;; Keywords: comm, data, processes
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Copyright (c) 1993 - 1996 by William M. Perry (wmperry@cs.indiana.edu)
+;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc.
 ;;;
 ;;; This file is not part of GNU Emacs, but the same permissions apply.
 ;;;
@@ -78,152 +79,46 @@
 	      " </body>\n"
 	      "</html>\n"))))
 
-(defun url-rlogin (url)
-  ;; Open up an rlogin connection
-  (if (get-buffer url-working-buffer)
-      (kill-buffer url-working-buffer))
-  (or (string-match "rlogin:/*\\(.*@\\)*\\([^/]*\\)/*" url)
-      (error "Malformed RLOGIN URL."))
-  (let* ((server (substring url (match-beginning 2) (match-end 2)))
-	 (name (if (match-beginning 1)
-		   (substring url (match-beginning 1) (1- (match-end 1)))
-		 nil))
-	 (title (format "%s%s" (if name (concat name "@") "") server))
-	 (thebuf (string-match ":" server))
-	 (port (if thebuf
-		   (prog1
-		       (substring server (1+ thebuf) nil)
-		     (setq server (substring server 0 thebuf))) "23")))
-    (cond
-     ((not (eq (device-type) 'tty))
-      (apply 'start-process
-	     "htmlsub"
-	     nil
-	     (url-string-to-tokens
-	      (format url-xterm-command title 
-		      (if (and url-gateway-local-host-regexp
-			       (string-match url-gateway-local-host-regexp
-					     server))
-			  url-local-rlogin-prog
-			url-remote-rlogin-prog) server
-			(concat "-l " name)) ? )))
-     (url-use-transparent
-      (require 'transparent)
-      (sit-for 1)
-      (transparent-window (get-buffer-create
-			   (format "%s%s:%s" (if name (concat name "@") "")
-				   server port))
-			  (if (and url-gateway-local-host-regexp
-				   (string-match url-gateway-local-host-regexp
-						 server))
-			      url-local-rlogin-prog
-			    url-remote-rlogin-prog)
-			  (list server "-l" name) nil
-			  "Press any key to return to emacs"))
-     (t
-      (terminal-emulator
-       (get-buffer-create (format "%s%s:%s" (if name (concat name "@") "")
-				  server port))
-       (if (and url-gateway-local-host-regexp
-		(string-match url-gateway-local-host-regexp
-			      server))
-	   url-local-rlogin-prog
-	 url-remote-rlogin-prog)
-       (list server "-l" name))))))
+(defun url-do-terminal-emulator (type server port user)
+  (terminal-emulator
+   (generate-new-buffer (format "%s%s" (if user (concat user "@") "") server))
+   (case type
+     (rlogin "rlogin")
+     (telnet "telnet")
+     (tn3270 "tn3270")
+     (otherwise
+      (error "Unknown terminal emulator required: %s" type)))
+   (if user
+       (case type
+	 (rlogin
+	  (list server "-l" user))
+	 (telnet
+	  (if user (message "Please log in as user: %s" user))
+	  (if port
+	      (list server port)
+	    (list server)))
+	 (tn3270
+	  (if user (message "Please log in as user: %s" user))
+	  (list server))))))
 
-(defun url-telnet (url)
-  ;; Open up a telnet connection
+(defun url-generic-emulator-loader (url)
   (if (get-buffer url-working-buffer)
       (kill-buffer url-working-buffer))
-  (or (string-match "telnet:/*\\(.*@\\)*\\([^/]*\\)/*" url)
-      (error "Malformed telnet URL: %s" url))
-  (let* ((server (substring url (match-beginning 2) (match-end 2)))
-	 (name (if (match-beginning 1)
-		   (substring url (match-beginning 1) (1- (match-end 1)))
-		 nil))
-	 (title (format "%s%s" (if name (concat name "@") "") server))
-	 (thebuf (string-match ":" server))
-	 (port (if thebuf
+  (or (string-match "^\\([^:]+\\):/*\\(.*@\\)*\\([^/]*\\)/*" url)
+      (error "Invalid URL: %s" url))
+  (let* ((type (intern (downcase (match-string 1 url))))
+	 (server (match-string 3 url))
+	 (name (if (match-beginning 2)
+		   (substring url (match-beginning 2) (1- (match-end 2)))))
+	 (port (if (string-match ":" server)
 		   (prog1
-		       (substring server (1+ thebuf) nil)
-		     (setq server (substring server 0 thebuf))) "23")))
-    (cond
-     ((not (eq (device-type) 'tty))
-      (apply 'start-process
-	     "htmlsub"
-	     nil
-	     (url-string-to-tokens
-	      (format url-xterm-command title 
-		      (if (and url-gateway-local-host-regexp
-			       (string-match url-gateway-local-host-regexp
-					     server))
-			  url-local-telnet-prog
-			url-remote-telnet-prog) server port) ? ))
-      (if name (message "Please log in as %s" name)))
-     (url-use-transparent
-      (require 'transparent)
-      (if name (message "Please log in as %s" name))
-      (sit-for 1)
-      (transparent-window (get-buffer-create
-			   (format "%s%s:%s" (if name (concat name "@") "")
-				   server port))
-			  (if (and url-gateway-local-host-regexp
-				   (string-match url-gateway-local-host-regexp
-						 server))
-			      url-local-telnet-prog
-			    url-remote-telnet-prog)
-			  (list server port) nil
-			  "Press any key to return to emacs"))
-     (t
-      (terminal-emulator
-       (get-buffer-create (format "%s%s:%s" (if name (concat name "@") "")
-				  server port))
-       (if (and url-gateway-local-host-regexp
-		(string-match url-gateway-local-host-regexp
-			      server))
-	   url-local-telnet-prog
-	 url-remote-telnet-prog)
-       (list server port))
-      (if name (message "Please log in as %s" name))))))
+		       (substring server (match-end 0))
+		     (setq server (substring server 0 (match-beginning 0)))))))
+    (url-do-terminal-emulator type server port name)))
 
-(defun url-tn3270 (url)
-  ;; Open up a tn3270 connection
-  (if (get-buffer url-working-buffer)
-      (kill-buffer url-working-buffer))
-  (string-match "tn3270:/*\\(.*@\\)*\\([^/]*\\)/*" url)
-  (let* ((server (substring url (match-beginning 2) (match-end 2)))
-	 (name (if (match-beginning 1)
-		   (substring url (match-beginning 1) (1- (match-end 1)))
-		 nil))
-	 (thebuf (string-match ":" server))
-	 (title (format "%s%s" (if name (concat name "@") "") server))
-	 (port (if thebuf
-		   (prog1
-		       (substring server (1+ thebuf) nil)
-		     (setq server (substring server 0 thebuf))) "23")))
-    (cond
-     ((not (eq (device-type) 'tty))
-      (start-process "htmlsub" nil url-xterm-command
-		     "-title" title
-		     "-ut" "-e" url-tn3270-emulator server port)
-      (if name (message "Please log in as %s" name)))
-     (url-use-transparent
-      (require 'transparent)
-      (if name (message "Please log in as %s" name))
-      (sit-for 1)
-      (transparent-window (get-buffer-create
-			   (format "%s%s:%s" (if name (concat name "@") "")
-				   server port))
-			  url-tn3270-emulator
-			  (list server port) nil
-			  "Press any key to return to emacs"))
-     (t
-      (terminal-emulator
-       (get-buffer-create (format "%s%s:%s" (if name (concat name "@") "")
-				  server port))
-       url-tn3270-emulator
-       (list server port))
-      (if name (message "Please log in as %s" name))))))
+(fset 'url-rlogin 'url-generic-emulator-loader)
+(fset 'url-telnet 'url-generic-emulator-loader)
+(fset 'url-tn3270 'url-generic-emulator-loader)
 
 (defun url-proxy (url)
   ;; Retrieve URL from a proxy.
@@ -310,4 +205,25 @@
 	(insert "HTTP/1.0 404 Not Found\n"
 		"Server: " url-package-name "/x-exec\n"))))))
 
+;; ftp://ietf.org/internet-drafts/draft-masinter-url-data-02.txt
+(defun url-data (url)
+  (set-buffer (get-buffer-create url-working-buffer))
+  (let ((content-type nil)
+	(encoding nil)
+	(data nil))
+    (cond
+     ((string-match "^data:\\([^;,]*\\);*\\([^,]*\\)," url)
+      (setq content-type (match-string 1 url)
+	    encoding (match-string 2 url)
+	    data (url-unhex-string (substring url (match-end 0))))
+      (if (= 0 (length content-type)) (setq content-type "text/plain"))
+      (if (= 0 (length encoding)) (setq encoding "8bit")))
+     (t nil))
+    (setq url-current-content-length (length data)
+	  url-current-mime-type content-type
+	  url-current-mime-encoding encoding
+	  url-current-mime-headers (list (cons "content-type" content-type)
+					 (cons "content-encoding" encoding)))
+    (and data (insert data))))
+
 (provide 'url-misc)