[osicat-cvs] CVS update: src/osicat.asd src/osicat.lisp src/version.txt

[Nikodemus Siivola]

Update of /project/osicat/cvsroot/src
In directory common-lisp.net:/tmp/cvs-serv19018

Modified Files:
	osicat.asd osicat.lisp version.txt 
Log Message:

* Better handling of returned directory entries in WITH-DIRECTORY-ITERATOR. This also let's use be rid of ESCAPE-WILD-NAME which was unportable.
* Incremented version number to 0.4.0 in preparation for release.

Date: Sun Apr 25 07:02:24 2004
Author: nsiivola

Index: src/osicat.asd
diff -u src/osicat.asd:1.7 src/osicat.asd:1.8
--- src/osicat.asd:1.7	Fri Mar  5 13:34:54 2004
+++ src/osicat.asd	Sun Apr 25 07:02:24 2004
@@ -69,7 +69,7 @@
 ;;;; SYSTEM
 
 (defsystem :osicat
-    :version "0.3.6"
+    :version "0.4.0"
     :depends-on (:uffi)
     :components
     ((:c-source-file "osicat-glue")


Index: src/osicat.lisp
diff -u src/osicat.lisp:1.20 src/osicat.lisp:1.21
--- src/osicat.lisp:1.20	Sat Apr 24 12:40:02 2004
+++ src/osicat.lisp	Sun Apr 25 07:02:24 2004
@@ -82,15 +82,6 @@
 	    tmp))
       pathspec))
 
-(defun escape-wild-name (name)
-  (declare (simple-string name))
-  (let (stack)
-    (loop for char across name
-	  when (member char '(#\* #\[))
-	  do (push #\\ stack)
-	  do (push char stack))
-    (coerce (nreverse stack) 'simple-string)))
-
 (defun unmerge-pathnames
     (pathspec &optional (known *default-pathname-defaults*))
   (let* ((dir (pathname-directory pathspec))
@@ -142,21 +133,24 @@
 (defmacro with-directory-iterator ((iterator pathspec) &body body)
   "macro WITH-DIRECTORY-ITERATOR (iterator pathspec) &body forms => value
 
-The directory designated by pathspec is then bound to 
-*default-pathname-defaults* for the dynamic scope of the body.
+Pathspec must be a valid directory designator:
+*default-pathname-defaults* is bound, and (current-directory) is set
+to the designated directory for the dynamic scope of the body.
 
 Within the lexical scope of the body, iterator is defined via macrolet
 such that successive invocations of (iterator) return the directory
 entries, one by one. Both files and directories are returned, except
 '.' and '..'. The order of entries is not guaranteed. The entries are
-returned as relative pathnames against the directory. Entries that are
-symbolic links are not resolved. Once all entries have been returned, 
-further invocations of (iterator) will all return NIL.
+returned as relative pathnames against the designated
+directory. Entries that are symbolic links are not resolved. Once all
+entries have been returned, further invocations of (iterator) will all
+return NIL.
 
 The value returned is the value of the last form evaluated in
 body. Signals an error if pathspec is wild or does not designate a directory."
-  (with-unique-names (dp dir cdir one-iter)
-    `(let ((,dir (normpath ,pathspec t)))
+  (with-unique-names (dp dir cdir old-dir one-iter)
+    `(let ((,dir (normpath ,pathspec t))
+	   (,old-dir (current-directory)))
        (with-c-file (,cdir ,dir :directory t)
 	 (let (,dp)
 	   (unwind-protect
@@ -164,24 +158,36 @@
 			   (let ((entry (readdir ,dp)))
 			     (if (null-pointer-p entry)
 				 nil
-				 (let ((string
-					(convert-from-cstring
-					 (osicat-dirent-name entry))))
-				   (if (member string '("." "..") 
-					       :test #'string=)
-				       (,one-iter)
-				       (normpath (escape-wild-name string))))))))
+				 (let* ((cname (osicat-dirent-name entry))
+					(name (convert-from-cstring cname)))
+				   (declare (type simple-string name))
+				   (cond 
+				     ((member name '("." "..") :test #'string=)
+				      (,one-iter))
+				     ((eq :directory (c-file-kind cname t))
+				      (make-pathname
+				       :directory `(:relative ,name)))
+				     (t
+				      (let ((dotpos (position #\. name)))
+					(if (and dotpos (plusp dotpos))
+					    (make-pathname
+					     :name (subseq name 0 dotpos)
+					     :type (subseq name (1+ dotpos)))
+					    (make-pathname
+					     :name name))))))))))
 		  (macrolet ((,iterator () 
 			       `(,',one-iter)))
 		    (setf ,dp (opendir ,cdir))
 		    (when (null-pointer-p ,dp)
 		      (error "Error opening directory ~S." ,dir))
 		    (let ((*default-pathname-defaults* ,dir))
+		      (setf (current-directory) ,dir)
 		      , at body)))
 	     (when ,dp
 	       (if (zerop (closedir ,dp))
 		   nil
-		   (error "Error closing directory ~S." ,dir)))))))))
+		   (error "Error closing directory ~S." ,dir)))
+	     (setf (current-directory) ,old-dir)))))))
 
 (defun mapdir (function pathspec)
   "function MAPDIR function pathspec => list


Index: src/version.txt
diff -u src/version.txt:1.9 src/version.txt:1.10
--- src/version.txt:1.9	Fri Mar  5 13:34:54 2004
+++ src/version.txt	Sun Apr 25 07:02:24 2004
@@ -1 +1 @@
-0.3.6
+0.4.0