Mercurial > hg > xemacs-beta

comparison lisp/w3/url.el @ 144:318232e2a3f0 r20-2b6

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-2b6
author cvs
date Mon, 13 Aug 2007 09:34:14 +0200
parents 6608ceec7cf8
children 5a88923fcbfe
comparison
equal deleted inserted replaced
143:50e7fedfe353 144:318232e2a3f0
1 ;;; url.el --- Uniform Resource Locator retrieval tool 1 ;;; url.el --- Uniform Resource Locator retrieval tool
2 ;; Author: wmperry 2 ;; Author: wmperry
3 ;; Created: 1997/04/22 15:08:38 3 ;; Created: 1997/05/08 22:17:40
4 ;; Version: 1.76 4 ;; Version: 1.78
5 ;; Keywords: comm, data, processes, hypermedia 5 ;; Keywords: comm, data, processes, hypermedia
6 6
7 ;;; LCD Archive Entry: 7 ;;; LCD Archive Entry:
8 ;;; url|William M. Perry|wmperry@cs.indiana.edu| 8 ;;; url|William M. Perry|wmperry@cs.indiana.edu|
9 ;;; Functions for retrieving/manipulating URLs| 9 ;;; Functions for retrieving/manipulating URLs|
10 ;;; 1997/04/22 15:08:38|1.76|Location Undetermined 10 ;;; 1997/05/08 22:17:40|1.78|Location Undetermined
11 ;;; 11 ;;;
12 12
13 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 13 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
14 ;;; Copyright (c) 1993-1996 by William M. Perry (wmperry@cs.indiana.edu) 14 ;;; Copyright (c) 1993-1996 by William M. Perry (wmperry@cs.indiana.edu)
15 ;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc. 15 ;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc.
1354 (w3-sentinel)) 1354 (w3-sentinel))
1355 (t 1355 (t
1356 (message "Retrieval for %s complete." buf)))) 1356 (message "Retrieval for %s complete." buf))))
1357 1357
1358 (defun url-sentinel (proc string) 1358 (defun url-sentinel (proc string)
1359 (let* ((buf (process-buffer proc)) 1359 (let* ((buf (if (processp proc) (process-buffer proc) proc))
1360 (url-working-buffer (and buf (get-buffer buf))) 1360 (url-working-buffer (and buf (get-buffer buf)))
1361 status) 1361 status)
1362 (if (not url-working-buffer) 1362 (if (not url-working-buffer)
1363 (url-warn 'url (format "Process %s completed with no buffer!" proc)) 1363 (url-warn 'url (format "Process %s completed with no buffer!" proc))
1364 (save-excursion 1364 (save-excursion
1370 (cond 1370 (cond
1371 ((and (null proc) (not url-working-buffer)) nil) 1371 ((and (null proc) (not url-working-buffer)) nil)
1372 ((url-mime-response-p) 1372 ((url-mime-response-p)
1373 (setq status (url-parse-mime-headers)))) 1373 (setq status (url-parse-mime-headers))))
1374 (if (not url-current-mime-type) 1374 (if (not url-current-mime-type)
1375 (setq url-current-mime-type (mm-extension-to-mime 1375 (setq url-current-mime-type (or
1376 (url-file-extension 1376 (mm-extension-to-mime
1377 (url-filename 1377 (url-file-extension
1378 url-current-object)))))))) 1378 (url-filename
1379 url-current-object)))
1380 "text/plain"))))))
1379 (if (member status '(401 301 302 303 204)) 1381 (if (member status '(401 301 302 303 204))
1380 nil 1382 nil
1381 (funcall url-default-retrieval-proc (buffer-name url-working-buffer))))) 1383 (funcall url-default-retrieval-proc (buffer-name url-working-buffer)))))
1382 ;; FSF Emacs doesn't do this after calling a process-sentinel 1384 ;; FSF Emacs doesn't do this after calling a process-sentinel
1383 (set-buffer (window-buffer (selected-window)))) 1385 (set-buffer (window-buffer (selected-window))))
1955 "<a href=\"mailto://" url-bug-address "\">send me mail.</a>" 1957 "<a href=\"mailto://" url-bug-address "\">send me mail.</a>"
1956 "<p><address>William Perry</address><br>" 1958 "<p><address>William Perry</address><br>"
1957 "<address>" url-bug-address "</address>")) 1959 "<address>" url-bug-address "</address>"))
1958 (cond 1960 (cond
1959 ((and url-be-asynchronous (not cached) 1961 ((and url-be-asynchronous (not cached)
1960 (member type '("http" "https" "proxy"))) 1962 (member type '("http" "https" "proxy" "file" "ftp")))
1961 nil) 1963 nil)
1962 ((and url-be-asynchronous (get-buffer url-working-buffer)) 1964 ((and url-be-asynchronous (get-buffer url-working-buffer))
1963 (funcall url-default-retrieval-proc (buffer-name))) 1965 (funcall url-default-retrieval-proc (buffer-name)))
1964 ((not (get-buffer url-working-buffer)) nil) 1966 ((not (get-buffer url-working-buffer)) nil)
1965 ((and (not url-inhibit-mime-parsing) 1967 ((and (not url-inhibit-mime-parsing)
1967 (or cached (url-parse-mime-headers nil t)))) 1969 (or cached (url-parse-mime-headers nil t))))
1968 (if (and (or (not url-be-asynchronous) 1970 (if (and (or (not url-be-asynchronous)
1969 (not (equal type "http"))) 1971 (not (equal type "http")))
1970 url-current-object 1972 url-current-object
1971 (not url-current-mime-type)) 1973 (not url-current-mime-type))
1972 (if (url-buffer-is-hypertext) 1974 (setq url-current-mime-type (mm-extension-to-mime
1973 (setq url-current-mime-type "text/html") 1975 (url-file-extension
1974 (setq url-current-mime-type (mm-extension-to-mime 1976 (url-filename
1975 (url-file-extension 1977 url-current-object)))))
1976 (url-filename
1977 url-current-object))))))
1978 (if (not url-be-asynchronous) 1978 (if (not url-be-asynchronous)
1979 (url-store-in-cache url-working-buffer)) 1979 (url-store-in-cache url-working-buffer))
1980 (if (not url-global-history-hash-table) 1980 (if (not url-global-history-hash-table)
1981 (setq url-global-history-hash-table (make-hash-table :size 131 1981 (setq url-global-history-hash-table (make-hash-table :size 131
1982 :test 'equal))) 1982 :test 'equal)))