Mercurial > hg > xemacs-beta
diff lisp/w3/url.el @ 108:360340f9fd5f r20-1b6
Import from CVS: tag r20-1b6
author | cvs |
---|---|
date | Mon, 13 Aug 2007 09:18:39 +0200 |
parents | a145efe76779 |
children | fe104dbd9147 |
line wrap: on
line diff
--- a/lisp/w3/url.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/w3/url.el Mon Aug 13 09:18:39 2007 +0200 @@ -1,13 +1,13 @@ ;;; url.el --- Uniform Resource Locator retrieval tool ;; Author: wmperry -;; Created: 1997/02/20 15:34:07 -;; Version: 1.57 +;; Created: 1997/03/05 23:37:22 +;; Version: 1.61 ;; Keywords: comm, data, processes, hypermedia ;;; LCD Archive Entry: ;;; url|William M. Perry|wmperry@cs.indiana.edu| ;;; Functions for retrieving/manipulating URLs| -;;; 1997/02/20 15:34:07|1.57|Location Undetermined +;;; 1997/03/05 23:37:22|1.61|Location Undetermined ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -119,8 +119,8 @@ (autoload 'url-is-cached "url-cache") (autoload 'url-store-in-cache "url-cache") (autoload 'url-is-cached "url-cache") -(autoload 'url-create-cached-filename "url-cache") -(autoload 'url-extract-from-cache "url-cache") +(autoload 'url-cache-create-filename "url-cache") +(autoload 'url-cache-extract "url-cache") (autoload 'url-cache-expired "url-cache") (require 'md5) @@ -796,20 +796,21 @@ (and (listp url-privacy-level) (memq 'os url-privacy-level))) nil) + ;; First, we handle the inseparable OS/Windowing system + ;; combinations ((eq system-type 'Apple-Macintosh) "Macintosh") ((eq system-type 'next-mach) "NeXT") ((eq system-type 'windows-nt) "Windows-NT; 32bit") ((eq system-type 'ms-windows) "Windows; 16bit") ((eq system-type 'ms-dos) "MS-DOS; 32bit") - ((and (eq system-type 'vax-vms) (device-type)) - "VMS; X11") - ((eq system-type 'vax-vms) "VMS; TTY") - ((eq (device-type) 'x) "X11") - ((eq (device-type) 'ns) "NeXTStep") - ((eq (device-type) 'pm) "OS/2") ((eq (device-type) 'win32) "Windows; 32bit") - ((eq (device-type) 'tty) "(Unix?); TTY") - (t "UnkownPlatform"))) + ((eq (device-type) 'pm) "OS/2; 32bit") + (t + (case (device-type) + (x "X11") + (ns "OpenStep") + (tty "TTY") + (otherwise nil))))) (setq url-personal-mail-address (or url-personal-mail-address user-mail-address @@ -821,14 +822,17 @@ (memq 'email url-privacy-level))) (setq url-personal-mail-address nil)) - (if (or (eq url-privacy-level 'paranoid) - (and (listp url-privacy-level) - (memq 'os url-privacy-level))) - (setq url-os-type nil) - (let ((vers (emacs-version))) - (if (string-match "(\\([^, )]+\\))$" vers) - (setq url-os-type (url-match vers 1)) - (setq url-os-type (symbol-name system-type)))))) + (setq url-os-type + (cond + ((or (eq url-privacy-level 'paranoid) + (and (listp url-privacy-level) + (memq 'os url-privacy-level))) + nil) + ((boundp 'system-configuration) + system-configuration) + ((boundp 'system-type) + (symbol-name system-type)) + (t nil)))) (defun url-handle-no-scheme (url) (let ((temp url-registered-protocols) @@ -1047,6 +1051,8 @@ (setq url (substring url 4 nil))) (if (string-match "\\.$" url) (setq url (substring url 0 -1))) + (if (string-match "^www\\." url) + (setq url (concat "http://" url))) (if (not (string-match url-nonrelative-link url)) (setq url nil)) url))) @@ -1345,8 +1351,7 @@ url-current-callback-data)) (t (funcall url-current-callback-func)))))) - ((fboundp 'w3-sentinel) - (set-variable 'w3-working-buffer buf) + ((and (fboundp 'w3-sentinel) (get-buffer buf)) (w3-sentinel)) (t (message "Retrieval for %s complete." buf)))) @@ -1372,10 +1377,10 @@ (setq url-current-mime-type (mm-extension-to-mime (url-file-extension (url-filename - url-current-object))))) - (if (member status '(401 301 302 303 204)) - nil - (funcall url-default-retrieval-proc (buffer-name url-working-buffer))))))))) + url-current-object)))))))) + (if (member status '(401 301 302 303 204)) + nil + (funcall url-default-retrieval-proc (buffer-name url-working-buffer)))))) (defun url-remove-relative-links (name) ;; Strip . and .. from pathnames @@ -1921,11 +1926,11 @@ (setq cached (url-is-cached url) cached (and cached (not (url-cache-expired url cached))) handler (if cached - 'url-extract-from-cache + 'url-cache-extract (car-safe (cdr-safe (assoc (or type "auto") url-registered-protocols)))) - url (if cached (url-create-cached-filename url) url)) + url (if cached (url-cache-create-filename url) url)) (save-excursion (set-buffer (get-buffer-create url-working-buffer)) (setq url-current-can-be-cached (not no-cache) @@ -1946,7 +1951,7 @@ (cond ((and url-be-asynchronous (not cached) (member type '("http" "proxy"))) nil) - (url-be-asynchronous + ((and url-be-asynchronous (get-buffer url-working-buffer)) (funcall url-default-retrieval-proc (buffer-name))) ((not (get-buffer url-working-buffer)) nil) ((and (not url-inhibit-mime-parsing)