Mercurial > hg > xemacs-beta

comparison lisp/w3/url-file.el @ 22:8fc7fe29b841 r19-15b94

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b94
author cvs
date Mon, 13 Aug 2007 08:50:29 +0200
parents 859a2309aef8
children 441bb1e64a06
comparison
equal deleted inserted replaced
21:b88636d63495 22:8fc7fe29b841
1 ;;; url-file.el --- File retrieval code 1 ;;; url-file.el --- File retrieval code
2 ;; Author: wmperry 2 ;; Author: wmperry
3 ;; Created: 1997/02/07 14:29:24 3 ;; Created: 1997/02/10 16:16:46
4 ;; Version: 1.10 4 ;; Version: 1.13
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.
81 (t 81 (t
82 (error "File not found %s" fname)))) 82 (error "File not found %s" fname))))
83 (apply 'insert-file-contents fname args) 83 (apply 'insert-file-contents fname args)
84 (set-buffer-modified-p nil))) 84 (set-buffer-modified-p nil)))
85 85
86 (defvar url-dired-minor-mode-map
87 (let ((map (make-sparse-keymap)))
88 (define-key map "\C-m" 'url-dired-find-file)
89 (if url-running-xemacs
90 (define-key map [button2] 'url-dired-find-file-mouse)
91 (define-key map [mouse-2] 'url-dired-find-file-mouse))
92 map)
93 "Keymap used when browsing directories.")
94
95 (defvar url-dired-minor-mode nil
96 "Whether we are in url-dired-minor-mode")
97
98 (make-variable-buffer-local 'url-dired-minor-mode)
99
100 (defun url-dired-find-file ()
101 "In dired, visit the file or directory named on this line, using Emacs-W3."
102 (interactive)
103 (w3-open-local (dired-get-filename)))
104
105 (defun url-dired-find-file-mouse (event)
106 "In dired, visit the file or directory name you click on, using Emacs-W3."
107 (interactive "@e")
108 (if (event-point event)
109 (progn
110 (goto-char (event-point event))
111 (url-dired-find-file))))
112
113 (defun url-dired-minor-mode (&optional arg)
114 "Minor mode for directory browsing with Emacs-W3."
115 (interactive "P")
116 (cond
117 ((null arg)
118 (setq url-dired-minor-mode (not url-dired-minor-mode)))
119 ((equal 0 arg)
120 (setq url-dired-minor-mode nil))
121 (t
122 (setq url-dired-minor-mode t))))
123
124 (add-minor-mode 'url-dired-minor-mode " URL" url-dired-minor-mode-map)
125
86 (defun url-format-directory (dir) 126 (defun url-format-directory (dir)
87 ;; Format the files in DIR into hypertext 127 ;; Format the files in DIR into hypertext
88 (let ((files (directory-files dir nil)) file 128 (if (and url-directory-index-file
89 div attr mod-time size typ title) 129 (file-exists-p (expand-file-name url-directory-index-file dir))
90 (if (and url-directory-index-file 130 (file-readable-p (expand-file-name url-directory-index-file dir)))
91 (file-exists-p (expand-file-name url-directory-index-file dir))
92 (file-readable-p (expand-file-name url-directory-index-file dir)))
93 (save-excursion
94 (set-buffer url-working-buffer)
95 (erase-buffer)
96 (insert-file-contents-literally
97 (expand-file-name url-directory-index-file dir)))
98 (save-excursion 131 (save-excursion
99 (if (string-match "/\\([^/]+\\)/$" dir)
100 (setq title (concat ".../" (url-match dir 1) "/"))
101 (setq title "/"))
102 (setq div (1- (length files)))
103 (set-buffer url-working-buffer) 132 (set-buffer url-working-buffer)
104 (erase-buffer) 133 (erase-buffer)
105 (insert "<html>\n" 134 (insert-file-contents-literally
106 " <head>\n" 135 (expand-file-name url-directory-index-file dir)))
107 " <title>" title "</title>\n" 136 (kill-buffer (current-buffer))
108 " </head>\n" 137 (find-file dir)
109 " <body>\n" 138 (url-dired-minor-mode t)))
110 " <div>\n" 139 ; (let ((files (directory-files dir nil)) file
111 " <h1 align=center> Index of " title "</h1>\n" 140 ; div attr mod-time size typ title desc)
112 " <pre>\n" 141 ; (save-excursion
113 " Name Last modified Size\n</pre>" 142 ; (if (string-match "/\\([^/]+\\)/$" dir)
114 "<hr>\n <pre>\n") 143 ; (setq title (concat ".../" (url-match dir 1) "/"))
115 (while files 144 ; (setq title "/"))
116 (url-lazy-message "Building directory list... (%d%%)" 145 ; (setq div (1- (length files)))
117 (/ (* 100 (- div (length files))) div)) 146 ; (set-buffer url-working-buffer)
118 (setq file (expand-file-name (car files) dir) 147 ; (erase-buffer)
119 attr (file-attributes file) 148 ; (insert "<html>\n"
120 file (car files) 149 ; " <head>\n"
121 mod-time (nth 5 attr) 150 ; " <title>" title "</title>\n"
122 size (nth 7 attr) 151 ; " </head>\n"
123 typ (or (mm-extension-to-mime (url-file-extension file)) "")) 152 ; " <body>\n"
124 (setq file (url-hexify-string file)) 153 ; " <h1 align=center> Index of " title "</h1>\n"
125 (if (equal '(0 0) mod-time) ; Set to null if unknown or 154 ; " <table border=0>\n"
126 (setq mod-time "Unknown ") 155 ; " <tr><th>Name<th>Last Modified<th>Size</tr>\n"
127 (setq mod-time (current-time-string mod-time))) 156 ; " <tr><td colspan=3><hr></tr>\n")
128 (if (or (equal size 0) (equal size -1) (null size)) 157 ; (while files
129 (setq size " -") 158 ; (url-lazy-message "Building directory list... (%d%%)"
130 (setq size 159 ; (/ (* 100 (- div (length files))) div))
131 (cond 160 ; (setq file (expand-file-name (car files) dir)
132 ((< size 1024) (concat " " "1K")) 161 ; attr (file-attributes file)
133 ((< size 1048576) (concat " " 162 ; file (car files)
134 (int-to-string 163 ; mod-time (nth 5 attr)
135 (max 1 (/ size 1024))) "K")) 164 ; size (nth 7 attr)
136 (t 165 ; typ (or (mm-extension-to-mime (url-file-extension file)) ""))
137 (let* ((megs (max 1 (/ size 1048576))) 166 ; (setq file (url-hexify-string file))
138 (kilo (/ (- size (* megs 1048576)) 1024))) 167 ; (if (equal '(0 0) mod-time) ; Set to null if unknown or
139 (concat " " (int-to-string megs) 168 ; (setq mod-time "Unknown")
140 (if (> kilo 0) 169 ; (setq mod-time (current-time-string mod-time)))
141 (concat "." (int-to-string kilo)) 170 ; (if (or (equal size 0) (equal size -1) (null size))
142 "") "M")))))) 171 ; (setq size "-")
143 (cond 172 ; (setq size
144 ((or (equal "." (car files)) 173 ; (cond
145 (equal "/.." (car files))) 174 ; ((< size 1024) "1K")
146 nil) 175 ; ((< size 1048576) (concat (int-to-string
147 ((equal ".." (car files)) 176 ; (max 1 (/ size 1024))) "K"))
148 (if (not (= ?/ (aref file (1- (length file))))) 177 ; (t
149 (setq file (concat file "/")))) 178 ; (let* ((megs (max 1 (/ size 1048576)))
150 ((stringp (nth 0 attr)) ; Symbolic link handling 179 ; (kilo (/ (- size (* megs 1048576)) 1024)))
151 (insert "[LNK] <a href=\"./" file "\">" (car files) "</a>" 180 ; (concat (int-to-string megs)
152 (make-string (max 0 (- 25 (length (car files)))) ? ) 181 ; (if (> kilo 0)
153 mod-time size "\n")) 182 ; (concat "." (int-to-string kilo))
154 ((nth 0 attr) ; Directory handling 183 ; "") "M"))))))
155 (insert "[DIR] <a href=\"./" file "/\">" (car files) "</a>" 184 ; (cond
156 (make-string (max 0 (- 25 (length (car files)))) ? ) 185 ; ((or (equal "." (car files))
157 mod-time size "\n")) 186 ; (equal "/.." (car files)))
158 ((string-match "image" typ) 187 ; (setq desc nil))
159 (insert "[IMG] <a href=\"./" file "\">" (car files) "</a>" 188 ; ((equal ".." (car files))
160 (make-string (max 0 (- 25 (length (car files)))) ? ) 189 ; (if (not (= ?/ (aref file (1- (length file)))))
161 mod-time size "\n")) 190 ; (setq file (concat file "/"))))
162 ((string-match "application" typ) 191 ; ((stringp (nth 0 attr)) ; Symbolic link handling
163 (insert "[APP] <a href=\"./" file "\">" (car files) "</a>" 192 ; (setq desc "[LNK]"))
164 (make-string (max 0 (- 25 (length (car files)))) ? ) 193 ; ((nth 0 attr) ; Directory handling
165 mod-time size "\n")) 194 ; (setq desc "[DIR]"))
166 ((string-match "text" typ) 195 ; ((string-match "image" typ)
167 (insert "[TXT] <a href=\"./" file "\">" (car files) "</a>" 196 ; (setq desc "[IMG]"))
168 (make-string (max 0 (- 25 (length (car files)))) ? ) 197 ; ((string-match "application" typ)
169 mod-time size "\n")) 198 ; (setq desc "[APP]"))
170 (t 199 ; ((string-match "text" typ)
171 (insert "[UNK] <a href=\"./" file "\">" (car files) "</a>" 200 ; (setq desc "[TXT]"))
172 (make-string (max 0 (- 25 (length (car files)))) ? ) 201 ; ((auto-save-file-name-p (car files))
173 mod-time size "\n"))) 202 ; (setq desc "[BAK]"))
174 (setq files (cdr files))) 203 ; (t
175 (insert " </pre>\n" 204 ; (setq desc "[UNK]")))
176 " </div>\n" 205 ; (if desc
177 " </body>\n" 206 ; (insert "<tr><td>" desc " <a href=\"./" file "\">" (car files)
178 "</html>\n" 207 ; "</a><td>" mod-time "<td><p align=right>" size
179 "<!-- Automatically generated by URL v" url-version 208 ; "</tr>\n"))
180 " -->\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")))
181 215
182 (defun url-host-is-local-p (host) 216 (defun url-host-is-local-p (host)
183 "Return t iff HOST references our local machine." 217 "Return t iff HOST references our local machine."
184 (let ((case-fold-search t)) 218 (let ((case-fold-search t))
185 (or 219 (or
224 (efs-set-passwd site user pass)) 258 (efs-set-passwd site user pass))
225 (t 259 (t
226 nil))) 260 nil)))
227 (cond 261 (cond
228 ((file-directory-p filename) 262 ((file-directory-p filename)
229 (if url-use-hypertext-dired 263 (if (string-match "/$" filename)
230 (progn 264 nil
231 (if (string-match "/$" filename) 265 (setq filename (concat filename "/")))
232 nil 266 (if (string-match "/$" file)
233 (setq filename (concat filename "/"))) 267 nil
234 (if (string-match "/$" file) 268 (setq file (concat file "/")))
235 nil 269 (url-set-filename urlobj file)
236 (setq file (concat file "/"))) 270 (url-format-directory filename))
237 (url-set-filename urlobj file)
238 (url-format-directory filename))
239 (progn
240 (if (get-buffer url-working-buffer)
241 (kill-buffer url-working-buffer))
242 (find-file filename))))
243 ((and (boundp 'w3-dump-to-disk) (symbol-value 'w3-dump-to-disk)) 271 ((and (boundp 'w3-dump-to-disk) (symbol-value 'w3-dump-to-disk))
244 (cond 272 (cond
245 ((file-exists-p filename) nil) 273 ((file-exists-p filename) nil)
246 ((file-exists-p (concat filename ".Z")) 274 ((file-exists-p (concat filename ".Z"))
247 (setq filename (concat filename ".Z"))) 275 (setq filename (concat filename ".Z")))