diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index 9899013844..6c233faa46 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -17,6 +17,7 @@ + ui: - editor: + - delegation issue with fields and interactors - multi-line inserts - scroll to caret - only redraw visible lines diff --git a/library/ui/gadgets/panes.factor b/library/ui/gadgets/panes.factor index 1832bd09f2..3f03a8bf6e 100644 --- a/library/ui/gadgets/panes.factor +++ b/library/ui/gadgets/panes.factor @@ -1,25 +1,23 @@ ! Copyright (C) 2005, 2006 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. IN: gadgets-panes -USING: arrays gadgets gadgets-buttons gadgets-controls -gadgets-frames gadgets-grids gadgets-labels gadgets-scrolling -gadgets-theme generic hashtables io kernel math namespaces -sequences strings ; +USING: gadgets gadgets-buttons gadgets-controls gadgets-labels +gadgets-scrolling gadgets-theme generic hashtables io kernel +namespaces sequences ; -TUPLE: pane output active current prototype scrolls? ; +TUPLE: pane output current prototype scrolls? ; : add-output 2dup set-pane-output add-gadget ; -: init-line ( pane -- ) - dup pane-prototype clone swap set-pane-current ; +: add-current 2dup set-pane-current add-gadget ; : prepare-line ( pane -- ) - dup init-line dup pane-active unparent - [ pane-current 1array make-shelf ] keep - 2dup set-pane-active add-gadget ; + dup pane-prototype clone swap add-current ; : pane-clear ( pane -- ) - dup pane-output clear-incremental pane-current clear-gadget ; + dup + pane-output clear-incremental + pane-current clear-gadget ; C: pane ( -- pane ) over set-delegate @@ -58,11 +56,7 @@ C: pane ( -- pane ) M: pane stream-flush ( pane -- ) drop ; : scroll-pane ( pane -- ) - dup pane-scrolls? [ - find-scroller [ scroll>bottom ] when* - ] [ - drop - ] if ; + dup pane-scrolls? [ scroll>bottom ] [ drop ] if ; M: pane stream-terpri ( pane -- ) dup pane-current prepare-print diff --git a/library/ui/gadgets/scrolling.factor b/library/ui/gadgets/scrolling.factor index 20517b941f..57a9cb24b3 100644 --- a/library/ui/gadgets/scrolling.factor +++ b/library/ui/gadgets/scrolling.factor @@ -16,12 +16,6 @@ TUPLE: scroller viewport x y follows ; : find-scroller [ scroller? ] find-parent ; -: scroll>gadget ( gadget -- ) - #! Scroll the scroller that contains this gadget, if any, so - #! that the gadget becomes visible. - dup find-scroller dup - [ [ set-scroller-follows ] keep relayout ] [ 2drop ] if ; - : scroll-up-line scroller-y -1 swap slide-by-line ; : scroll-down-line scroller-y 1 swap slide-by-line ; @@ -63,15 +57,15 @@ C: scroller ( gadget -- scroller ) dupd over scroller-y update-slider position-viewport ; -: scroll>bottom ( scroller -- ) - t swap set-scroller-follows ; +: scroll>bottom ( gadget -- ) + find-scroller [ t swap set-scroller-follows ] when* ; : update-scroller ( scroller -- ) - dup scroller-follows [ + dup dup scroller-follows [ f over set-scroller-follows - dup rect-dim { 0 1 } v* + scroller-viewport viewport-dim { 0 1 } v* ] [ - drop dup scroller-origin + scroller-origin ] if scroll ; M: scroller layout* ( scroller -- ) diff --git a/library/ui/tools/listener.factor b/library/ui/tools/listener.factor index f9814c2720..42eb8c4e09 100644 --- a/library/ui/tools/listener.factor +++ b/library/ui/tools/listener.factor @@ -27,23 +27,34 @@ TUPLE: listener-gadget input output stack ; [ >r clear r> init-namespaces listener-thread ] in-thread drop ; -: ( -- gadget ) - gadget get listener-gadget-output ; - : ( model quot title -- gadget ) >r r> f ; : ( model title -- gadget ) [ stack. ] swap ; -: ( -- gadget ) - gadget get listener-gadget-stack "Stack" ; +: ( listener -- gadget ) + listener-gadget-input "Input" f ; + +: ( listener -- gadget ) + listener-gadget-stack "Stack" ; + +: ( listener -- gadget ) + dup { + { [ ] f f 1/2 } + { [ ] f f 1/2 } + } { 1 0 } make-track ; + +: init-listener ( listener -- ) + f over set-listener-gadget-stack + over set-listener-gadget-output + dup listener-gadget-output + swap set-listener-gadget-input ; C: listener-gadget ( -- gadget ) - f over set-listener-gadget-stack { - { [ ] set-listener-gadget-output [ ] 4/6 } - { [ ] set-listener-gadget-input [ ] 1/6 } - { [ ] f f 1/6 } + dup init-listener { + { [ gadget get listener-gadget-output ] f f 5/6 } + { [ gadget get ] f f 1/6 } } { 0 1 } make-track* dup start-listener ; M: listener-gadget pref-dim*