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))