Mercurial > hg > xemacs-beta

comparison lisp/w3/url.el @ 120:cca96a509cfe r20-1b12

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-1b12
author cvs
date Mon, 13 Aug 2007 09:25:29 +0200
parents 7d55a9ba150c
children d2f30a177268
comparison
equal deleted inserted replaced
119:d101af7320b8 120:cca96a509cfe
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/03 15:23:07 3 ;; Created: 1997/04/07 16:01:55
4 ;; Version: 1.70 4 ;; Version: 1.72
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/03 15:23:07|1.70|Location Undetermined 10 ;;; 1997/04/07 16:01:55|1.72|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.
1272 (t (char-to-string code)))) 1272 (t (char-to-string code))))
1273 str (substring str (match-end 0))))) 1273 str (substring str (match-end 0)))))
1274 (setq tmp (concat tmp str)) 1274 (setq tmp (concat tmp str))
1275 tmp)) 1275 tmp))
1276 1276
1277 (defun url-clean-text ()
1278 "Clean up a buffer, removing any excess garbage from a gateway mechanism,
1279 and decoding any MIME content-transfer-encoding used."
1280 (set-buffer url-working-buffer)
1281 (goto-char (point-min))
1282 (url-replace-regexp "Connection closed by.*\n*\\'" "")
1283 (goto-char (point-min))
1284 (url-replace-regexp "Process .* exited abnormally.*\n*\\'" ""))
1285
1286 (defun url-remove-compressed-extensions (filename) 1277 (defun url-remove-compressed-extensions (filename)
1287 (while (assoc (url-file-extension filename) url-uncompressor-alist) 1278 (while (assoc (url-file-extension filename) url-uncompressor-alist)
1288 (setq filename (url-file-extension filename t))) 1279 (setq filename (url-file-extension filename t)))
1289 filename) 1280 filename)
1290 1281
1369 (set-buffer url-working-buffer) 1360 (set-buffer url-working-buffer)
1370 (remove-hook 'after-change-functions 'url-after-change-function) 1361 (remove-hook 'after-change-functions 'url-after-change-function)
1371 (if url-be-asynchronous 1362 (if url-be-asynchronous
1372 (progn 1363 (progn
1373 (widen) 1364 (widen)
1374 (url-clean-text)
1375 (cond 1365 (cond
1376 ((and (null proc) (not url-working-buffer)) nil) 1366 ((and (null proc) (not url-working-buffer)) nil)
1377 ((url-mime-response-p) 1367 ((url-mime-response-p)
1378 (setq status (url-parse-mime-headers)))) 1368 (setq status (url-parse-mime-headers))))
1379 (if (not url-current-mime-type) 1369 (if (not url-current-mime-type)
1381 (url-file-extension 1371 (url-file-extension
1382 (url-filename 1372 (url-filename
1383 url-current-object)))))))) 1373 url-current-object))))))))
1384 (if (member status '(401 301 302 303 204)) 1374 (if (member status '(401 301 302 303 204))
1385 nil 1375 nil
1386 (funcall url-default-retrieval-proc (buffer-name url-working-buffer)))))) 1376 (funcall url-default-retrieval-proc (buffer-name url-working-buffer)))))
1377 ;; FSF Emacs doesn't do this after calling a process-sentinel
1378 (set-buffer (window-buffer (selected-window))))
1387 1379
1388 (defun url-remove-relative-links (name) 1380 (defun url-remove-relative-links (name)
1389 ;; Strip . and .. from pathnames 1381 ;; Strip . and .. from pathnames
1390 (let ((new (if (not (string-match "^/" name)) 1382 (let ((new (if (not (string-match "^/" name))
1391 (concat "/" name) 1383 (concat "/" name)
1995 buffer specified by url-working-buffer. url-working-buffer is killed 1987 buffer specified by url-working-buffer. url-working-buffer is killed
1996 immediately before starting the transfer, so that no buffer-local 1988 immediately before starting the transfer, so that no buffer-local
1997 variables interfere with the retrieval. HTTP/1.0 redirection will 1989 variables interfere with the retrieval. HTTP/1.0 redirection will
1998 be honored before this function exits." 1990 be honored before this function exits."
1999 (url-do-setup) 1991 (url-do-setup)
1992 ;;(url-download-minor-mode t)
2000 (if (and (fboundp 'set-text-properties) 1993 (if (and (fboundp 'set-text-properties)
2001 (subrp (symbol-function 'set-text-properties))) 1994 (subrp (symbol-function 'set-text-properties)))
2002 (set-text-properties 0 (length url) nil url)) 1995 (set-text-properties 0 (length url) nil url))
2003 (if (and url (string-match "^url:" url)) 1996 (if (and url (string-match "^url:" url))
2004 (setq url (substring url (match-end 0) nil))) 1997 (setq url (substring url (match-end 0) nil)))