From fb918ab7567ad251547f2d40ecbc0931ffbe0b2a Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 21 Nov 2008 23:01:20 -0600 Subject: [PATCH] The event loop thread now adds events to a queue slurped by the UI update thread instead of handling them directly. This fixes a race condition where a gadget could end up handling an event before it was grafted or laid out --- basis/ui/cocoa/cocoa.factor | 4 +- basis/ui/cocoa/views/views.factor | 55 +++++++++----------- basis/ui/gadgets/editors/editors.factor | 2 +- basis/ui/gadgets/gadgets.factor | 8 ++- basis/ui/gadgets/panes/panes-tests.factor | 8 +-- basis/ui/gestures/gestures-docs.factor | 6 +-- basis/ui/gestures/gestures.factor | 41 +++++++++++---- basis/ui/tools/debugger/debugger-docs.factor | 2 +- basis/ui/tools/interactor/interactor.factor | 2 +- basis/ui/tools/listener/listener.factor | 42 ++++++++------- basis/ui/ui-docs.factor | 5 -- basis/ui/ui.factor | 25 +++++---- basis/ui/windows/windows.factor | 8 ++- basis/ui/x11/x11.factor | 2 +- 14 files changed, 112 insertions(+), 98 deletions(-) diff --git a/basis/ui/cocoa/cocoa.factor b/basis/ui/cocoa/cocoa.factor index 1a05d23aa0..9ff3a59f71 100644 --- a/basis/ui/cocoa/cocoa.factor +++ b/basis/ui/cocoa/cocoa.factor @@ -15,9 +15,7 @@ C: handle SINGLETON: cocoa-ui-backend M: cocoa-ui-backend do-events ( -- ) - [ - [ NSApp [ do-event ] curry loop ui-wait ] ui-try - ] with-autorelease-pool ; + [ NSApp [ do-event ] curry loop ui-wait ] with-autorelease-pool ; TUPLE: pasteboard handle ; diff --git a/basis/ui/cocoa/views/views.factor b/basis/ui/cocoa/views/views.factor index f72eab0862..82a31ad0d9 100644 --- a/basis/ui/cocoa/views/views.factor +++ b/basis/ui/cocoa/views/views.factor @@ -62,9 +62,6 @@ IN: ui.cocoa.views : send-key-event ( view gesture -- ) swap window-focus propagate-gesture ; -: send-user-input ( view string -- ) - CF>string swap window-focus user-input ; - : interpret-key-event ( view event -- ) NSArray swap -> arrayWithObject: -> interpretKeyEvents: ; @@ -138,83 +135,83 @@ CLASS: { } { "mouseEntered:" "void" { "id" "SEL" "id" } - [ [ nip send-mouse-moved ] ui-try ] + [ nip send-mouse-moved ] } { "mouseExited:" "void" { "id" "SEL" "id" } - [ [ 3drop forget-rollover ] ui-try ] + [ 3drop forget-rollover ] } { "mouseMoved:" "void" { "id" "SEL" "id" } - [ [ nip send-mouse-moved ] ui-try ] + [ nip send-mouse-moved ] } { "mouseDragged:" "void" { "id" "SEL" "id" } - [ [ nip send-mouse-moved ] ui-try ] + [ nip send-mouse-moved ] } { "rightMouseDragged:" "void" { "id" "SEL" "id" } - [ [ nip send-mouse-moved ] ui-try ] + [ nip send-mouse-moved ] } { "otherMouseDragged:" "void" { "id" "SEL" "id" } - [ [ nip send-mouse-moved ] ui-try ] + [ nip send-mouse-moved ] } { "mouseDown:" "void" { "id" "SEL" "id" } - [ [ nip send-button-down$ ] ui-try ] + [ nip send-button-down$ ] } { "mouseUp:" "void" { "id" "SEL" "id" } - [ [ nip send-button-up$ ] ui-try ] + [ nip send-button-up$ ] } { "rightMouseDown:" "void" { "id" "SEL" "id" } - [ [ nip send-button-down$ ] ui-try ] + [ nip send-button-down$ ] } { "rightMouseUp:" "void" { "id" "SEL" "id" } - [ [ nip send-button-up$ ] ui-try ] + [ nip send-button-up$ ] } { "otherMouseDown:" "void" { "id" "SEL" "id" } - [ [ nip send-button-down$ ] ui-try ] + [ nip send-button-down$ ] } { "otherMouseUp:" "void" { "id" "SEL" "id" } - [ [ nip send-button-up$ ] ui-try ] + [ nip send-button-up$ ] } { "scrollWheel:" "void" { "id" "SEL" "id" } - [ [ nip send-wheel$ ] ui-try ] + [ nip send-wheel$ ] } { "keyDown:" "void" { "id" "SEL" "id" } - [ [ nip send-key-down-event ] ui-try ] + [ nip send-key-down-event ] } { "keyUp:" "void" { "id" "SEL" "id" } - [ [ nip send-key-up-event ] ui-try ] + [ nip send-key-up-event ] } { "cut:" "id" { "id" "SEL" "id" } - [ [ nip T{ cut-action } send-action$ ] ui-try ] + [ nip T{ cut-action } send-action$ ] } { "copy:" "id" { "id" "SEL" "id" } - [ [ nip T{ copy-action } send-action$ ] ui-try ] + [ nip T{ copy-action } send-action$ ] } { "paste:" "id" { "id" "SEL" "id" } - [ [ nip T{ paste-action } send-action$ ] ui-try ] + [ nip T{ paste-action } send-action$ ] } { "delete:" "id" { "id" "SEL" "id" } - [ [ nip T{ delete-action } send-action$ ] ui-try ] + [ nip T{ delete-action } send-action$ ] } { "selectAll:" "id" { "id" "SEL" "id" } - [ [ nip T{ select-all-action } send-action$ ] ui-try ] + [ nip T{ select-all-action } send-action$ ] } ! Multi-touch gestures: this is undocumented. @@ -290,7 +287,7 @@ CLASS: { ! Text input { "insertText:" "void" { "id" "SEL" "id" } - [ [ nip send-user-input ] ui-try ] + [ nip CF>string swap window-focus user-input ] } { "hasMarkedText" "char" { "id" "SEL" } @@ -335,11 +332,11 @@ CLASS: { ! Initialization { "updateFactorGadgetSize:" "void" { "id" "SEL" "id" } - [ - [ - 2drop dup view-dim swap window (>>dim) yield - ] ui-try - ] + [ 2drop dup view-dim swap window (>>dim) yield ] +} + +{ "doCommandBySelector:" "void" { "id" "SEL" "SEL" } + [ 3drop ] } { "initWithFrame:pixelFormat:" "id" { "id" "SEL" "NSRect" "id" } diff --git a/basis/ui/gadgets/editors/editors.factor b/basis/ui/gadgets/editors/editors.factor index b5d30dd2d6..3753e98a8a 100644 --- a/basis/ui/gadgets/editors/editors.factor +++ b/basis/ui/gadgets/editors/editors.factor @@ -356,7 +356,7 @@ M: editor gadget-text* editor-string % ; [ drop dup extend-selection dup mark>> click-loc ] [ select-elt ] if ; -: insert-newline ( editor -- ) "\n" swap user-input ; +: insert-newline ( editor -- ) "\n" swap user-input* ; : delete-next-character ( editor -- ) T{ char-elt } editor-delete ; diff --git a/basis/ui/gadgets/gadgets.factor b/basis/ui/gadgets/gadgets.factor index a18571d472..7d33ec21fd 100644 --- a/basis/ui/gadgets/gadgets.factor +++ b/basis/ui/gadgets/gadgets.factor @@ -10,11 +10,9 @@ SYMBOL: ui-notify-flag : notify-ui-thread ( -- ) ui-notify-flag get-global raise-flag ; -TUPLE: gadget < rect - pref-dim parent children orientation focus - visible? root? clipped? layout-state graft-state graft-node - interior boundary - model ; +TUPLE: gadget < rect pref-dim parent children orientation focus +visible? root? clipped? layout-state graft-state graft-node +interior boundary model ; M: gadget equal? 2drop f ; diff --git a/basis/ui/gadgets/panes/panes-tests.factor b/basis/ui/gadgets/panes/panes-tests.factor index 109c0a1461..8627f7fbfe 100644 --- a/basis/ui/gadgets/panes/panes-tests.factor +++ b/basis/ui/gadgets/panes/panes-tests.factor @@ -40,7 +40,7 @@ IN: ui.gadgets.panes.tests [ t ] [ [ [ 1 2 3 ] pprint ] test-gadget-text ] unit-test [ t ] [ [ \ + describe ] test-gadget-text ] unit-test [ t ] [ [ \ = see ] test-gadget-text ] unit-test -[ t ] [ [ \ = help ] test-gadget-text ] unit-test +[ t ] [ [ \ = print-topic ] test-gadget-text ] unit-test [ t ] [ [ @@ -84,16 +84,16 @@ ARTICLE: "test-article-1" "This is a test article" [ t ] [ [ "test-article-1" $title ] test-gadget-text ] unit-test -[ t ] [ [ "test-article-1" help ] test-gadget-text ] unit-test +[ t ] [ [ "test-article-1" print-topic ] test-gadget-text ] unit-test ARTICLE: "test-article-2" "This is a test article" "Hello world, how are you today." { $table { "a" "b" } { "c" "d" } } ; -[ t ] [ [ "test-article-2" help ] test-gadget-text ] unit-test +[ t ] [ [ "test-article-2" print-topic ] test-gadget-text ] unit-test [ \ = see ] with-pane - [ \ = help ] with-pane + [ \ = print-topic ] with-pane [ ] [ \ = [ see ] [ ] with-grafted-gadget diff --git a/basis/ui/gestures/gestures-docs.factor b/basis/ui/gestures/gestures-docs.factor index 69425cca0f..e94bcf6d93 100644 --- a/basis/ui/gestures/gestures-docs.factor +++ b/basis/ui/gestures/gestures-docs.factor @@ -22,7 +22,7 @@ HELP: propagate-gesture { $description "Calls " { $link handle-gesture } " on every parent of " { $snippet "gadget" } ". Outputs " { $link f } " if some parent handled the gesture, else outputs " { $link t } "." } ; HELP: user-input -{ $values { "str" string } { "gadget" gadget } } +{ $values { "string" string } { "gadget" gadget } } { $description "Calls " { $link user-input* } " on every parent of the gadget." } ; HELP: motion @@ -90,10 +90,6 @@ HELP: select-all-action { $class-description "Gesture sent when the " { $emphasis "select all" } " standard window system action is invoked." } { $examples { $code "T{ select-all-action }" } } ; -HELP: generalize-gesture -{ $values { "gesture" "a gesture" } { "newgesture" "a new gesture" } } -{ $description "Turns a " { $link button-down } ", " { $link button-up } " or " { $link drag } " action naming a specific mouse button into one which can apply regardless of which mouse button was pressed." } ; - HELP: C+ { $description "Control key modifier." } ; diff --git a/basis/ui/gestures/gestures.factor b/basis/ui/gestures/gestures.factor index 63ecbc2a80..180447ff4f 100644 --- a/basis/ui/gestures/gestures.factor +++ b/basis/ui/gestures/gestures.factor @@ -3,11 +3,9 @@ USING: accessors arrays assocs kernel math models namespaces make sequences words strings system hashtables math.parser math.vectors classes.tuple classes boxes calendar -alarms symbols combinators sets columns fry ui.gadgets ; +alarms symbols combinators sets columns fry deques ui.gadgets ; IN: ui.gestures -: set-gestures ( class hash -- ) "gestures" set-word-prop ; - GENERIC: handle-gesture ( gesture gadget -- ? ) M: object handle-gesture @@ -15,17 +13,42 @@ M: object handle-gesture [ "gestures" word-prop ] map assoc-stack dup [ call f ] [ 2drop t ] if ; +: set-gestures ( class hash -- ) "gestures" set-word-prop ; + +: gesture-queue ( -- deque ) \ gesture-queue get ; + +GENERIC: send-queued-gesture ( request -- ) + +TUPLE: send-gesture gesture gadget ; + +M: send-gesture send-queued-gesture + [ gesture>> ] [ gadget>> ] bi handle-gesture drop ; + +: queue-gesture ( ... class -- ) + boa gesture-queue push-front notify-ui-thread ; inline + : send-gesture ( gesture gadget -- ) - handle-gesture drop ; + \ send-gesture queue-gesture ; -: each-gesture ( gesture seq -- ) - [ send-gesture ] with each ; +: each-gesture ( gesture seq -- ) [ send-gesture ] with each ; -: propagate-gesture ( gesture gadget -- ) +TUPLE: propagate-gesture gesture gadget ; + +M: propagate-gesture send-queued-gesture + [ gesture>> ] [ gadget>> ] bi [ handle-gesture ] with each-parent drop ; -: user-input ( str gadget -- ) - '[ _ [ user-input* ] with each-parent drop ] unless-empty ; +: propagate-gesture ( gesture gadget -- ) + \ propagate-gesture queue-gesture ; + +TUPLE: user-input string gadget ; + +M: user-input send-queued-gesture + [ string>> ] [ gadget>> ] bi + [ user-input* ] with each-parent drop ; + +: user-input ( string gadget -- ) + '[ _ \ user-input queue-gesture ] unless-empty ; ! Gesture objects TUPLE: motion ; C: motion diff --git a/basis/ui/tools/debugger/debugger-docs.factor b/basis/ui/tools/debugger/debugger-docs.factor index 12a2e0d806..94c118953d 100644 --- a/basis/ui/tools/debugger/debugger-docs.factor +++ b/basis/ui/tools/debugger/debugger-docs.factor @@ -8,7 +8,7 @@ HELP: "Creates a gadget displaying a description of the error, along with buttons to print the contents of the stacks in the listener, and a list of restarts." } ; -{ debugger-window ui-try } related-words +{ debugger-window } related-words HELP: debugger-window { $values { "error" "an error" } } diff --git a/basis/ui/tools/interactor/interactor.factor b/basis/ui/tools/interactor/interactor.factor index 36ce67e57b..94aa878942 100644 --- a/basis/ui/tools/interactor/interactor.factor +++ b/basis/ui/tools/interactor/interactor.factor @@ -164,7 +164,7 @@ M: interactor dispose drop ; : handle-interactive ( lines interactor -- quot/f ? ) tuck try-parse { { [ dup quotation? ] [ nip t ] } - { [ dup not ] [ drop "\n" swap user-input f f ] } + { [ dup not ] [ drop "\n" swap user-input* f f ] } [ handle-parse-error f f ] } cond ; diff --git a/basis/ui/tools/listener/listener.factor b/basis/ui/tools/listener/listener.factor index 250fc371c7..bf62f5372d 100644 --- a/basis/ui/tools/listener/listener.factor +++ b/basis/ui/tools/listener/listener.factor @@ -1,11 +1,11 @@ ! Copyright (C) 2005, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: inspector help help.markup io io.styles -kernel models namespaces parser quotations sequences vocabs words -prettyprint listener debugger threads boxes concurrency.flags -math arrays generic accessors combinators assocs fry ui.commands -ui.gadgets ui.gadgets.editors ui.gadgets.labelled -ui.gadgets.panes ui.gadgets.buttons ui.gadgets.scrollers +USING: inspector help help.markup io io.styles kernel models +namespaces parser quotations sequences vocabs words prettyprint +listener debugger threads boxes concurrency.flags math arrays +generic accessors combinators assocs fry ui.commands ui.gadgets +ui.gadgets.editors ui.gadgets.labelled ui.gadgets.panes +ui.gadgets.buttons ui.gadgets.scrollers ui.gadgets.packs ui.gadgets.tracks ui.gadgets.borders ui.gestures ui.operations ui.tools.browser ui.tools.interactor ui.tools.inspector ui.tools.workspace ; @@ -13,20 +13,12 @@ IN: ui.tools.listener TUPLE: listener-gadget < track input output ; -: listener-output, ( listener -- listener ) - - [ >>output ] [ 1 track-add ] bi ; - : listener-streams ( listener -- input output ) [ input>> ] [ output>> ] bi ; : ( listener -- gadget ) output>> ; -: listener-input, ( listener -- listener ) - dup - [ >>input ] [ 1 { 1 1 } >>fill f track-add ] bi ; - : welcome. ( -- ) "If this is your first time with Factor, please read the " print "handbook" ($link) ". To see a list of keyboard shortcuts," print @@ -109,7 +101,7 @@ M: engine-word word-completion-string : insert-word ( word -- ) get-workspace listener>> input>> - [ >r word-completion-string r> user-input ] + [ >r word-completion-string r> user-input* ] [ interactor-use use-if-necessary ] 2bi ; @@ -156,11 +148,21 @@ M: engine-word word-completion-string [ wait-for-listener ] } cleave ; +: init-listener ( listener -- listener ) + >>output + dup >>input ; + +: ( listener -- scroller ) + + over output>> add-gadget + swap input>> add-gadget + ; + : ( -- gadget ) { 0 1 } listener-gadget new-track add-toolbar - listener-output, - listener-input, ; + init-listener + dup 1 track-add ; : listener-help ( -- ) "ui-listener" help-window ; @@ -177,9 +179,9 @@ listener-gadget "misc" "Miscellaneous commands" { listener-gadget "toolbar" f { { f restart-listener } - { T{ key-down f { A+ } "a" } com-auto-use } - { T{ key-down f { A+ } "c" } clear-output } - { T{ key-down f { A+ } "C" } clear-stack } + { T{ key-down f { A+ } "u" } com-auto-use } + { T{ key-down f { A+ } "k" } clear-output } + { T{ key-down f { A+ } "K" } clear-stack } { T{ key-down f { C+ } "d" } com-end } } define-command-map diff --git a/basis/ui/ui-docs.factor b/basis/ui/ui-docs.factor index c10205ed26..978bd24055 100644 --- a/basis/ui/ui-docs.factor +++ b/basis/ui/ui-docs.factor @@ -47,11 +47,6 @@ HELP: (open-window) { $description "Opens a native window containing the given world. This grafts the world by calling " { $link graft } ". Each world can only be displayed in one top-level window at a time." } { $notes "This word should not be called directly by user code. Instead, use " { $link open-window } "." } ; -HELP: ui-try -{ $values { "quot" quotation } } -{ $description "Calls the quotation. If it throws an error, opens a window with the error and restores the data stack." } -{ $notes "This is essentially a graphical variant of " { $link try } "." } ; - ARTICLE: "ui-glossary" "UI glossary" { $table { "color specifier" diff --git a/basis/ui/ui.factor b/basis/ui/ui.factor index db0ac9a624..e05341f3fc 100644 --- a/basis/ui/ui.factor +++ b/basis/ui/ui.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2006, 2007 Slava Pestov. +! Copyright (C) 2006, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: arrays assocs io kernel math models namespaces make prettyprint dlists deques sequences threads sequences words @@ -87,6 +87,7 @@ SYMBOL: ui-hook : init-ui ( -- ) \ graft-queue set-global \ layout-queue set-global + \ gesture-queue set-global V{ } clone windows set-global ; : restore-gadget-later ( gadget -- ) @@ -138,14 +139,22 @@ SYMBOL: ui-hook : notify-queued ( -- ) graft-queue [ notify ] slurp-deque ; +: send-queued-gestures ( -- ) + gesture-queue [ send-queued-gesture ] slurp-deque ; + : update-ui ( -- ) - [ notify-queued layout-queued redraw-worlds ] assert-depth ; + [ + [ + notify-queued + layout-queued + redraw-worlds + send-queued-gestures + ] assert-depth + ] [ ui-error ] recover ; : ui-wait ( -- ) 10 sleep ; -: ui-try ( quot -- ) [ ui-error ] recover ; - SYMBOL: ui-thread : ui-running ( quot -- ) @@ -156,11 +165,9 @@ SYMBOL: ui-thread \ ui-running get-global ; : update-ui-loop ( -- ) - ui-running? ui-thread get-global self eq? and [ - ui-notify-flag get lower-flag - [ update-ui ] ui-try - update-ui-loop - ] when ; + [ ui-running? ui-thread get-global self eq? and ] + [ ui-notify-flag get lower-flag update-ui ] + [ ] while ; : start-ui-thread ( -- ) [ self ui-thread set-global update-ui-loop ] diff --git a/basis/ui/windows/windows.factor b/basis/ui/windows/windows.factor index 81cc0a0b70..fc22f30e0a 100644 --- a/basis/ui/windows/windows.factor +++ b/basis/ui/windows/windows.factor @@ -381,11 +381,9 @@ SYMBOL: trace-messages? ! return 0 if you handle the message, else just let DefWindowProc return its val : ui-wndproc ( -- object ) "uint" { "void*" "uint" "long" "long" } "stdcall" [ - [ - pick - trace-messages? get-global [ dup windows-message-name name>> print flush ] when - wm-handlers get-global at* [ call ] [ drop DefWindowProc ] if - ] ui-try + pick + trace-messages? get-global [ dup windows-message-name name>> print flush ] when + wm-handlers get-global at* [ call ] [ drop DefWindowProc ] if ] alien-callback ; : peek-message? ( msg -- ? ) f 0 0 PM_REMOVE PeekMessage zero? ; diff --git a/basis/ui/x11/x11.factor b/basis/ui/x11/x11.factor index 04e47763a8..9faf888559 100644 --- a/basis/ui/x11/x11.factor +++ b/basis/ui/x11/x11.factor @@ -189,7 +189,7 @@ M: world client-event M: x11-ui-backend do-events wait-event dup XAnyEvent-window window dup - [ [ [ 2dup handle-event ] ui-try ] assert-depth ] when 2drop ; + [ handle-event ] [ 2drop ] if ; : x-clipboard@ ( gadget clipboard -- prop win ) atom>> swap