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

mhenoch at common-lisp.net mhenoch at common-lisp.net
Fri Aug 24 17:25:20 UTC 2007


Author: mhenoch
Date: Fri Aug 24 13:25:20 2007
New Revision: 131

Modified:
   cl-darcs/trunk/pending.lisp
Log:
Use ENOUGH-NAMESTRING to permit more user convenience in ADD-FILE


Modified: cl-darcs/trunk/pending.lisp
==============================================================================
--- cl-darcs/trunk/pending.lisp	(original)
+++ cl-darcs/trunk/pending.lisp	Fri Aug 24 13:25:20 2007
@@ -42,18 +42,13 @@
 FILE can be a string or a pathname denoting a relative path.
 FILE can be either a file or a directory."
   (setf repo (fad:pathname-as-directory repo))
-  (let (type)
-    (if (pathnamep file)
-	(progn
-	  (unless (pathname-sane-p file)
-	    (error "~A is not a relative pathname going strictly down." file))
-	  (setf type (if (fad:directory-pathname-p file) :directory :file)))
-	(progn
-	  (setf type (if (fad:directory-exists-p 
-			  (fad:pathname-as-directory (merge-pathnames file repo)))
-			 :directory 
-			 :file))
-	  (setf file (sanitize-filename file :type type))))
+  (setf file (enough-namestring file repo))
+  (let ((type
+	 (if (fad:directory-exists-p 
+	      (fad:pathname-as-directory (merge-pathnames file repo)))
+	     :directory 
+	     :file)))
+    (setf file (sanitize-filename file :type type))
 
     (let ((pristine-file (merge-pathnames file (upath-subdir repo '("_darcs" "pristine"))))
 	  (working-file (merge-pathnames file repo)))
@@ -71,4 +66,4 @@
      repo 
      (if (eql type :file)
 	 (make-instance 'add-file-patch :filename file)
-	 (make-instance 'add-dir-patch :directory file)))))
+	 (make-instance 'add-dir-patch :directory file)))))
\ No newline at end of file



More information about the Cl-darcs-cvs mailing list