--- a/lisp/w3/url-file.el	Mon Aug 13 09:12:43 2007 +0200
+++ b/lisp/w3/url-file.el	Mon Aug 13 09:13:56 2007 +0200
@@ -1,7 +1,7 @@
 ;;; url-file.el --- File retrieval code
 ;; Author: wmperry
-;; Created: 1997/01/24 14:32:50
-;; Version: 1.9
+;; Created: 1997/02/10 16:16:46
+;; Version: 1.13
 ;; Keywords: comm, data, processes
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -44,136 +44,174 @@
 	(coding-system-for-read mule-no-coding-system))
     (setq compressed 
 	  (cond
-	   ((file-exists-p fname) nil)
+	   ((file-exists-p fname)
+	    (if (string-match "\\.\\(z\\|gz\\|Z\\)$" fname)
+		(case (intern (match-string 1 fname))
+		  ((z gz)
+		   (setq url-current-mime-headers (cons
+						   (cons
+						    "content-transfer-encoding"
+						    "gzip")
+						   url-current-mime-headers)))
+		  (Z
+		   (setq url-current-mime-headers (cons
+						   (cons
+						    "content-transfer-encoding"
+						    "compress")
+						   url-current-mime-headers))))
+	      nil))
 	   ((file-exists-p (concat fname ".Z"))
-	    (setq fname (concat fname ".Z")))
+	    (setq fname (concat fname ".Z")
+		  url-current-mime-headers (cons (cons
+						  "content-transfer-encoding"
+						  "compress")
+						 url-current-mime-headers)))
 	   ((file-exists-p (concat fname ".gz"))
-	    (setq fname (concat fname ".gz")))
+	    (setq fname (concat fname ".gz")
+		  url-current-mime-headers (cons (cons
+						  "content-transfer-encoding"
+						  "gzip")
+						 url-current-mime-headers)))
 	   ((file-exists-p (concat fname ".z"))
-	    (setq fname (concat fname ".z")))
+	    (setq fname (concat fname ".z")
+		  url-current-mime-headers (cons (cons
+						  "content-transfer-encoding"
+						  "gzip")
+						 url-current-mime-headers)))
 	   (t
 	    (error "File not found %s" fname))))
