[climacs-cvs] CVS update: climacs/gui.lisp

[Aleksandar Bakic]

Update of /project/climacs/cvsroot/climacs
In directory common-lisp.net:/tmp/cvs-serv29990

Modified Files:
	gui.lisp 
Log Message:
Contribution by John Q. Splittist: Made Find File more portable by
copying some code from cl-fad.

Date: Tue May  3 22:45:17 2005
Author: abakic

Index: climacs/gui.lisp
diff -u climacs/gui.lisp:1.128 climacs/gui.lisp:1.129
--- climacs/gui.lisp:1.128	Sat Mar 19 23:08:31 2005
+++ climacs/gui.lisp	Tue May  3 22:45:17 2005
@@ -621,12 +621,18 @@
 	   (full-so-far (concatenate 'string directory-prefix so-far))
 	   (pathnames
 	    (loop with length = (length full-so-far)
-		  for path in (directory (concatenate 'string
-						       (remove-trail so-far)
-						      "*.*"))
-		  when (let ((mismatch (mismatch (namestring path) full-so-far)))
-			 (or (null mismatch) (= mismatch length)))
-		    collect path))
+	       and wildcard = (concatenate 'string (remove-trail so-far) "*.*")
+	       for path in
+		 #+(or sbcl cmu lispworks) (directory wildcard)
+		 #+openmcl (directory wildcard :directories t)
+		 #+allegro (directory wildcard :directories-are-files nil)
+		 #+cormanlisp (nconc (directory wildcard)
+				      (cl::directory-subdirs dirname))
+		 #-(or sbcl cmu lispworks openmcl allegro cormanlisp)
+		 (directory wildcard)
+	       when (let ((mismatch (mismatch (namestring path) full-so-far)))
+		      (or (null mismatch) (= mismatch length)))
+	       collect path))
 	   (strings (mapcar #'namestring pathnames))
 	   (first-string (car strings))
 	   (length-common-prefix nil)