diff --git a/basis/ui/gadgets/glass/glass.factor b/basis/ui/gadgets/glass/glass.factor index 0a91236bd4..8722d817ed 100644 --- a/basis/ui/gadgets/glass/glass.factor +++ b/basis/ui/gadgets/glass/glass.factor @@ -1,17 +1,14 @@ ! Copyright (C) 2005, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors kernel namespaces ui.gadgets ui.gadgets.worlds -ui.gestures math.rectangles math.rectangles.positioning -combinators ; +ui.gadgets.wrappers ui.gestures math.rectangles +math.rectangles.positioning combinators ; IN: ui.gadgets.glass GENERIC: hide-glass-hook ( gadget -- ) M: gadget hide-glass-hook drop ; -: hide-glass ( world -- ) - [ [ unparent ] when* f ] change-glass drop ; - >glass ] bi drop ; +: (hide-glass) ( gadget -- ) + [ [ unparent ] when* f ] change-glass drop ; -\ glass H{ - { T{ button-down } [ find-world [ hide-glass ] when* ] } - { T{ drag } [ update-clicked drop ] } -} set-gestures +: add-glass ( glass world -- ) + dup (hide-glass) swap [ add-gadget ] [ >>glass ] bi drop ; PRIVATE> +: hide-glass ( child -- ) + find-world [ [ (hide-glass) ] [ request-focus ] bi ] when* ; + : show-glass ( owner child visible-rect -- ) dup gadget-child hand-clicked set - dup owner>> find-world add-glass ; \ No newline at end of file + dup owner>> find-world add-glass ; + +\ glass H{ + { T{ button-down } [ hide-glass ] } + { T{ drag } [ update-clicked drop ] } +} set-gestures + +SLOT: popup + + ( owner gadget -- popup ) + popup new-wrapper + swap >>owner ; inline + +M: popup hide-glass-hook + owner>> f >>popup request-focus ; + +PRIVATE> + +popup H{ + { T{ key-down f f "ESC" } [ hide-glass ] } +} set-gestures + +: pass-to-popup ( gesture interactor -- ? ) + popup>> focusable-child resend-gesture ; + +: show-popup ( owner popup visible-rect -- ) + [ ] dip + [ drop dup owner>> (>>popup) ] + [ [ [ owner>> ] keep ] dip show-glass ] + 2bi ; \ No newline at end of file diff --git a/basis/ui/tools/listener/completion/completion.factor b/basis/ui/tools/listener/completion/completion.factor index ce61fcc0bc..a9cd616a92 100644 --- a/basis/ui/tools/listener/completion/completion.factor +++ b/basis/ui/tools/listener/completion/completion.factor @@ -131,7 +131,7 @@ GENERIC# accept-completion-hook 1 ( item popup -- ) find-completion-popup [ insert-completion ] [ accept-completion-hook ] - [ nip hide-popup ] + [ nip hide-glass ] 2tri ; : ( interactor completion-mode -- table ) @@ -140,8 +140,6 @@ GENERIC# accept-completion-hook 1 ( item popup -- ) monospace-font >>font t >>selection-required? t >>single-click? - transparent >>column-line-color - 2 >>gap 30 >>min-cols 10 >>max-rows dup '[ _ accept-completion ] >>action ; @@ -162,7 +160,7 @@ completion-popup H{ : show-completion-popup ( interactor mode -- ) [ completion-element ] [ ] 2bi - show-popup ; + show-listener-popup ; : code-completion-popup ( interactor -- ) dup completion-mode show-completion-popup ; @@ -182,5 +180,5 @@ completion-popup H{ M: completion-popup handle-gesture ( gesture completion -- ? ) 2dup completion-gesture dup [ - [ nip find-world hide-glass ] [ invoke-command ] 2bi* f + [ nip hide-glass ] [ invoke-command ] 2bi* f ] [ 2drop call-next-method ] if ; \ No newline at end of file diff --git a/basis/ui/tools/listener/listener.factor b/basis/ui/tools/listener/listener.factor index 7f76a47d6c..a1bf5ce20d 100644 --- a/basis/ui/tools/listener/listener.factor +++ b/basis/ui/tools/listener/listener.factor @@ -7,7 +7,7 @@ documents documents.elements fry hashtables help help.markup io io.styles kernel lexer listener math models models.delay models.filter namespaces parser prettyprint quotations sequences strings threads tools.vocabs vocabs vocabs.loader vocabs.parser words ui ui.commands -ui.pens.solid ui.gadgets ui.gadgets.buttons ui.gadgets.editors +ui.pens.solid ui.gadgets ui.gadgets.glass ui.gadgets.buttons ui.gadgets.editors ui.gadgets.labeled ui.gadgets.panes ui.gadgets.scrollers ui.gadgets.status-bar ui.gadgets.tracks ui.gadgets.borders ui.gestures ui.operations ui.tools.browser ui.tools.common ui.tools.debugger @@ -293,11 +293,11 @@ M: object accept-completion-hook 2drop ; :: ( interactor error continuation -- popup ) error continuation error compute-restarts - [ interactor hide-popup ] + [ interactor hide-glass ] "Error" ; : debugger-popup ( interactor error continuation -- ) - [ [ drop one-line-elt ] 2keep ] dip show-popup ; + [ [ drop one-line-elt ] 2keep ] dip show-listener-popup ; : handle-parse-error ( interactor error -- ) dup lexer-error? [ 2dup go-to-error error>> ] when @@ -329,9 +329,6 @@ M: interactor stream-read-quot ] } cond ; -: pass-to-popup ( gesture interactor -- ? ) - popup>> focusable-child resend-gesture ; - : interactor-operation ( gesture interactor -- ? ) [ token-model>> value>> ] keep word-at-caret [ nip ] [ gesture>operation ] 2bi dup [ invoke-command f ] [ 2drop t ] if ; diff --git a/basis/ui/tools/listener/popups/popups.factor b/basis/ui/tools/listener/popups/popups.factor index 6bb23e41a8..9329c0ebe8 100644 --- a/basis/ui/tools/listener/popups/popups.factor +++ b/basis/ui/tools/listener/popups/popups.factor @@ -1,30 +1,9 @@ ! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors documents.elements kernel math math.vectors -math.rectangles math.rectangles.positioning sequences ui.gadgets -ui.gadgets.editors ui.gadgets.glass ui.gadgets.tracks -ui.gadgets.wrappers ui.gadgets.worlds ui.gestures ; +USING: accessors documents.elements kernel math.rectangles +math.vectors ui.gadgets.editors ui.gadgets.glass ; IN: ui.tools.listener.popups -SLOT: popup - -TUPLE: popup < wrapper interactor element ; - -: ( interactor element gadget -- popup ) - popup new-wrapper - swap >>element - swap >>interactor ; - -M: popup hide-glass-hook - interactor>> f >>popup request-focus ; - -: hide-popup ( popup -- ) - find-world hide-glass ; - -popup H{ - { T{ key-down f f "ESC" } [ hide-popup ] } -} set-gestures - : caret-loc ( interactor element -- loc ) [ [ [ editor-caret ] [ model>> ] bi ] dip @@ -32,13 +11,8 @@ popup H{ ] [ drop ] 2bi loc>point ; -: relevant-rect ( popup -- rect ) - [ interactor>> ] [ element>> ] bi - [ caret-loc ] [ drop caret-dim { 0 1 } v+ ] 2bi - ; +: relevant-rect ( interactor element -- rect ) + [ caret-loc ] [ drop caret-dim { 0 1 } v+ ] 2bi ; -: show-popup ( interactor element popup -- ) - - [ dup interactor>> (>>popup) ] - [ [ interactor>> ] [ ] [ relevant-rect ] tri show-glass ] - bi ; \ No newline at end of file +: show-listener-popup ( interactor element popup -- ) + [ [ drop ] [ relevant-rect ] 2bi ] dip swap show-popup ; \ No newline at end of file