Slider fix, rename path. to write-path

diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt
index 0d1ab43aa4d7e45fb9d1b185a8a7a528af52ff91..0547bde6eabeb6d95b1a53415847e9bcc56d1f79 100644 (file)
--- a/TODO.FACTOR.txt
+++ b/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:
 

diff --git a/library/io/files.factor b/library/io/files.factor
index 6dd521d148eac1033716ba3a8dd2d73b86d17c56..ad884561e9dbd623b5ddb438a59d99ed7b89cd9e 100644 (file)
--- a/library/io/files.factor
+++ b/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.
 

diff --git a/library/syntax/parse-stream.factor b/library/syntax/parse-stream.factor
index 8b870bba67b12086de29d4f20ba6662c5d706932..4ec43ef586bcf11c75e82bcb726f3c7a6b0b7d57 100644 (file)
--- a/library/syntax/parse-stream.factor
+++ b/library/syntax/parse-stream.factor
@@ -64,7 +64,7 @@ SYMBOL: parse-hook
     ] with-scope ;\r
 \r
 : parsing-file ( file -- )\r
-    "Loading " write path. terpri flush ;\r
+    "Loading " write write-pathname terpri flush ;\r
 \r
 : record-file ( file -- )\r
     [ <source-file> ] keep source-files get set-hash ;\r

diff --git a/library/test/kernel.factor b/library/test/kernel.factor
index 0922f3482394de8d078f1c84b986749d7e2e3eb5..dc5b722277af7bd5bf243f4c4c6f05b449514709 100644 (file)
--- a/library/test/kernel.factor
+++ b/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

diff --git a/library/tools/errors.factor b/library/tools/errors.factor
index 7ea959cc372c8434071c5c64639c78604e2651c9..6af6eaf25b4ce1c87f1f53beb015b86973a1890a 100644 (file)
--- a/library/tools/errors.factor
+++ b/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
     

diff --git a/library/tools/test.factor b/library/tools/test.factor
index 6bd37a4c0ba452777d4578588ad9fa9e536108ea..f71cb8a10a1011d7d65b0099935ce4332d644b3b 100644 (file)
--- a/library/tools/test.factor
+++ b/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. ;

diff --git a/library/ui/gadgets/lists.factor b/library/ui/gadgets/lists.factor
index 91bf9087f96a96eeb36c5cc51f6d54130c4e2fac..f52a7d4b05a0e2344d0651195ffaf70b3b468249 100644 (file)
--- a/library/ui/gadgets/lists.factor
+++ b/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 ] }

diff --git a/library/ui/gadgets/sliders.factor b/library/ui/gadgets/sliders.factor
index fc011c4e98c3cea98d1fcb614c90fc02b1d9cfb0..7dc58f53cf94245f98bee4dba0184426ccf288dc 100644 (file)
--- a/library/ui/gadgets/sliders.factor
+++ b/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 ] }

diff --git a/library/ui/load.factor b/library/ui/load.factor
index e533ea55a41a2690293e3f94efe8726a86f0e919..7e86b03406e6745ab7d359806b3eaa107446a7c3 100644 (file)
--- a/library/ui/load.factor
+++ b/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"
 } ;

diff --git a/library/ui/test/lists.factor b/library/ui/test/lists.factor
new file mode 100644 (file)
index 0000000..82ccdf2
--- /dev/null
+++ b/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

diff --git a/library/ui/tools/dataflow.factor b/library/ui/tools/dataflow.factor
index 4c22eec4f472910a6ce16b2d6d4fa25a36119dd7..1d0258052e737414ff00cc562070dfb061425012 100644 (file)
--- a/library/ui/tools/dataflow.factor
+++ b/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 ] }