Merge branch 'master' of git://factorcode.org/git/factor
commit
c719d85305
|
@ -273,3 +273,9 @@ USE: sorting.private
|
|||
10 20 >vector <flat-slice>
|
||||
[ [ - ] 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
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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 )
|
||||
|
|
|
@ -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> "editor" set
|
||||
|
@ -27,3 +27,12 @@ ui.gadgets.grids prettyprint documents ;
|
|||
"editor" get gadget-selection
|
||||
"editor" get ungraft*
|
||||
] unit-test
|
||||
|
||||
[ ] [
|
||||
<editor> "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
|
||||
|
|
|
@ -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 ;
|
||||
|
||||
|
|
|
@ -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>
|
||||
|
|
|
@ -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 ;
|
||||
|
|
Loading…
Reference in New Issue