Author: mhenoch Date: Wed Mar 5 04:17:09 2008 New Revision: 172 Modified: cl-darcs/trunk/cmdline.lisp Log: Add WITH-REPO and use it for "add". Modified: cl-darcs/trunk/cmdline.lisp ============================================================================== --- cl-darcs/trunk/cmdline.lisp (original) +++ cl-darcs/trunk/cmdline.lisp Wed Mar 5 04:17:09 2008 @@ -100,6 +100,13 @@ (destructuring-bind ,operands ,operands-sym ,@body)))))))) +(defparameter opt-repodir + (make-option + :keyword :repodir + :long "repodir" + :arg "DIRECTORY" + :help "Use DIRECTORY instead of current directory")) + (defun find-repo (&optional (dir *default-pathname-defaults*)) "Find repository in current directory or above. Signal an error if there is none, else return the repository root. @@ -114,16 +121,39 @@ (find-repo parent-dir) (error "Not in a darcs repo."))))) -(define-darcs-command add () (&rest files-and-dirs) +(defmacro with-repo (repodir &body body) + "Given a --repodir argument, canonicalize it and change directory accordingly. +That is, if there is no --repodir option, don't change current directory, +and bind variable to the repository root directory. +If there is a --repodir option, ensure it refers to an existing directory, +and change the current directory to it. +\(This is actually how the original darcs does it.\)" + (let ((original-repodir (gensym))) + `(let* ((,original-repodir ,repodir) + (,repodir + (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 ,original-repodir) + *default-pathname-defaults* + (fad:pathname-as-directory ,repodir)))) + ,@body))) + +(define-darcs-command add (repodir) (&rest files-and-dirs + &aux already-there) "Add files and directories for later recording. Usage: darcs add FILE ..." - (let ((repo (find-repo)) - already-there) + (with-repo repodir (dolist (file files-and-dirs) (handler-case (progn - (add-file repo file) + (add-file repodir file) ;; (format t "~&Added ~A" file) ) (already-in-repository (c) @@ -132,7 +162,7 @@ (push (slot-value c 'file) already-there)))) (when already-there (setf already-there (nreverse already-there)) - (let* ((with-path (mapcar (lambda (f) (merge-pathnames f repo)) already-there)) + (let* ((with-path (mapcar (lambda (f) (merge-pathnames f repodir)) already-there)) (nfiles 0) (ndirs 0)) (dolist (f with-path) @@ -166,13 +196,6 @@ Usage: darcs whatsnew" (diff-repo-display (find-repo))) -(defparameter opt-repodir - (make-option - :keyword :repodir - :long "repodir" - :arg "DIRECTORY" - :help "Use DIRECTORY instead of current directory")) - (define-darcs-command init (repodir) () "Initialize a darcs repository in the current directory.