]> gitweb.factorcode.org Git - factor.git/blobdiff - unmaintained/4DNav/file-chooser/file-chooser.factor
Merge branch 'master' of git://factorcode.org/git/factor
[factor.git] / unmaintained / 4DNav / file-chooser / file-chooser.factor
index 2056b728d76e6c0dbc6a2db973bf29012e0fc3a1..d7c869ce2f8178da8a25f32efe5f2b4221b08606 100755 (executable)
@@ -45,18 +45,26 @@ TUPLE: file-chooser < track
     [ file-chooser? ] find-parent list>> ;\r
 \r
 file-chooser H{\r
-    { T{ key-down f f "UP" } [ find-file-list select-previous ] }\r
-    { T{ key-down f f "DOWN" } [ find-file-list select-next ] }\r
-    { T{ key-down f f "PAGE_UP" } [ find-file-list list-page-up ] }\r
-    { T{ key-down f f "PAGE_DOWN" } [ find-file-list list-page-down ] }\r
-    { T{ key-down f f "RET" } [ find-file-list invoke-value-action ] }\r
-    { T{ button-down } request-focus }\r
-    { T{ button-down f 1 } [ find-file-list invoke-value-action ]  }\r
+    { T{ key-down f f "UP" } \r
+        [ find-file-list select-previous ] }\r
+    { T{ key-down f f "DOWN" } \r
+        [ find-file-list select-next ] }\r
+    { T{ key-down f f "PAGE_UP" } \r
+        [ find-file-list list-page-up ] }\r
+    { T{ key-down f f "PAGE_DOWN" } \r
+        [ find-file-list list-page-down ] }\r
+    { T{ key-down f f "RET" } \r
+        [ find-file-list invoke-value-action ] }\r
+    { T{ button-down } \r
+        request-focus }\r
+    { T{ button-down f 1 } \r
+        [ find-file-list invoke-value-action ]  }\r
 } set-gestures\r
 \r
 : list-of-files ( file-chooser -- seq )\r
      [ path>> value>> directory-entries ] [ extension>> ] bi\r
-     '[ [ name>> _ [ tail? ] with contains? ] [ directory? ] bi or ]  filter\r
+     '[ [ name>> _ [ tail? ] with any? ] \r
+     [ directory? ] bi or ]  filter\r
 ;\r
 \r
 : update-filelist-model ( file-chooser -- file-chooser )\r
@@ -123,15 +131,19 @@ file-chooser H{
     dup <file-list> >>list\r
     "choose a file in directory " <label> f track-add\r
     dup path>> <label-control> f track-add\r
-    dup extension>> ", " join "limited to : " prepend <label> f track-add\r
+    dup extension>> ", " join "limited to : " prepend \r
+        <label> f track-add\r
     <shelf> \r
         "selected file : " <label> add-gadget\r
         over selected-file>> <label-control> add-gadget\r
     f track-add\r
     <shelf> \r
-        over [  swap fc-go-parent ] curry  "go up" swap <bevel-button> add-gadget\r
-        over [  swap fc-go-home ] curry  "go home" swap <bevel-button> add-gadget\r
-    !    over [ swap fc-ok-action ] curry "OK" swap <bevel-button> add-gadget\r
+        over [  swap fc-go-parent ] curry  "go up" \r
+            swap <bevel-button> add-gadget\r
+        over [  swap fc-go-home ] curry  "go home" \r
+            swap <bevel-button> add-gadget\r
+    !    over [ swap fc-ok-action ] curry "OK" \r
+    !    swap <bevel-button> add-gadget\r
     !    [ drop ]  "Cancel" swap <bevel-button> add-gadget\r
     f track-add\r
     dup list>> <scroller> 1 track-add\r
@@ -140,5 +152,6 @@ file-chooser H{
 M: file-chooser pref-dim* drop { 400 200 } ;\r
 \r
 : file-chooser-window ( -- )\r
-[ . ] home { "xml" "txt" }   <file-chooser> "Choose a file" open-window ;\r
+    [ . ] home { "xml" "txt" }   <file-chooser> \r
+    "Choose a file" open-window ;\r
 \r