Mercurial > hg > xemacs-beta

comparison lisp/w3/url-file.el @ 165:5a88923fcbfe r20-3b9

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-3b9
author cvs
date Mon, 13 Aug 2007 09:44:42 +0200
parents 318232e2a3f0
children
comparison
equal deleted inserted replaced
164:4e0740e5aab2 165:5a88923fcbfe
1 ;;; url-file.el --- File retrieval code 1 ;;; url-file.el --- File retrieval code
2 ;; Author: wmperry 2 ;; Author: wmperry
3 ;; Created: 1997/05/09 04:39:15 3 ;; Created: 1997/06/24 22:38:39
4 ;; Version: 1.19 4 ;; Version: 1.21
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.
123 123
124 (add-minor-mode 'url-dired-minor-mode " URL" url-dired-minor-mode-map) 124 (add-minor-mode 'url-dired-minor-mode " URL" url-dired-minor-mode-map)
125 125
126 (defun url-format-directory (dir) 126 (defun url-format-directory (dir)
127 ;; Format the files in DIR into hypertext 127 ;; Format the files in DIR into hypertext
128 (if (and url-directory-index-file 128 (kill-buffer (current-buffer))
129 (file-exists-p (expand-file-name url-directory-index-file dir)) 129 (find-file dir)
130 (file-readable-p (expand-file-name url-directory-index-file dir))) 130 (url-dired-minor-mode t))
131 (save-excursion
132 (set-buffer url-working-buffer)
133 (erase-buffer)
134 (insert-file-contents
135 (expand-file-name url-directory-index-file dir)))
136 (kill-buffer (current-buffer))
137 (find-file dir)
138 (url-dired-minor-mode t)))
139 131
140 (defun url-host-is-local-p (host) 132 (defun url-host-is-local-p (host)
141 "Return t iff HOST references our local machine." 133 "Return t iff HOST references our local machine."
142 (let ((case-fold-search t)) 134 (let ((case-fold-search t))
143 (or 135 (or
187 (site (url-host urlobj)) 179 (site (url-host urlobj))
188 (file (url-unhex-string (url-filename urlobj))) 180 (file (url-unhex-string (url-filename urlobj)))
189 (dest (url-target urlobj)) 181 (dest (url-target urlobj))
190 (filename (if (or user (not (url-host-is-local-p site))) 182 (filename (if (or user (not (url-host-is-local-p site)))
191 (concat "/" (or user "anonymous") "@" site ":" file) 183 (concat "/" (or user "anonymous") "@" site ":" file)
192 file))) 184 file))
193 185 (viewer (mm-mime-info
186 (mm-extension-to-mime (url-file-extension file))))
187 (pos-index (if url-directory-index-file
188 (expand-file-name url-directory-index-file filename))))
194 (url-clear-tmp-buffer) 189 (url-clear-tmp-buffer)
195 (and user pass 190 (and user pass
196 (cond 191 (cond
197 ((featurep 'ange-ftp) 192 ((featurep 'ange-ftp)
198 (ange-ftp-set-passwd site user pass)) 193 (ange-ftp-set-passwd site user pass))
199 ((or (featurep 'efs) (featurep 'efs-auto)) 194 ((or (featurep 'efs) (featurep 'efs-auto))
200 (efs-set-passwd site user pass)) 195 (efs-set-passwd site user pass))
201 (t 196 (t
202 nil))) 197 nil)))
198 (if (and pos-index
199 (file-exists-p pos-index)
200 (file-readable-p pos-index))
201 (setq filename pos-index))
202 (setq url-current-mime-type (mm-extension-to-mime
203 (url-file-extension filename)))
203 (cond 204 (cond
204 ((file-directory-p filename) 205 ((file-directory-p filename)
205 (if (not (string-match "/$" filename)) 206 (if (not (string-match "/$" filename))
206 (setq filename (concat filename "/"))) 207 (setq filename (concat filename "/")))
207 (if (not (string-match "/$" file)) 208 (if (not (string-match "/$" file))
239 new (efs-ftp-path new) 240 new (efs-ftp-path new)
240 t nil 0 241 t nil 0
241 (url-file-build-continuation new) 242 (url-file-build-continuation new)
242 0 nil))))) 243 0 nil)))))
243 (t 244 (t
244 (let ((viewer (mm-mime-info 245 (let ((errobj nil))
245 (mm-extension-to-mime (url-file-extension file))))
246 (errobj nil))
247 (if (or url-source ; Need it in a buffer 246 (if (or url-source ; Need it in a buffer
248 (and (symbolp viewer) 247 (and (symbolp viewer)
249 (not (eq viewer 'w3-default-local-file))) 248 (not (eq viewer 'w3-default-local-file)))
250 (stringp viewer)) 249 (stringp viewer))
251 (condition-case errobj 250 (condition-case errobj
252 (url-insert-possibly-compressed-file filename t) 251 (url-insert-possibly-compressed-file filename t)
253 (error 252 (error
254 (url-save-error errobj) 253 (url-save-error errobj)
255 (url-retrieve (concat "www://error/nofile/" file)))))))) 254 (url-retrieve (concat "www://error/nofile/" file))))))))))
256 (setq url-current-mime-type (mm-extension-to-mime
257 (url-file-extension file)))))
258 255
259 (fset 'url-ftp 'url-file) 256 (fset 'url-ftp 'url-file)
260 257
261 (provide 'url-file) 258 (provide 'url-file)