Slider fix, rename path. to write-path

TODO.FACTOR.txt

@@ -12,7 +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
+- parse errors: clickable pathnames
 
 + ui:
 

library/io/files.factor

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

library/syntax/parse-stream.factor

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

library/test/kernel.factor

@@ -1,6 +1,6 @@
 IN: scratchpad
 USING: kernel kernel-internals math memory namespaces sequences
-test ;
+test errors ;
 
 [ 0 ] [ f size ] unit-test
 [ t ] [ [ \ = \ = ] all-equal? ] unit-test
@@ -14,3 +14,7 @@ test ;
 [ [ 3 ] ] [ 3 f curry ] unit-test
 [ [ \ + ] ] [ \ + f curry ] unit-test
 [ [ \ + = ] ] [ \ + [ = ] curry ] unit-test
+
+! Make sure we report the correct error on stack underflow
+[ { kernel-error 11 f f } ]
+[ [ clear drop ] catch ] unit-test

library/tools/errors.factor

@@ -138,7 +138,9 @@ M: no-word summary
 
 : parse-dump ( error -- )
     "Parsing " write
-    dup parse-error-file [ "<interactive>" ] unless* write
+    dup parse-error-file
+    [ "<interactive>" ] unless*
+    write-pathname
     ":" write
     dup parse-error-line [ 1 ] unless* number>string print
     

library/tools/test.factor

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

library/ui/gadgets/lists.factor

@@ -38,17 +38,15 @@ M: list draw-gadget*
 M: list focusable-child* drop t ;
 
 : list-value ( list -- object )
-    dup control-value empty? [
-        drop f
-    ] [
-        dup list-index swap control-value nth
-    ] if ;
+    dup list-index swap control-value ?nth ;
 
 : scroll>selected ( list -- )
     dup selected-rect swap scroll>rect ;
 
+: list-empty? ( list -- ? ) control-value empty? ;
+
 : select-index ( n list -- )
-    dup control-value empty? [
+    dup list-empty? [
         2drop
     ] [
         [ control-value length rem ] keep
@@ -64,7 +62,9 @@ M: list focusable-child* drop t ;
     dup list-index 1+ swap select-index ;
 
 : call-action ( list -- )
-    dup list-value swap list-action call ;
+    dup list-empty? [
+        dup list-value over list-action call
+    ] unless drop ;
 
 list H{
     { T{ button-down } [ request-focus ] }

library/ui/gadgets/sliders.factor

@@ -83,11 +83,16 @@ C: thumb ( vector -- thumb )
 : slide-by-page ( -1/1 gadget -- )
     [ slider-page * ] keep slide-by ;
 
-: elevator-click ( elevator -- )
-    dup hand-click-rel >r find-slider r>
+: page-direction ( elevator -- -1/1 )
+    dup find-slider swap hand-click-rel
     over gadget-orientation v.
-    over screen>slider over slider-value - sgn
-    [ swap slide-by-page ] curry start-timer-gadget ;
+    over screen>slider
+    swap slider-value - sgn ;
+
+: elevator-click ( elevator -- )
+    dup page-direction
+    [ swap find-slider slide-by-page ] curry
+    start-timer-gadget ;
 
 elevator H{
     { T{ button-down } [ elevator-click ] }

library/ui/load.factor

@@ -50,10 +50,12 @@ PROVIDE: library/ui {
     "test/gadgets.factor"
     "test/models.factor"
     "test/document.factor"
+    "test/lists.factor"
     "test/rectangles.factor"
     "test/commands.factor"
     "test/panes.factor"
     "test/editor.factor"
     "test/search.factor"
+    "test/sliders.factor"
     "test/tracks.factor"
 } ;

library/ui/test/lists.factor

@@ -0,0 +1,4 @@
+IN: temporary
+USING: gadgets-lists models prettyprint math test ;
+
+[ ] [ f <model> [ ] [ 3 + . ] <list> call-action ] unit-test

library/ui/tools/dataflow.factor

@@ -186,7 +186,7 @@ DEFER: (compute-heights)
     make-shelf 1 over set-pack-align ;
 
 ! The UI tool
-TUPLE: dataflow-gadget history search ;
+TUPLE: dataflow-gadget history ;
 
 dataflow-gadget "Toolbar" {
     { "Back" T{ key-down f { C+ } "b" } [ dataflow-gadget-history go-back ] }