Mercurial > hg > xemacs-beta

comparison lisp/w3/url-gopher.el @ 102:a145efe76779 r20-1b3

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-1b3
author cvs
date Mon, 13 Aug 2007 09:15:49 +0200
parents 441bb1e64a06
children c53a95d3c46d
comparison
equal deleted inserted replaced
101:a0ec055d74dd 102:a145efe76779
1 ;;; url-gopher.el --- Gopher Uniform Resource Locator retrieval code 1 ;;; url-gopher.el --- Gopher Uniform Resource Locator retrieval code
2 ;; Author: wmperry 2 ;; Author: wmperry
3 ;; Created: 1997/02/08 05:25:58 3 ;; Created: 1997/02/18 23:34:30
4 ;; Version: 1.5 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.
242 (forward-line 1)) 242 (forward-line 1))
243 (setq objs (nreverse objs)) 243 (setq objs (nreverse objs))
244 (erase-buffer) 244 (erase-buffer)
245 (insert "<title>" 245 (insert "<title>"
246 (cond 246 (cond
247 ((or (string= "" url-current-file) 247 ((or (string= "" (url-filename url-current-object))
248 (string= "1/" url-current-file) 248 (string= "1/" (url-filename url-current-object))
249 (string= "1" url-current-file)) 249 (string= "1" (url-filename url-current-object)))
250 (concat "Gopher root at " url-current-server)) 250 (concat "Gopher root at " (url-host url-current-object)))
251 ((string-match (format "^[%s]+/" url-gopher-types) 251 ((string-match (format "^[%s]+/" url-gopher-types)
252 url-current-file) 252 (url-filename url-current-object))
253 (substring url-current-file 2 nil)) 253 (substring (url-filename url-current-object) 2 nil))
254 (t url-current-file)) 254 (t (url-filename url-current-object)))
255 "</title><ol>" 255 "</title><ol>"
256 (mapconcat 'url-format-gopher-link objs "") 256 (mapconcat 'url-format-gopher-link objs "")
257 "</ol>")))) 257 "</ol>"))))
258 258
259 (defun url-gopher-retrieve (host port selector &optional wait-for) 259 (defun url-gopher-retrieve (host port selector &optional wait-for)
262 host (if (stringp port) (string-to-int port) 262 host (if (stringp port) (string-to-int port)
263 port))) 263 port)))
264 (len nil) 264 (len nil)
265 (parsed nil)) 265 (parsed nil))
266 (url-clear-tmp-buffer) 266 (url-clear-tmp-buffer)
267 (setq url-current-file selector
268 url-current-port port
269 url-current-server host
270 url-current-type "gopher")
271 (if (> (length selector) 0) 267 (if (> (length selector) 0)
272 (setq selector (substring selector 1 nil))) 268 (setq selector (substring selector 1 nil)))
273 (if (not (processp proc)) 269 (if (not (processp proc))
274 nil 270 nil
275 (save-excursion 271 (save-excursion
445 (progn 441 (progn
446 (url-parse-gopher) 442 (url-parse-gopher)
447 (setq type "text/html" 443 (setq type "text/html"
448 url-current-mime-viewer (mm-mime-info type nil 5)))) 444 url-current-mime-viewer (mm-mime-info type nil 5))))
449 (setq url-current-mime-type (or type "text/plain") 445 (setq url-current-mime-type (or type "text/plain")
450 url-current-mime-viewer (mm-mime-info type nil 5) 446 url-current-mime-viewer (mm-mime-info type nil 5))))
451 url-current-file file
452 url-current-port port
453 url-current-server host
454 url-current-type "gopher")))
455 447
456 (defun url-gopher (url) 448 (defun url-gopher (url)
457 ;; Handle gopher URLs 449 ;; Handle gopher URLs
458 (let ((descr (url-grok-gopher-href url))) 450 (let ((descr (url-grok-gopher-href url)))
459 (cond 451 (cond