[Cl-darcs-cvs] r182 - cl-darcs/trunk

mhenoch at common-lisp.net mhenoch at common-lisp.net
Tue Apr 1 21:34:11 UTC 2008


Author: mhenoch
Date: Tue Apr  1 16:34:10 2008
New Revision: 182

Modified:
   cl-darcs/trunk/get.lisp
   cl-darcs/trunk/upath.lisp
Log:
Add TRUENAME argument to UPATH-TO-STRING, and use it in GET-REPO


Modified: cl-darcs/trunk/get.lisp
==============================================================================
--- cl-darcs/trunk/get.lisp	(original)
+++ cl-darcs/trunk/get.lisp	Tue Apr  1 16:34:10 2008
@@ -49,7 +49,7 @@
     ;; Create directories...
     (ensure-directories-exist outname)
     (prepare-new-repo outname)
-    (set-default-repo outname inrepodir)
+    (set-default-repo outname (upath-to-string inrepodir) :truename t)
 
     (when checkpoint
       (format t "~&Copying checkpoint...")

Modified: cl-darcs/trunk/upath.lisp
==============================================================================
--- cl-darcs/trunk/upath.lisp	(original)
+++ cl-darcs/trunk/upath.lisp	Tue Apr  1 16:34:10 2008
@@ -83,14 +83,17 @@
      (open upath :direction :input :if-does-not-exist :error
 	   :element-type (if binary '(unsigned-byte 8) 'character)))))
 
-(defun upath-to-string (upath)
+(defun upath-to-string (upath &key truename)
   "Convert UPATH to a string.
-This string can be read with MAKE-UPATH."
+This string can be read with MAKE-UPATH.
+When TRUENAME is provided and true, give absolute/canonical form."
   (ctypecase upath
     (string
      upath)
     (pathname
-     (namestring upath))
+     (namestring (if truename
+		     (truename upath)
+		     upath)))
     (net.uri:uri
      (with-output-to-string (s)
        (net.uri:render-uri upath s)))))



More information about the Cl-darcs-cvs mailing list