X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/4787a496a05fdc03241850b45911dd283d4b06b8..d2be4dccb9088cc7e27aeb6b01ef23ed20da2447:/lisp/url/url-file.el

diff --git a/lisp/url/url-file.el b/lisp/url/url-file.el
index 14b4c432a0..e4d6b649a5 100644
--- a/lisp/url/url-file.el
+++ b/lisp/url/url-file.el
@@ -1,7 +1,6 @@
 ;;; url-file.el --- File retrieval code
 
-;; Copyright (C) 1996, 1997, 1998, 1999, 2004,
-;;   2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1999, 2004-2013 Free Software Foundation, Inc.
 
 ;; Keywords: comm, data, processes
 
@@ -24,7 +23,6 @@
 
 ;;; Code:
 
-(eval-when-compile (require 'cl))
 (require 'mailcap)
 (require 'url-vars)
 (require 'url-parse)
@@ -39,10 +37,10 @@
 This tries the common compression extensions, because things like
 ange-ftp and efs are not quite smart enough to realize when a server
 can do automatic decompression for them, and won't find 'foo' if
-'foo.gz' exists, even though the ftp server would happily serve it up
+'foo.gz' exists, even though the FTP server would happily serve it up
 to them."
   (let ((scratch nil)
-	(compressed-extensions '("" ".gz" ".z" ".Z" ".bz2"))
+	(compressed-extensions '("" ".gz" ".z" ".Z" ".bz2" ".xz"))
 	(found nil))
     (while (and compressed-extensions (not found))
       (if (file-exists-p (setq scratch (concat fname (pop compressed-extensions))))
@@ -88,7 +86,6 @@ to them."
 (declare-function ange-ftp-copy-file-internal "ange-ftp"
 		  (filename newname ok-if-already-exists
 			    keep-date &optional msg cont nowait))
-(declare-function url-generate-unique-filename "url-util" (&optional fmt))
 
 (defun url-file-build-filename (url)
   (if (not (vectorp url))
@@ -104,13 +101,19 @@ to them."
 		     (format "%s#%d" host port))
 		 host))
 	 (file (url-unhex-string (url-filename url)))
-	 (filename (if (or user (not (url-file-host-is-local-p host)))
-		       (concat "/" (or user "anonymous") "@" site ":" file)
-		     (if (and (memq system-type
-				    '(emx ms-dos windows-nt ms-windows))
-			      (string-match "^/[a-zA-Z]:/" file))
-			 (substring file 1)
-		       file)))
+	 (filename (cond
+		    ;; ftp: URL.
+		    ((or user (not (url-file-host-is-local-p host)))
+		     (concat "/" (or user "anonymous") "@" site ":" file))
+		    ;; file: URL on Windows.
+		    ((and (string-match "\\`/[a-zA-Z]:/" file)
+			  (memq system-type '(ms-dos windows-nt)))
+		     (substring file 1))
+		    ;; file: URL with a file:/bar:/foo-like spec.
+		    ((string-match "\\`/[^/]+:/" file)
+		     (concat "/:" file))
+		    (t
+		     file)))
 	 pos-index)
 
     (and user pass
@@ -158,27 +161,26 @@ to them."
 	 (uncompressed-filename nil)
 	 (content-type nil)
 	 (content-encoding nil)
-	 (coding-system-for-read 'binary))
-
-    (setq filename (url-file-build-filename url))
-
-    (if (not filename)
-	(error "File does not exist: %s" (url-recreate-url url)))
-
+	 (coding-system-for-read 'binary)
+	 (filename (url-file-build-filename url)))
+    (or filename (error "File does not exist: %s" (url-recreate-url url)))
     ;; Need to figure out the content-type from the real extension,
     ;; not the compressed one.
+    ;; FIXME should this regexp not include more extensions; basically
+    ;; everything that url-file-find-possibly-compressed-file does?
     (setq uncompressed-filename (if (string-match "\\.\\(gz\\|Z\\|z\\)$" filename)
 				    (substring filename 0 (match-beginning 0))
 				  filename))
     (setq content-type (mailcap-extension-to-mime
 			(url-file-extension uncompressed-filename))
-	  content-encoding (case (intern (url-file-extension filename))
-			     ((\.z \.gz) "gzip")
-			     (\.Z "compress")
-			     (\.uue "x-uuencoded")
-			     (\.hqx "x-hqx")
-			     (\.bz2 "x-bzip2")
-			     (otherwise nil)))
+	  content-encoding (pcase (url-file-extension filename)
+			     ((or ".z" ".gz") "gzip")
+			     (".Z" "compress")
+			     (".uue" "x-uuencoded")
+			     (".hqx" "x-hqx")
+			     (".bz2" "x-bzip2")
+			     (".xz" "x-xz")
+			     (_ nil)))
 
     (if (file-directory-p filename)
 	;; A directory is done the same whether we are local or remote
@@ -202,10 +204,8 @@ to them."
 					(current-buffer)
 					callback cbargs))
 	  ;; FTP handling
-	  (let* ((extension (url-file-extension filename))
-		 (new (url-generate-unique-filename
-		       (and (> (length extension) 0)
-			    (concat "%s." extension)))))
+	  (let ((new (make-temp-file
+		      (format "url-tmp.%d" (user-real-uid)))))
 	    (if (featurep 'ange-ftp)
 		(ange-ftp-copy-file-internal filename (expand-file-name new) t
 					     nil t
@@ -242,5 +242,4 @@ to them."
 
 (provide 'url-file)
 
-;; arch-tag: 010e914a-7313-494b-8a8c-6495a862157d
 ;;; url-file.el ends here