Mercurial > hg > xemacs-beta

comparison lisp/w3/url-file.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 0d2f883870bc
children cca96a509cfe
comparison
equal deleted inserted replaced
101:a0ec055d74dd 102:a145efe76779
1 ;;; url-file.el --- File retrieval code 1 ;;; url-file.el --- File retrieval code
2 ;; Author: wmperry 2 ;; Author: wmperry
3 ;; Created: 1997/02/10 16:16:46 3 ;; Created: 1997/02/19 23:38:31
4 ;; Version: 1.13 4 ;; Version: 1.15
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.
134 (insert-file-contents-literally 134 (insert-file-contents-literally
135 (expand-file-name url-directory-index-file dir))) 135 (expand-file-name url-directory-index-file dir)))
136 (kill-buffer (current-buffer)) 136 (kill-buffer (current-buffer))
137 (find-file dir) 137 (find-file dir)
138 (url-dired-minor-mode t))) 138 (url-dired-minor-mode t)))
139 ; (let ((files (directory-files dir nil)) file
140 ; div attr mod-time size typ title desc)
141 ; (save-excursion
142 ; (if (string-match "/\\([^/]+\\)/$" dir)
143 ; (setq title (concat ".../" (url-match dir 1) "/"))
144 ; (setq title "/"))
145 ; (setq div (1- (length files)))
146 ; (set-buffer url-working-buffer)
147 ; (erase-buffer)
148 ; (insert "<html>\n"
149 ; " <head>\n"
150 ; " <title>" title "</title>\n"
151 ; " </head>\n"
152 ; " <body>\n"
153 ; " <h1 align=center> Index of " title "</h1>\n"
154 ; " <table border=0>\n"
155 ; " <tr><th>Name<th>Last Modified<th>Size</tr>\n"
156 ; " <tr><td colspan=3><hr></tr>\n")
157 ; (while files
158 ; (url-lazy-message "Building directory list... (%d%%)"
159 ; (/ (* 100 (- div (length files))) div))
160 ; (setq file (expand-file-name (car files) dir)
161 ; attr (file-attributes file)
162 ; file (car files)
163 ; mod-time (nth 5 attr)
164 ; size (nth 7 attr)
165 ; typ (or (mm-extension-to-mime (url-file-extension file)) ""))
166 ; (setq file (url-hexify-string file))
167 ; (if (equal '(0 0) mod-time) ; Set to null if unknown or
168 ; (setq mod-time "Unknown")
169 ; (setq mod-time (current-time-string mod-time)))
170 ; (if (or (equal size 0) (equal size -1) (null size))
171 ; (setq size "-")
172 ; (setq size
173 ; (cond
174 ; ((< size 1024) "1K")
175 ; ((< size 1048576) (concat (int-to-string
176 ; (max 1 (/ size 1024))) "K"))
177 ; (t
178 ; (let* ((megs (max 1 (/ size 1048576)))
179 ; (kilo (/ (- size (* megs 1048576)) 1024)))
180 ; (concat (int-to-string megs)
181 ; (if (> kilo 0)
182 ; (concat "." (int-to-string kilo))
183 ; "") "M"))))))
184 ; (cond
185 ; ((or (equal "." (car files))
186 ; (equal "/.." (car files)))
187 ; (setq desc nil))
188 ; ((equal ".." (car files))
189 ; (if (not (= ?/ (aref file (1- (length file)))))
190 ; (setq file (concat file "/"))))
191 ; ((stringp (nth 0 attr)) ; Symbolic link handling
192 ; (setq desc "[LNK]"))
193 ; ((nth 0 attr) ; Directory handling
194 ; (setq desc "[DIR]"))
195 ; ((string-match "image" typ)
196 ; (setq desc "[IMG]"))
197 ; ((string-match "application" typ)
198 ; (setq desc "[APP]"))
199 ; ((string-match "text" typ)
200 ; (setq desc "[TXT]"))
201 ; ((auto-save-file-name-p (car files))
202 ; (setq desc "[BAK]"))
203 ; (t
204 ; (setq desc "[UNK]")))
205 ; (if desc
206 ; (insert "<tr><td>" desc " <a href=\"./" file "\">" (car files)
207 ; "</a><td>" mod-time "<td><p align=right>" size
208 ; "</tr>\n"))
209 ; (setq files (cdr files)))
210 ; (insert " </table>\n"
211 ; " </body>\n"
212 ; "</html>\n"
213 ; "<!-- Automatically generated by URL v" url-version
214 ; " -->\n")))
215 139
216 (defun url-host-is-local-p (host) 140 (defun url-host-is-local-p (host)
217 "Return t iff HOST references our local machine." 141 "Return t iff HOST references our local machine."
218 (let ((case-fold-search t)) 142 (let ((case-fold-search t))
219 (or 143 (or
237 (file (url-unhex-string (url-filename urlobj))) 161 (file (url-unhex-string (url-filename urlobj)))
238 (dest (url-target urlobj)) 162 (dest (url-target urlobj))
239 (filename (if (or user (not (url-host-is-local-p site))) 163 (filename (if (or user (not (url-host-is-local-p site)))
240 (concat "/" (or user "anonymous") "@" site ":" file) 164 (concat "/" (or user "anonymous") "@" site ":" file)
241 file))) 165 file)))
242
243 (if (and file (url-host-is-local-p site)
244 (memq system-type '(ms-windows ms-dos windows-nt os2)))
245 (let ((x (1- (length file)))
246 (y 0))
247 (while (<= y x)
248 (if (= (aref file y) ?\\ )
249 (aset file y ?/))
250 (setq y (1+ y)))))
251 166
252 (url-clear-tmp-buffer) 167 (url-clear-tmp-buffer)
253 (and user pass 168 (and user pass
254 (cond 169 (cond
255 ((featurep 'ange-ftp) 170 ((featurep 'ange-ftp)
313 (condition-case errobj 228 (condition-case errobj
314 (url-insert-possibly-compressed-file filename t) 229 (url-insert-possibly-compressed-file filename t)
315 (error 230 (error
316 (url-save-error errobj) 231 (url-save-error errobj)
317 (url-retrieve (concat "www://error/nofile/" file)))))))) 232 (url-retrieve (concat "www://error/nofile/" file))))))))
318 (setq url-current-type (if site "ftp" "file") 233 (setq url-current-mime-type (mm-extension-to-mime
319 url-current-object urlobj 234 (url-file-extension file)))))
320 url-find-this-link dest
321 url-current-user user
322 url-current-server site
323 url-current-mime-type (mm-extension-to-mime
324 (url-file-extension file))
325 url-current-file file)))
326 235
327 (fset 'url-ftp 'url-file) 236 (fset 'url-ftp 'url-file)
328 237
329 (provide 'url-file) 238 (provide 'url-file)