[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