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

[mhenoch at common-lisp.net]

Author: mhenoch
Date: Wed Mar  5 04:01:41 2008
New Revision: 171

Modified:
   cl-darcs/trunk/cmdline.lisp
Log:
Implement "pull" command.  Remove obsolete handler case.


Modified: cl-darcs/trunk/cmdline.lisp
==============================================================================
--- cl-darcs/trunk/cmdline.lisp	(original)
+++ cl-darcs/trunk/cmdline.lisp	Wed Mar  5 04:01:41 2008
@@ -49,11 +49,6 @@
 		  (progn
 		    (warn "~A didn't give a proper exit code." command)
 		    0)))
-	  ;; Catch wrong number of arguments
-	  (program-error (c)
-	    (format *error-output* "~&Program error: ~A" c)
-	    (command-usage command)
-	    1)
 	  (invalid-arguments (c)
 	    (with-accessors ((ctrl simple-condition-format-control)
 			     (args simple-condition-format-arguments)) c
@@ -262,3 +257,39 @@
 	(format t "~&Finished recording patch '~A'~%" patch-name)
 	0))))
 
+(define-darcs-command pull
+    (all-patches repodir)
+  (&rest from-repositories)
+  "Copy and apply patches from another repository to this one."
+  (let* ((ourrepo
+	  (if repodir
+	      (or (fad:directory-exists-p repodir)
+		  (error "Directory ~A does not exist." repodir))
+	      (find-repo)))
+	 ;; If explicit --repodir argument was specified, change directory.
+	 ;; Otherwise, leave it, even if the actual repository is in a
+	 ;; parent directory.
+	 (*default-pathname-defaults* 
+	  (if (null repodir)
+	      *default-pathname-defaults*
+	      (fad:pathname-as-directory ourrepo))))
+
+    (if from-repositories
+	;; Get truename for all repositories, if they are local paths.
+	(map-into 
+	 from-repositories
+	 (lambda (dir)
+	   (setf dir (make-upath dir))
+	   (when (typep dir 'pathname)
+	     (setf dir (or
+			(fad:directory-exists-p dir)
+			(error "Directory ~A does not exist." dir))))
+	   dir)
+	 from-repositories)
+	;; If no remote repository specified, use the default one.
+	(setf from-repositories (list nil)))
+
+    (dolist (theirrepo from-repositories)
+      (pull ourrepo theirrepo :select-patches (if all-patches :all :ask)))
+
+    0))