-    (if (or (not compressed) url-inhibit-uncompression)
-	(apply 'insert-file-contents fname args)
-      (let* ((extn (url-file-extension fname))
-	     (code (cdr-safe (assoc extn url-uncompressor-alist)))
-	     (decoder (cdr-safe (assoc code mm-content-transfer-encodings))))
-	(cond
-	 ((null decoder) 
-	  (apply 'insert-file-contents fname args))
-	 ((stringp decoder)
-	  (apply 'insert-file-contents fname args)
-	  (message "Decoding...")
-	  (call-process-region (point-min) (point-max) decoder t t nil)
-	  (message "Decoding... done."))
-	 ((listp decoder)
-	  (apply 'call-process-region (point-min) (point-max)
-		 (car decoder) t t t (cdr decoder)))
-	 ((and (symbolp decoder) (fboundp decoder))
-	  (apply 'insert-file-contents fname args)
-	  (message "Decoding...")
-	  (funcall decoder (point-min) (point-max))
-	  (message "Decoding... done."))
-	 (t
-	  (error "Malformed entry for %s in `mm-content-transfer-encodings'"
-		 code))))))
-  (set-buffer-modified-p nil))
+    (apply 'insert-file-contents fname args)
+    (set-buffer-modified-p nil)))
+
+(defvar url-dired-minor-mode-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map "\C-m" 'url-dired-find-file)
+    (if url-running-xemacs
+	(define-key map [button2] 'url-dired-find-file-mouse)
+      (define-key map [mouse-2] 'url-dired-find-file-mouse))
+    map)
+  "Keymap used when browsing directories.")
+
+(defvar url-dired-minor-mode nil
+  "Whether we are in url-dired-minor-mode")
+
+(make-variable-buffer-local 'url-dired-minor-mode)
+
+(defun url-dired-find-file ()
+  "In dired, visit the file or directory named on this line, using Emacs-W3."
+  (interactive)
+  (w3-open-local (dired-get-filename)))
+
+(defun url-dired-find-file-mouse (event)
+  "In dired, visit the file or directory name you click on, using Emacs-W3."
+  (interactive "@e")
+    (if (event-point event)
+	(progn
+	  (goto-char (event-point event))
+	  (url-dired-find-file))))
+
+(defun url-dired-minor-mode (&optional arg)
+  "Minor mode for directory browsing with Emacs-W3."
+  (interactive "P")
+  (cond
+   ((null arg)
+    (setq url-dired-minor-mode (not url-dired-minor-mode)))
+   ((equal 0 arg)
+    (setq url-dired-minor-mode nil))
+   (t
+    (setq url-dired-minor-mode t))))
+
+(add-minor-mode 'url-dired-minor-mode " URL" url-dired-minor-mode-map)
 
 (defun url-format-directory (dir)
   ;; Format the files in DIR into hypertext
-  (let ((files (directory-files dir nil)) file
-	div attr mod-time size typ title)
-    (if (and url-directory-index-file
-	     (file-exists-p (expand-file-name url-directory-index-file dir))
-	     (file-readable-p (expand-file-name url-directory-index-file dir)))
-	(save-excursion
-	  (set-buffer url-working-buffer)
-	  (erase-buffer)
-	  (insert-file-contents-literally
-	   (expand-file-name url-directory-index-file dir)))
+  (if (and url-directory-index-file
+	   (file-exists-p (expand-file-name url-directory-index-file dir))
+	   (file-readable-p (expand-file-name url-directory-index-file dir)))
       (save-excursion
-	(if (string-match "/\\([^/]+\\)/$" dir)
-	    (setq title (concat ".../" (url-match dir 1) "/"))
-	  (setq title "/"))
-	(setq div (1- (length files)))
 	(set-buffer url-working-buffer)
 	(erase-buffer)
-	(insert "<html>\n"
-		" <head>\n"
-		"  <title>" title "</title>\n"
-		" </head>\n"
-		" <body>\n"
-		"  <div>\n"
-		"   <h1 align=center> Index of " title "</h1>\n"
-		"   <pre>\n"
-		"       Name                     Last modified                Size\n</pre>"
-		"<hr>\n   <pre>\n")
-	(while files
-	  (url-lazy-message "Building directory list... (%d%%)"
-			    (/ (* 100 (- div (length files))) div))
-	  (setq file (expand-file-name (car files) dir)
-		attr (file-attributes file)
-		file (car files)
-		mod-time (nth 5 attr)
-		size (nth 7 attr)
-		typ (or (mm-extension-to-mime (url-file-extension file)) ""))
-	  (setq file (url-hexify-string file))
-	  (if (equal '(0 0) mod-time) ; Set to null if unknown or
-	      (setq mod-time "Unknown                 ")
-	    (setq mod-time (current-time-string mod-time)))
-	  (if (or (equal size 0) (equal size -1) (null size))
-	      (setq size "   -")
-	    (setq size
-		  (cond
-		   ((< size 1024) (concat "   " "1K"))
-		   ((< size 1048576) (concat "   "
-					     (int-to-string
-					      (max 1 (/ size 1024))) "K"))
-		   (t
-		    (let* ((megs (max 1 (/ size 1048576)))
-			   (kilo (/ (- size (* megs 1048576)) 1024)))
-		      (concat "   "  (int-to-string megs)
-			      (if (> kilo 0)
-				  (concat "." (int-to-string kilo))
-				"") "M"))))))
-	  (cond
-	   ((or (equal "." (car files))
-		(equal "/.." (car files)))
-	    nil)
-	   ((equal ".." (car files))
-	    (if (not (= ?/ (aref file (1- (length file)))))
-		(setq file (concat file "/"))))
-	   ((stringp (nth 0 attr))	; Symbolic link handling
-	    (insert "[LNK] <a href=\"./" file "\">" (car files) "</a>"
-		    (make-string (max 0 (- 25 (length (car files)))) ? )
-		    mod-time size "\n"))
-	   ((nth 0 attr)		; Directory handling
-	    (insert "[DIR] <a href=\"./" file "/\">" (car files) "</a>"
-		    (make-string (max 0 (- 25 (length (car files)))) ? )
-		    mod-time size "\n"))
-	   ((string-match "image" typ)
-	    (insert "[IMG] <a href=\"./" file "\">" (car files) "</a>"
-		    (make-string (max 0 (- 25 (length (car files)))) ? )
-		    mod-time size "\n"))
-	   ((string-match "application" typ)
-	    (insert "[APP] <a href=\"./" file "\">" (car files) "</a>"
-		    (make-string (max 0 (- 25 (length (car files)))) ? )
-		    mod-time size "\n"))
-	   ((string-match "text" typ)
-	    (insert "[TXT] <a href=\"./" file "\">" (car files) "</a>"
-		    (make-string (max 0 (- 25 (length (car files)))) ? )
-		    mod-time size "\n"))
-	   (t
-	    (insert "[UNK] <a href=\"./" file "\">" (car files) "</a>"
-		    (make-string (max 0 (- 25 (length (car files)))) ? )
-		    mod-time size "\n")))
-	  (setq files (cdr files)))
-	(insert "   </pre>\n"
-		"  </div>\n"
-		" </body>\n"
-		"</html>\n"
-		"<!-- Automatically generated by URL v" url-version
-		" -->\n")))))
+	(insert-file-contents-literally
+	 (expand-file-name url-directory-index-file dir)))
+    (kill-buffer (current-buffer))
+    (find-file dir)
+    (url-dired-minor-mode t)))
+;   (let ((files (directory-files dir nil)) file
+;	  div attr mod-time size typ title desc)
+;      (save-excursion
+;	(if (string-match "/\\([^/]+\\)/$" dir)
+;	    (setq title (concat ".../" (url-match dir 1) "/"))
+;	  (setq title "/"))
+;	(setq div (1- (length files)))
+;	(set-buffer url-working-buffer)
+;	(erase-buffer)
+;	(insert "<html>\n"
+;		" <head>\n"
+;		"  <title>" title "</title>\n"
+;		" </head>\n"
+;		" <body>\n"
+;		"   <h1 align=center> Index of " title "</h1>\n"
+;		"   <table border=0>\n"
+;		"    <tr><th>Name<th>Last Modified<th>Size</tr>\n"
+;		"    <tr><td colspan=3><hr></tr>\n")
+;	(while files
+;	  (url-lazy-message "Building directory list... (%d%%)"
+;			    (/ (* 100 (- div (length files))) div))
+;	  (setq file (expand-file-name (car files) dir)
+;		attr (file-attributes file)
+;		file (car files)
+;		mod-time (nth 5 attr)
+;		size (nth 7 attr)
+;		typ (or (mm-extension-to-mime (url-file-extension file)) ""))
+;	  (setq file (url-hexify-string file))
+;	  (if (equal '(0 0) mod-time)	; Set to null if unknown or
+;	      (setq mod-time "Unknown")
+;	    (setq mod-time (current-time-string mod-time)))
+;	  (if (or (equal size 0) (equal size -1) (null size))
+;	      (setq size "-")
+;	    (setq size
+;		  (cond
+;		   ((< size 1024) "1K")
+;		   ((< size 1048576) (concat (int-to-string
+;					      (max 1 (/ size 1024))) "K"))
+;		   (t
+;		    (let* ((megs (max 1 (/ size 1048576)))
+;			   (kilo (/ (- size (* megs 1048576)) 1024)))
+;		      (concat (int-to-string megs)
+;			      (if (> kilo 0)
+;				  (concat "." (int-to-string kilo))
+;				"") "M"))))))
+;	  (cond
+;	   ((or (equal "." (car files))
+;		(equal "/.." (car files)))
+;	    (setq desc nil))
+;	   ((equal ".." (car files))
+;	    (if (not (= ?/ (aref file (1- (length file)))))
+;		(setq file (concat file "/"))))
+;	   ((stringp (nth 0 attr))	; Symbolic link handling
+;	    (setq desc "[LNK]"))
+;	   ((nth 0 attr)		; Directory handling
+;	    (setq desc "[DIR]"))
+;	   ((string-match "image" typ)
+;	    (setq desc "[IMG]"))
+;	   ((string-match "application" typ)
+;	    (setq desc "[APP]"))
+;	   ((string-match "text" typ)
+;	    (setq desc "[TXT]"))
+;	   ((auto-save-file-name-p (car files))
+;	    (setq desc "[BAK]"))
+;	   (t
+;	    (setq desc "[UNK]")))
+;	  (if desc
+;	      (insert "<tr><td>" desc " <a href=\"./" file "\">" (car files)
+;		      "</a><td>" mod-time "<td><p align=right>" size
+;		      "</tr>\n"))
+;	  (setq files (cdr files)))
+;	(insert "   </table>\n"
+;		" </body>\n"
+;		"</html>\n"
+;		"<!-- Automatically generated by URL v" url-version
+;		" -->\n")))
 
 (defun url-host-is-local-p (host)
   "Return t iff HOST references our local machine."
@@ -222,20 +260,14 @@
 	   nil)))
     (cond
      ((file-directory-p filename)
-      (if url-use-hypertext-dired
-	  (progn
-	    (if (string-match "/$" filename)
-		nil
-	      (setq filename (concat filename "/")))
-	    (if (string-match "/$" file)
-		nil
-	      (setq file (concat file "/")))
-	    (url-set-filename urlobj file)
-	    (url-format-directory filename))
-	(progn
-	  (if (get-buffer url-working-buffer)
-	      (kill-buffer url-working-buffer))
-	  (find-file filename))))
+      (if (string-match "/$" filename)
+	  nil
+	(setq filename (concat filename "/")))
+      (if (string-match "/$" file)
+	  nil
+	(setq file (concat file "/")))
+      (url-set-filename urlobj file)
+      (url-format-directory filename))
      ((and (boundp 'w3-dump-to-disk) (symbol-value 'w3-dump-to-disk))
       (cond
        ((file-exists-p filename) nil)