Megatest

path-glob.scm at tip
Login

File path-glob/path-glob.scm from the latest check-in


(define (multi-glob pathspec)
  (let* ((path-parts (intersperse (string-split pathspec "/" #t) "/")))
    (print "path-parts: " path-parts)
    (if (null? path-parts)
	'()
	(let loop ((parts  (cdr path-parts))
		   (result (let ((p (car path-parts)))
			     (if (string=? p "")
				 '("")
				 (glob (car path-parts))))))
	  (if (null? parts)
	      result
	      (let* ((part (car parts))
		     (rem  (cdr parts)))
		(loop rem
		      (apply append
			     (map (lambda (curr)
				    (let ((new (string-append curr part)))
				      (print "new: " new " part: " part)
				      (cond
				       ((and (directory? curr)(file-read-access? curr))
					(glob new))
				       ((member part '("." ".." "/")) (list new part))
				       (else '()))))
				  result)))))))))

;; alternative implementation

(define (path-glob pattern)
  (let ((parts (string-split pattern "/" '())))
    (if (null? parts)
       '()
       (glob-expand (car parts) (cdr parts))
    )))

(define (glob-expand pattern #!optional (rest '()))
  (let ((result  '())
	(expanded (glob pattern)))
    (apply append result (cond
			  ((null? expanded) (list '()))
			  ((null? rest)     (list expanded))
			  (else (map (lambda (x)
				       (if (directory? x)
					   (glob-expand (conc x "/" (car rest)) (cdr rest))
					   '()))
				     expanded))))))