From 5f0855c5c25c59a59d67a4335df47f311f6dbe93 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Sun, 14 Feb 2010 11:49:33 -0800 Subject: [PATCH] globs: add "glob-parent-directory" word that returns the deepest level of a path without glob symbols --- basis/globs/globs-tests.factor | 18 +++++++++++++++++- basis/globs/globs.factor | 7 +++++++ 2 files changed, 24 insertions(+), 1 deletion(-) diff --git a/basis/globs/globs-tests.factor b/basis/globs/globs-tests.factor index eceb6bab7b..c9903b1633 100644 --- a/basis/globs/globs-tests.factor +++ b/basis/globs/globs-tests.factor @@ -1,4 +1,4 @@ -USING: tools.test globs io.pathnames ; +USING: arrays tools.test globs io.pathnames sequences ; IN: globs.tests [ f ] [ "abd" "fdf" glob-matches? ] unit-test @@ -22,3 +22,19 @@ IN: globs.tests [ t ] [ "foo" "bar" append-path "*" "*" append-path glob-matches? ] unit-test [ f ] [ "foo" "bar" append-path "foo?bar" glob-matches? ] unit-test [ t ] [ "foo" "bar" append-path "fo?" "bar" append-path glob-matches? ] unit-test + +[ f ] [ "foo" glob-pattern? ] unit-test +[ t ] [ "fo?" glob-pattern? ] unit-test +[ t ] [ "fo*" glob-pattern? ] unit-test +[ t ] [ "fo[mno]" glob-pattern? ] unit-test +[ t ] [ "fo\\*" glob-pattern? ] unit-test +[ t ] [ "fo{o,bro}" glob-pattern? ] unit-test + +"foo" "bar" append-path 1array +[ { "foo" "bar" "ba?" } path-separator join glob-parent-directory ] unit-test + +[ "foo" ] +[ { "foo" "b?r" "bas" } path-separator join glob-parent-directory ] unit-test + +[ "" ] +[ { "f*" "bar" "bas" } path-separator join glob-parent-directory ] unit-test diff --git a/basis/globs/globs.factor b/basis/globs/globs.factor index 47c8fca528..72b686c3b1 100644 --- a/basis/globs/globs.factor +++ b/basis/globs/globs.factor @@ -43,3 +43,10 @@ Main = Concatenation End : glob-matches? ( input glob -- ? ) [ >case-fold ] bi@ matches? ; + +: glob-pattern? ( string -- ? ) + [ "\\*?[{" member? ] any? ; + +: glob-parent-directory ( glob -- parent-directory ) + path-components dup [ glob-pattern? ] find drop head + path-separator join ;