Mercurial > hg > xemacs-beta

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

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b91
author cvs
date Mon, 13 Aug 2007 09:07:36 +0200
parents 0293115a14e9
children 859a2309aef8
comparison
equal deleted inserted replaced
81:ebca3d831cea 82:6a378aca36af
1 ;;; url-misc.el --- Misc Uniform Resource Locator retrieval code 1 ;;; url-misc.el --- Misc Uniform Resource Locator retrieval code
2 ;; Author: wmperry 2 ;; Author: wmperry
3 ;; Created: 1996/10/09 19:00:59 3 ;; Created: 1997/01/21 21:14:56
4 ;; Version: 1.3 4 ;; Version: 1.9
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 ;;; 10 ;;;
10 ;;; This file is not part of GNU Emacs, but the same permissions apply. 11 ;;; This file is not part of GNU Emacs, but the same permissions apply.
11 ;;; 12 ;;;
12 ;;; GNU Emacs is free software; you can redistribute it and/or modify 13 ;;; GNU Emacs is free software; you can redistribute it and/or modify
13 ;;; it under the terms of the GNU General Public License as published by 14 ;;; it under the terms of the GNU General Public License as published by
76 (goto-char (point-max)) 77 (goto-char (point-max))
77 (insert " </pre>\n" 78 (insert " </pre>\n"
78 " </body>\n" 79 " </body>\n"
79 "</html>\n")))) 80 "</html>\n"))))
80 81
81 (defun url-rlogin (url) 82 (defun url-do-terminal-emulator (type server port user)
82 ;; Open up an rlogin connection 83 (terminal-emulator
84 (generate-new-buffer (format "%s%s" (if user (concat user "@") "") server))
85 (case type
86 (rlogin "rlogin")
87 (telnet "telnet")
88 (tn3270 "tn3270")
89 (otherwise
90 (error "Unknown terminal emulator required: %s" type)))
91 (if user
92 (case type
93 (rlogin
94 (list server "-l" user))
95 (telnet
96 (if user (message "Please log in as user: %s" user))
97 (if port
98 (list server port)
99 (list server)))
100 (tn3270
101 (if user (message "Please log in as user: %s" user))
102 (list server))))))
103
104 (defun url-generic-emulator-loader (url)
83 (if (get-buffer url-working-buffer) 105 (if (get-buffer url-working-buffer)
84 (kill-buffer url-working-buffer)) 106 (kill-buffer url-working-buffer))
85 (or (string-match "rlogin:/*\\(.*@\\)*\\([^/]*\\)/*" url) 107 (or (string-match "^\\([^:]+\\):/*\\(.*@\\)*\\([^/]*\\)/*" url)
86 (error "Malformed RLOGIN URL.")) 108 (error "Invalid URL: %s" url))
87 (let* ((server (substring url (match-beginning 2) (match-end 2))) 109 (let* ((type (intern (downcase (match-string 1 url))))
88 (name (if (match-beginning 1) 110 (server (match-string 3 url))
89 (substring url (match-beginning 1) (1- (match-end 1))) 111 (name (if (match-beginning 2)
90 nil)) 112 (substring url (match-beginning 2) (1- (match-end 2)))))
91 (title (format "%s%s" (if name (concat name "@") "") server)) 113 (port (if (string-match ":" server)
92 (thebuf (string-match ":" server))
93 (port (if thebuf
94 (prog1 114 (prog1
95 (substring server (1+ thebuf) nil) 115 (substring server (match-end 0))
96 (setq server (substring server 0 thebuf))) "23"))) 116 (setq server (substring server 0 (match-beginning 0)))))))
97 (cond 117 (url-do-terminal-emulator type server port name)))
98 ((not (eq (device-type) 'tty)) 118
99 (apply 'start-process 119 (fset 'url-rlogin 'url-generic-emulator-loader)
100 "htmlsub" 120 (fset 'url-telnet 'url-generic-emulator-loader)
101 nil 121 (fset 'url-tn3270 'url-generic-emulator-loader)
102 (url-string-to-tokens
103 (format url-xterm-command title
104 (if (and url-gateway-local-host-regexp
105 (string-match url-gateway-local-host-regexp
106 server))
107 url-local-rlogin-prog
108 url-remote-rlogin-prog) server
109 (concat "-l " name)) ? )))
110 (url-use-transparent
111 (require 'transparent)
112 (sit-for 1)
113 (transparent-window (get-buffer-create
114 (format "%s%s:%s" (if name (concat name "@") "")
115 server port))
116 (if (and url-gateway-local-host-regexp
117 (string-match url-gateway-local-host-regexp
118 server))
119 url-local-rlogin-prog
120 url-remote-rlogin-prog)
121 (list server "-l" name) nil
122 "Press any key to return to emacs"))
123 (t
124 (terminal-emulator
125 (get-buffer-create (format "%s%s:%s" (if name (concat name "@") "")
126 server port))
127 (if (and url-gateway-local-host-regexp
128 (string-match url-gateway-local-host-regexp
129 server))
130 url-local-rlogin-prog
131 url-remote-rlogin-prog)
132 (list server "-l" name))))))
133
134 (defun url-telnet (url)
135 ;; Open up a telnet connection
136 (if (get-buffer url-working-buffer)
137 (kill-buffer url-working-buffer))
138 (or (string-match "telnet:/*\\(.*@\\)*\\([^/]*\\)/*" url)
139 (error "Malformed telnet URL: %s" url))
140 (let* ((server (substring url (match-beginning 2) (match-end 2)))
141 (name (if (match-beginning 1)
142 (substring url (match-beginning 1) (1- (match-end 1)))
143 nil))
144 (title (format "%s%s" (if name (concat name "@") "") server))
145 (thebuf (string-match ":" server))
146 (port (if thebuf
147 (prog1
148 (substring server (1+ thebuf) nil)
149 (setq server (substring server 0 thebuf))) "23")))
150 (cond
151 ((not (eq (device-type) 'tty))
152 (apply 'start-process
153 "htmlsub"
154 nil
155 (url-string-to-tokens
156 (format url-xterm-command title
157 (if (and url-gateway-local-host-regexp
158 (string-match url-gateway-local-host-regexp
159 server))
160 url-local-telnet-prog
161 url-remote-telnet-prog) server port) ? ))
162 (if name (message "Please log in as %s" name)))
163 (url-use-transparent
164 (require 'transparent)
165 (if name (message "Please log in as %s" name))
166 (sit-for 1)
167 (transparent-window (get-buffer-create
168 (format "%s%s:%s" (if name (concat name "@") "")
169 server port))
170 (if (and url-gateway-local-host-regexp
171 (string-match url-gateway-local-host-regexp
172 server))
173 url-local-telnet-prog
174 url-remote-telnet-prog)
175 (list server port) nil
176 "Press any key to return to emacs"))
177 (t
178 (terminal-emulator
179 (get-buffer-create (format "%s%s:%s" (if name (concat name "@") "")
180 server port))
181 (if (and url-gateway-local-host-regexp
182 (string-match url-gateway-local-host-regexp
183 server))
184 url-local-telnet-prog
185 url-remote-telnet-prog)
186 (list server port))
187 (if name (message "Please log in as %s" name))))))
188
189 (defun url-tn3270 (url)
190 ;; Open up a tn3270 connection
191 (if (get-buffer url-working-buffer)
192 (kill-buffer url-working-buffer))
193 (string-match "tn3270:/*\\(.*@\\)*\\([^/]*\\)/*" url)
194 (let* ((server (substring url (match-beginning 2) (match-end 2)))
195 (name (if (match-beginning 1)
196 (substring url (match-beginning 1) (1- (match-end 1)))
197 nil))
198 (thebuf (string-match ":" server))
199 (title (format "%s%s" (if name (concat name "@") "") server))
200 (port (if thebuf
201 (prog1
202 (substring server (1+ thebuf) nil)
203 (setq server (substring server 0 thebuf))) "23")))
204 (cond
205 ((not (eq (device-type) 'tty))
206 (start-process "htmlsub" nil url-xterm-command
207 "-title" title
208 "-ut" "-e" url-tn3270-emulator server port)
209 (if name (message "Please log in as %s" name)))
210 (url-use-transparent
211 (require 'transparent)
212 (if name (message "Please log in as %s" name))
213 (sit-for 1)
214 (transparent-window (get-buffer-create
215 (format "%s%s:%s" (if name (concat name "@") "")
216 server port))
217 url-tn3270-emulator
218 (list server port) nil
219 "Press any key to return to emacs"))
220 (t
221 (terminal-emulator
222 (get-buffer-create (format "%s%s:%s" (if name (concat name "@") "")
223 server port))
224 url-tn3270-emulator
225 (list server port))
226 (if name (message "Please log in as %s" name))))))
227 122
228 (defun url-proxy (url) 123 (defun url-proxy (url)
229 ;; Retrieve URL from a proxy. 124 ;; Retrieve URL from a proxy.
230 ;; Expects `url-using-proxy' to be bound to the specific proxy to use." 125 ;; Expects `url-using-proxy' to be bound to the specific proxy to use."
231 (let ( 126 (let (
308 "Server: " url-package-name "/x-exec\n")) 203 "Server: " url-package-name "/x-exec\n"))
309 (t ; Non-zero exit status is bad bad bad 204 (t ; Non-zero exit status is bad bad bad
310 (insert "HTTP/1.0 404 Not Found\n" 205 (insert "HTTP/1.0 404 Not Found\n"
311 "Server: " url-package-name "/x-exec\n")))))) 206 "Server: " url-package-name "/x-exec\n"))))))
312 207
208 ;; ftp://ietf.org/internet-drafts/draft-masinter-url-data-02.txt
209 (defun url-data (url)
210 (set-buffer (get-buffer-create url-working-buffer))
211 (let ((content-type nil)
212 (encoding nil)
213 (data nil))
214 (cond
215 ((string-match "^data:\\([^;,]*\\);*\\([^,]*\\)," url)
216 (setq content-type (match-string 1 url)
217 encoding (match-string 2 url)
218 data (url-unhex-string (substring url (match-end 0))))
219 (if (= 0 (length content-type)) (setq content-type "text/plain"))
220 (if (= 0 (length encoding)) (setq encoding "8bit")))
221 (t nil))
222 (setq url-current-content-length (length data)
223 url-current-mime-type content-type
224 url-current-mime-encoding encoding
225 url-current-mime-headers (list (cons "content-type" content-type)
226 (cons "content-encoding" encoding)))
227 (and data (insert data))))
228
313 (provide 'url-misc) 229 (provide 'url-misc)