diff --git a/core/compiler/test/optimizer.factor b/core/compiler/test/optimizer.factor index 496c6f24ec..e05164cfdd 100644 --- a/core/compiler/test/optimizer.factor +++ b/core/compiler/test/optimizer.factor @@ -273,3 +273,9 @@ USE: sorting.private 10 20 >vector [ [ - ] swap old-binsearch ] compile-1 2nip ] unit-test + +! Regression +[ 1 2 { real imaginary } ] [ + C{ 1 2 } + [ { real imaginary } [ get-slots ] keep ] compile-1 +] unit-test diff --git a/core/inference/inference-tests.factor b/core/inference/inference-tests.factor index f83dc3a4fd..cefad52cd7 100644 --- a/core/inference/inference-tests.factor +++ b/core/inference/inference-tests.factor @@ -347,6 +347,9 @@ DEFER: bar [ t ] [ [ [ r> ] infer short-effect ] catch inference-error? ] unit-test +! Regression +[ t ] [ [ [ get-slots ] infer ] catch inference-error? ] unit-test + ! Test some curry stuff [ { 1 1 } ] [ [ 3 [ ] curry 4 [ ] curry if ] infer short-effect ] unit-test diff --git a/core/inference/transforms/transforms.factor b/core/inference/transforms/transforms.factor index 71ccbc3c35..b52357fc81 100644 --- a/core/inference/transforms/transforms.factor +++ b/core/inference/transforms/transforms.factor @@ -6,12 +6,11 @@ inference.dataflow tuples.private ; IN: inference.transforms : pop-literals ( n -- rstate seq ) - dup zero? [ drop recursive-state get f ] [ - [ ensure-values ] keep - [ d-tail ] keep - (consume-values) - dup [ value-literal ] map - swap first value-recursion swap + dup zero? [ + drop recursive-state get { } + ] [ + dup ensure-values + f swap [ 2drop pop-literal ] map reverse ] if ; : transform-quot ( quot n -- newquot ) diff --git a/extra/ui/gadgets/editors/editors-tests.factor b/extra/ui/gadgets/editors/editors-tests.factor index 7c60536605..daaeac6fad 100644 --- a/extra/ui/gadgets/editors/editors-tests.factor +++ b/extra/ui/gadgets/editors/editors-tests.factor @@ -1,6 +1,6 @@ USING: ui.gadgets.editors tools.test kernel io io.streams.plain io.streams.string definitions namespaces ui.gadgets -ui.gadgets.grids prettyprint documents ; +ui.gadgets.grids prettyprint documents ui.gestures ; [ t ] [ "editor" set @@ -27,3 +27,12 @@ ui.gadgets.grids prettyprint documents ; "editor" get gadget-selection "editor" get ungraft* ] unit-test + +[ ] [ + "editor" set + "editor" get graft* + "foo bar\nbaz quux" "editor" get set-editor-string + 4 hand-click# set + "editor" get position-caret + "editor" get ungraft* +] unit-test diff --git a/extra/ui/gadgets/editors/editors.factor b/extra/ui/gadgets/editors/editors.factor index abf26f3f81..214572b0d8 100644 --- a/extra/ui/gadgets/editors/editors.factor +++ b/extra/ui/gadgets/editors/editors.factor @@ -5,7 +5,7 @@ ui.gadgets.borders ui.gadgets.buttons ui.gadgets.labels ui.gadgets.scrollers ui.gadgets.theme ui.gadgets.controls ui.render ui.gestures io kernel math models namespaces opengl opengl.gl sequences strings io.styles math.vectors sorting -colors ; +colors combinators ; IN: ui.gadgets.editors TUPLE: editor @@ -292,11 +292,11 @@ M: editor gadget-text* editor-string % ; : position-caret ( editor -- ) hand-click# get { - [ ] - [ dup (position-caret) ] - [ dup T{ one-word-elt } select-elt ] - [ dup T{ one-line-elt } select-elt ] - } ?nth call drop ; + { 1 [ (position-caret) ] } + { 2 [ T{ one-word-elt } select-elt ] } + { 3 [ T{ one-line-elt } select-elt ] } + [ 2drop ] + } case ; : insert-newline "\n" swap user-input ; diff --git a/extra/ui/x11/x11.factor b/extra/ui/x11/x11.factor index 87ed6d2852..c9b23e10e3 100644 --- a/extra/ui/x11/x11.factor +++ b/extra/ui/x11/x11.factor @@ -93,8 +93,12 @@ M: world button-up-event send-button-up ; : mouse-event>scroll-direction ( event -- pair ) - #! Reminder for myself: 4 is up, 5 is down - XButtonEvent-button 5 = 1 -1 ? 0 swap 2array ; + XButtonEvent-button { + { 4 { 0 -1 } } + { 5 { 0 1 } } + { 6 { -1 0 } } + { 7 { 1 0 } } + } at ; M: world wheel-event >r dup mouse-event>scroll-direction swap mouse-event-loc r> diff --git a/extra/x11/events/events.factor b/extra/x11/events/events.factor index 05b3318f4f..f40392891c 100644 --- a/extra/x11/events/events.factor +++ b/extra/x11/events/events.factor @@ -42,7 +42,7 @@ GENERIC: client-event ( event window -- ) : events-queued ( mode -- n ) >r dpy get r> XEventsQueued ; -: wheel? ( event -- ? ) XButtonEvent-button { 4 5 } member? ; +: wheel? ( event -- ? ) XButtonEvent-button 4 7 between? ; : button-down-event$ ( event window -- ) over wheel? [ wheel-event ] [ button-down-event ] if ;