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

[mhenoch at common-lisp.net]

Author: mhenoch
Date: Tue Apr  1 17:01:29 2008
New Revision: 186

Modified:
   cl-darcs/trunk/cmdline.lisp
Log:
"darcs get"


Modified: cl-darcs/trunk/cmdline.lisp
==============================================================================
--- cl-darcs/trunk/cmdline.lisp	(original)
+++ cl-darcs/trunk/cmdline.lisp	Tue Apr  1 17:01:29 2008
@@ -324,6 +324,33 @@
 
     ;; Change the default repository.
     (when (first from-repositories)
-      (set-default-repo ourrepo (upath-to-string (first from-repositories))))
+      (set-default-repo ourrepo (upath-to-string (first from-repositories) :truename t)))
 
     0))
+
+(define-darcs-command get
+    (repodir)
+  (from)
+  "Get a copy of a repository."
+  (setf from (make-upath from))
+  (let* ((to (or 
+	      ;; Either there is an explicit repodir...
+	      repodir
+	      ;; ...or we make one relative to the current directory.
+	      (make-pathname
+	       :directory
+	       (list :relative
+		     (typecase from
+		       ;; If we have a local pathname, use the last component.
+		       (pathname
+			(or (pathname-name pathname)
+			    (car (last (pathname-directory pathname)))))
+		       ;; Otherwise, use the part from the last slash.
+		       (t
+			(let* ((s (upath-to-string from))
+			       (last-slash (position #\/ s :from-end t)))
+			  (if last-slash
+			      (subseq s (1+ last-slash))
+			      s)))))))))
+    (get-repo from to))
+  0)