Re: [j-devel] some pathname wildcard code

[Russell M. <rus...@ya...>]

The code I wrote works ok at least for the case that I posted in my original report.
You could just give it a try!  I promise it will not erase your hard disk. ;-)

I did not intend to fully replace the code in pathnames.lisp, but rather to illustrate one approach
to a fuller fix.  I am not sure that I understand the overall structure of abcl to replace system
level code.


-russ


----- Original Message ----
> From: XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
> To: Russell McManus <rus...@ya...>
> Cc: arm...@li...
> Sent: Friday, August 15, 2008 12:46:25 AM
> Subject: Re: [j-devel] some pathname wildcard code
> 
> On Thu, Aug 14, 2008 at 7:55 PM, Russell McManus
> wrote:
> >
> > Something like the following might be useful in implementing support
> > for wild pathnames in DIRECTORY in abcl.
> >
> > One issue that I aware of but did not address is that I used
> > STRING-EQUAL in a couple of places that might be incorrect on Windows
> > and/or OSX.
> 
> Hi!
> 
> I'm about to step onto a flight, but let me take a minute to say
> thanks for the contribution! When having a cursory look at
> pathnames.lisp, I think to see some of the code that you wrote down
> here too. I didn't look at your code long enough though to find out
> whether it solves the "wild parents" problem: the fact that the path
> we're looking at can't itself contain wildcard patterns (or at least,
> that's the bug).
> 
> Bye,
> 
> Erik.
> 
> > -russ
> >
> >
> > (defpackage :abcl-hacks
> >  (:use :common-lisp :java))
> >
> > (in-package :abcl-hacks)
> >
> > (defun make-name-and-type-matcher (pathname)
> >  (let ((name1 (pathname-name pathname))
> >        (type1 (pathname-type pathname)))
> >    (flet ((to-string (jstring)
> >             (jcall (jmethod (jclass "java.lang.String") "toString") jstring))
> >           (split-path-and-type (s)
> >             (let ((dot-pos (position #\. s)))
> >               (if dot-pos
> >                   (values (subseq s 0 dot-pos) (subseq s (1+ dot-pos)))
> >                   (values s "")))))
> >      (cond ((and (eql :wild name1)
> >                  (eql :wild type1))
> >             (lambda (jstring)
> >               (declare (ignore jstring))
> >               t))
> >            ((eql :wild name1)
> >             (lambda (jstring)
> >               (multiple-value-bind (name2 type2)
> >                   (split-path-and-type (to-string jstring))
> >                 (string-equal type1 type2))))
> >            ((eql :wild type1)
> >             (lambda (jstring)
> >               (multiple-value-bind (name2 type2)
> >                   (split-path-and-type (to-string jstring))
> >                 (string-equal name1 name2))))
> >            (t
> >             (lambda (jstring)
> >               (multiple-value-bind (name2 type2)
> >                   (split-path-and-type (to-string jstring))
> >                 (and
> >                  (string-equal type1 type2)
> >                  (string-equal name1 name2)))))))))
> >
> > (defun find-matching-files (pathname)
> >  (let ((jfile-class (jclass "java.io.File"))
> >        (name-and-type-matcher (make-name-and-type-matcher pathname))
> >        (matches nil))
> >    (flet ((make-child (jfile child)
> >             (jnew (jconstructor jfile-class "java.io.File" "java.lang.String")
> >                   jfile child))
> >           (is-dir (jfile)
> >             (jcall (jmethod jfile-class "isDirectory") jfile))
> >           (is-file (jfile)
> >             (jcall (jmethod jfile-class "isFile") jfile))
> >           (children (jfile)
> >             (jcall (jmethod jfile-class "list") jfile)))
> >      (labels ((traverse (left-jfile subdirs)
> >                 (cond ((null subdirs)
> >                        (loop for jstring across (children left-jfile)
> >                             when (and (is-file (make-child left-jfile 
> jstring))
> >                                       (funcall name-and-type-matcher jstring))
> >                             do (push (make-child left-jfile jstring) 
> matches)))
> >                       ((eql :wild (car subdirs))
> >                        (let ((children (loop for jstring across (children 
> left-jfile)
> >                                           collect (make-child left-jfile 
> jstring))))
> >                          (mapc (lambda (child) (traverse child (cdr subdirs)))
> >                                (remove-if-not #'is-dir children))))
> >                       (t (traverse (make-child left-jfile (car subdirs))
> >                                    (cdr subdirs))))))
> >        (traverse (jnew (jconstructor jfile-class "java.lang.String")
> >                        (namestring (make-pathname :defaults pathname
> >                                                   :directory (list :absolute)
> >                                                   :name nil
> >                                                   :type nil)))
> >                  (cdr (pathname-directory pathname)))
> >        (mapcar (lambda (jfile)
> >                  (parse-namestring
> >                   (jcall (jmethod jfile-class "toString") jfile)))
> >                matches)))))
> >
> > -------------------------------------------------------------------------
> > This SF.Net email is sponsored by the Moblin Your Move Developer's challenge
> > Build the coolest Linux based applications with Moblin SDK & win great prizes
> > Grand prize is a trip for two to an Open Source event anywhere in the world
> > http://moblin-contest.org/redirect.php?banner_id=100&url=/
> > _______________________________________________
> > armedbear-j-devel mailing list
> > arm...@li...
> > https://lists.sourceforge.net/lists/listinfo/armedbear-j-devel
> >