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

[mhenoch at common-lisp.net]

Author: mhenoch
Date: Wed Mar  5 02:36:57 2008
New Revision: 162

Modified:
   cl-darcs/trunk/cmdline.lisp
Log:
FIND-REPO finds repository in parent directories too


Modified: cl-darcs/trunk/cmdline.lisp
==============================================================================
--- cl-darcs/trunk/cmdline.lisp	(original)
+++ cl-darcs/trunk/cmdline.lisp	Wed Mar  5 02:36:57 2008
@@ -105,12 +105,19 @@
 		    (destructuring-bind ,operands ,operands-sym
 		      , at body))))))))
 
-(defun find-repo ()
-  "Find repository in current directory.
-Signal an error if there is none."
-  (unless (fad:directory-exists-p (upath-subdir *default-pathname-defaults* '("_darcs")))
-    (error "Not in a darcs repo."))
-  *default-pathname-defaults*)
+(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.
+If DIR is specified, search for repository there instead."
+  (if (fad:directory-exists-p (upath-subdir dir '("_darcs")))
+      dir
+      (let ((parent-dir (ignore-errors
+			  (merge-pathnames 
+			   (make-pathname :directory '(:relative :up))
+			   dir))))
+	(if parent-dir
+	    (find-repo parent-dir)
+	    (error "Not in a darcs repo.")))))
 
 (define-darcs-command add () (&rest files-and-dirs)
   "Add files and directories for later recording.