[asdf-install-devel] Patch for tar handling

[Dan Muller]

OK, here's the patch I was talking about. After some of the other
discussion, though, I'm thinking that I should rework it for more
backwards compatibility. But if anyone actually takes the time to try
it out, I'd be interested in feedback.

There are some exported variables that are not documented,
e.g. *TAR-EXTRACTORS*. Would those be considered fair game for
changing? (I'm not sure I see the point behind having a *list* of
extractors, esp. when the only one provided by ASDF-INSTALL warns when
it's not applicable!) I'm thinking of reverting most of these changes,
exporting and documenting a single-valued *TAR-EXTRACTOR*, and then
providing an alternative extractor with my changes.

Thoughts?

BTW, I have the last released version of ASDF-INSTALL checked into my
private SVN repository, and I used SVN to make this patch -- hence the
references to "revision 141" in the patch. I don't have darcs on my
Windows machine. (Did they ever get that working on Windows?)

  -- Dan Muller


---- Patch begins below this line ---
Index: asdf-install/asdf-install/defpackage.lisp
===================================================================
--- asdf-install/asdf-install/defpackage.lisp	(revision 141)
+++ asdf-install/asdf-install/defpackage.lisp	(working copy)
@@ -48,12 +48,7 @@
 
    ;; restarts
    #:install-anyways
-   )
-  
-  #+(or :win32 :mswindows)
-  (:export
-   #:*cygwin-bin-directory*
-   #:*cygwin-bash-command*))
+   ))
 
 (defpackage #:asdf-install-customize
   (:use #:common-lisp #:asdf-install))
Index: asdf-install/asdf-install/installer.lisp
===================================================================
--- asdf-install/asdf-install/installer.lisp	(revision 141)
+++ asdf-install/asdf-install/installer.lisp	(working copy)
@@ -276,28 +276,19 @@
 
 (defun find-shell-command (command)
   (loop for directory in *shell-search-paths* do
-       (let ((target (make-pathname :name command :type nil
-				    :directory directory)))
+       (let ((target (merge-pathnames (pathname command) directory)))
 	 (when (probe-file target)
 	   (return-from find-shell-command (namestring target)))))
   (values nil))
 
 (defun tar-command ()
-  #-(or :win32 :mswindows)
-  (find-shell-command *gnu-tar-program*)
-  #+(or :win32 :mswindows)
-  *cygwin-bash-program*)
+  (find-shell-command *gnu-tar-program*))
 
 (defun tar-arguments (source packagename)
-  #-(or :win32 :mswindows :scl)
-  (list "-C" (namestring (truename source))
+  #-(or :scl)
+  (list "--force-local"
+        "-C" (namestring (truename source))
 	"-xzvf" (namestring (truename packagename)))
-  #+(or :win32 :mswindows)
-  (list "-l"
-	"-c"
-	(format nil "\"tar -C \\\"`cygpath '~A'`\\\" -xzvf \\\"`cygpath '~A'`\\\"\""
-		(namestring (truename source))
-		(namestring (truename packagename))))
   #+scl
   (list "-C" (ext:unix-namestring (truename source))
 	"-xzvf" (ext:unix-namestring (truename packagename))))
Index: asdf-install/asdf-install/variables.lisp
===================================================================
--- asdf-install/asdf-install/variables.lisp	(revision 141)
+++ asdf-install/asdf-install/variables.lisp	(working copy)
@@ -6,9 +6,8 @@
   (let ((path (pathname name)))
     (if (pathname-name path)
 	(merge-pathnames
-	 (make-pathname :directory `(:relative ,(pathname-name path))
-			:name "")
-	 path)
+	 (make-pathname :directory `(:relative ,(pathname-name path)))
+	 (make-pathname :host (pathname-host path) :device (pathname-device path) :directory (pathname-directory path)))
 	path)))
 
 #+:digitool
@@ -38,22 +37,27 @@
   (or (get-env-var "CCLAN_MIRROR")
       "http://ftp.linux.org.uk/pub/lisp/cclan/"))
 
-#+(or :win32 :mswindows)
-(defvar *cygwin-bin-directory*
-  (pathname "C:\\PROGRA~1\\Cygwin\\bin\\"))
+(defvar *shell-search-paths*
 
-#+(or :win32 :mswindows)
-(defvar *cygwin-bash-program*
-  "C:\\PROGRA~1\\Cygwin\\bin\\bash.exe")
+  #-(or :win32 :mswindows)
+  ;; bin first
+  (list (make-pathname :directory '(:absolute "bin"))
+        (make-pathname :directory '(:absolute "usr" "bin")))
+  
+  ;; On Windows, there's no notion of standard paths containing other
+  ;; than OS components. Simply use the same path that the user does.
+  #+(or :win32 :mswindows)
+  (loop
+     for path = (get-env-var "PATH") then (subseq path (1+ (or (position #\; path) (1- (length path)))))
+     for elem = (subseq path 0 (position #\; path))
+     while (plusp (length elem))
+     collect (directorify elem))
+  "A list of places to look for shell commands, as pathnames.")
 
-;; bin first
-(defvar *shell-search-paths* '((:absolute "bin")
-                               (:absolute "usr" "bin"))
-  "A list of places to look for shell commands.")
-
 (defvar *gnu-tar-program*
-  #-(or :netbsd :freebsd :solaris) "tar"
+  #-(or :netbsd :freebsd :solaris :win32 :mswindows) "tar"
   #+(or :netbsd :freebsd :solaris) "gtar"
+  #+(or :win32 :mswindows) "tar.exe"
   "Path to the GNU tar program")
 
 (eval-when (:compile-toplevel :load-toplevel :execute)