diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index 1c8bd03257..029fbd05e2 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -19,7 +19,6 @@ - optimize away dispatch - layouts with gaps - alignment of gadgets inside their bounding boxes needs thought -- WordPreview calls markTokens() -> NPE - faster completion - ppc register decls - rename f* words to stream-* @@ -29,6 +28,7 @@ - slot compile problem - sdl console crash - x86 register decl +- UI: don't roll over if mouse button is down + compiler/ffi: diff --git a/library/syntax/prettyprint.factor b/library/syntax/prettyprint.factor index 8c6a069d9d..41f238b02f 100644 --- a/library/syntax/prettyprint.factor +++ b/library/syntax/prettyprint.factor @@ -107,13 +107,9 @@ M: word prettyprint* ( indent word -- indent ) ] ifte ; M: list prettyprint* ( indent list -- indent ) - [ - [ - \ [ swap \ ] prettyprint-sequence - ] check-recursion - ] [ - f unparse write - ] ifte* ; + [ + \ [ swap \ ] prettyprint-sequence + ] check-recursion ; M: cons prettyprint* ( indent cons -- indent ) #! Here we turn the cons into a list of two elements. diff --git a/library/ui/gestures.factor b/library/ui/gestures.factor index f87b52d7e5..76d4daadaf 100644 --- a/library/ui/gestures.factor +++ b/library/ui/gestures.factor @@ -27,17 +27,20 @@ SYMBOL: motion SYMBOL: button-up SYMBOL: button-down +: hierarchy-gesture ( gadget ? gesture -- ? ) + swap [ + 2drop f + ] [ + swap handle-gesture* drop t + ] ifte ; + : mouse-enter ( point gadget -- ) #! If the old point is inside the new gadget, do not fire an #! enter gesture, since the mouse did not enter. Otherwise, #! fire an enter gesture and go on to the parent. [ [ shape-pos + ] keep - 2dup inside? [ - drop f - ] [ - [ mouse-enter ] swap handle-gesture* drop t - ] ifte + 2dup inside? [ mouse-enter ] hierarchy-gesture ] each-parent drop ; : mouse-leave ( point gadget -- ) @@ -46,9 +49,23 @@ SYMBOL: button-down #! fire a leave gesture and go on to the parent. [ [ shape-pos + ] keep - 2dup inside? [ - drop f - ] [ - [ mouse-leave ] swap handle-gesture* drop t - ] ifte + 2dup inside? [ mouse-leave ] hierarchy-gesture + ] each-parent drop ; + +: lose-focus ( old new -- ) + #! If the old focus owner is a child of the new owner, do + #! not fire a focus lost gesture, since the focus was not + #! lost. Otherwise, fire a focus lost gesture and go to the + #! parent. + [ + 2dup child? [ lose-focus ] hierarchy-gesture + ] each-parent drop ; + +: gain-focus ( old new -- ) + #! If the old focus owner is a child of the new owner, do + #! not fire a focus gained gesture, since the focus was not + #! gained. Otherwise, fire a focus gained gesture and go on + #! to the parent. + [ + 2dup child? [ gain-focus ] hierarchy-gesture ] each-parent drop ; diff --git a/library/ui/hand.factor b/library/ui/hand.factor index b8a3ebe1b1..f1d609df22 100644 --- a/library/ui/hand.factor +++ b/library/ui/hand.factor @@ -43,8 +43,11 @@ DEFER: world ! The hand is a special gadget that holds mouse position and ! mouse button click state. The hand's parent is the world, but ! it is special in that the world does not list it as part of -! its contents. -TUPLE: hand click-pos clicked buttons gadget delegate ; +! its contents. Some comments on the slots: +! - hand-gadget is the gadget under the mouse position +! - hand-clicked is the most recently clicked gadget +! - hand-focus is the gadget holding keyboard focus +TUPLE: hand click-pos clicked buttons gadget focus delegate ; C: hand ( world -- hand ) 0 0 0 0 @@ -81,3 +84,9 @@ C: hand ( world -- hand ) dup r> fire-leave dup fire-motion r> swap fire-enter ; + +: request-focus ( gadget -- ) + my-hand hand-focus swap + 2dup lose-focus + 2dup my-hand set-hand-focus + gain-focus ;