Assorted fixes

TODO.FACTOR.txt

@@ -12,6 +12,7 @@
 - minibuffer should show a title
 - clean up listener's minibuffer-related code
 - help search looks funny
+- list action: if nothing selected, don't NPE
 
 + ui:
 

library/io/files.factor

@@ -37,6 +37,8 @@ TUPLE: pathname string ;
 : (file.) ( name path -- )
     <pathname> write-object ;
 
+: path. ( path -- ) dup (file.) ;
+
 DEFER: directory.
 
 : (directory.) ( name path -- )

library/syntax/parse-stream.factor

@@ -64,7 +64,7 @@ SYMBOL: parse-hook
     ] with-scope ;
 
 : parsing-file ( file -- )
-    "Loading " write dup (file.) terpri flush ;
+    "Loading " write path. terpri flush ;
 
 : record-file ( file -- )
     [ <source-file> ] keep source-files get set-hash ;

library/test/tools.factor

@@ -1,5 +1,6 @@
 IN: temporary
-USING: tools ;
+USING: tools completion words sequences test ;
 
 [ ] [ "" apropos ] unit-test
 [ ] [ "swp" apropos ] unit-test
+[ f ] [ "swp" all-words word-completions empty? ] unit-test

library/tools/completion.factor

@@ -51,8 +51,8 @@ USING: kernel arrays sequences math namespaces strings io ;
 : rank-completions ( results -- newresults )
     #! Discard results in the low 33%
     [ [ second ] 2apply swap - ] sort
-    [ 0 [ second max ] reduce ] keep
-    [ second swap > ] subset-with ;
+    [ 0 [ second max ] reduce 3 / ] keep
+    [ second < ] subset-with ;
 
 : completion ( str quot obj -- pair )
     #! pair is { obj score }
@@ -65,7 +65,7 @@ USING: kernel arrays sequences math namespaces strings io ;
         [ >r 2dup r> completion ] map 2nip rank-completions
     ] if ; inline
 
-: completion>string ( score str -- )
+: completion>string ( score str -- newstr )
     [ % " (score: " % >fixnum # ")" % ] "" make ;
 
 : string-completions ( str strs -- seq )

library/tools/test.factor

@@ -60,7 +60,7 @@ SYMBOL: failures
 
 : failed.
     "Tests failed:" print
-    failures get [ first2 swap write ": " write error. ] each ;
+    failures get [ first2 swap path. ": " write error. ] each ;
 
 : run-tests ( seq -- )
     prepare-tests [ run-test ] subset terpri passed. failed. ;

library/ui/test/panes.factor

@@ -12,7 +12,7 @@ sequences io test prettyprint ;
 
     #children "num-children" set
     
-    "pane" get [ 10000 [ . ] each ] with-stream*
+    "pane" get <pane-stream> [ 10000 [ . ] each ] with-stream*
     
     [ t ] [ #children "num-children" get = ] unit-test
 ] maybe-with-freetype

library/ui/test/search.factor

@@ -1,6 +1,20 @@
 IN: temporary
-USING: gadgets-search io test ;
+USING: gadgets-search io test namespaces gadgets 
+sequences ;
 
 [ "hey man (score: 123)" ]
-[ [ { "hey man" 123 } file-completion. ] string-out ]
+[
+    [
+        { "hey man" 123 } [ <pathname> ] string-completion.
+    ] string-out
+] unit-test
+
+"set-word-prop" [ ] <word-search> "search" set
+"search" get graft*
+
+[ f ]
+[ "search" get live-search-list control-value empty? ]
 unit-test
+
+"search" get ungraft*
+

library/ui/tools/listener.factor

@@ -8,10 +8,9 @@ generic hashtables tools io kernel listener math models
 namespaces parser prettyprint sequences shells strings styles
 threads words definitions ;
 
-TUPLE: listener-gadget input output stack minibuffer use ;
+TUPLE: listener-gadget input output stack minibuffer ;
 
 : ui-listener-hook ( listener -- )
-    use get over set-listener-gadget-use
     >r datastack r> listener-gadget-stack set-model ;
 
 : listener-stream ( listener -- stream )

library/ui/tools/operations.factor

@@ -57,13 +57,13 @@ M: operation invoke-command ( target operation -- )
 [ pathname? ] H{
     { +mouse+ T{ button-up f f 1 } }
     { +name+ "Edit" }
-    { +quot+ [ edit-file ] }
+    { +quot+ [ pathname-string edit-file ] }
 } define-operation
 
 [ pathname? ] H{
     { +mouse+ T{ button-up f f 2 } }
     { +name+ "Run file" }
-    { +quot+ [ listener-gadget call-tool ] }
+    { +quot+ [ pathname-string [ run-file ] curry call-listener ] }
 } define-operation
 
 ! Words
@@ -126,13 +126,13 @@ M: operation invoke-command ( target operation -- )
 [ vocab-link? ] H{
     { +mouse+ T{ button-up f f 2 } }
     { +name+ "Enter in" }
-    { +quot+ [ [ in set ] curry call-listener ] }
+    { +quot+ [ vocab-link-name [ set-in ] curry call-listener ] }
 } define-operation
 
 [ vocab-link? ] H{
     { +mouse+ T{ button-up f f 3 } }
     { +name+ "Use" }
-    { +quot+ [ [ use+ ] curry call-listener ] }
+    { +quot+ [ vocab-link-name [ use+ ] curry call-listener ] }
 } define-operation
 
 ! Link

library/ui/tools/search.factor

@@ -7,7 +7,7 @@ generic help tools kernel models sequences words
 gadgets-borders gadgets-lists namespaces parser hashtables io
 completion styles ;
 
-TUPLE: live-search field list model producer action presenter ;
+TUPLE: live-search field list producer action presenter ;
 
 : find-live-search [ live-search? ] find-parent ;
 
@@ -71,7 +71,7 @@ M: live-search focusable-child* live-search-field ;
     <live-search> ;
 
 : string-completion. ( pair quot -- )
-    >r first2 over completion>string swap r> write-object ;
+    >r first2 over completion>string swap r> call write-object ;
     inline
 
 : <source-files-search> ( string action -- gadget )