better focus protocol, fix problem with the first line in a pane
parent
06e0804b5b
commit
43348dd4c4
|
|
@ -50,9 +50,7 @@ TUPLE: editor line caret ;
|
||||||
[ line-text get x>offset caret set ] with-editor ;
|
[ line-text get x>offset caret set ] with-editor ;
|
||||||
|
|
||||||
: click-editor ( editor -- )
|
: click-editor ( editor -- )
|
||||||
hand
|
dup hand relative shape-x over set-caret-x request-focus ;
|
||||||
2dup relative shape-x pick set-caret-x
|
|
||||||
request-focus ;
|
|
||||||
|
|
||||||
: editor-actions ( editor -- )
|
: editor-actions ( editor -- )
|
||||||
[
|
[
|
||||||
|
|
|
||||||
|
|
@ -90,3 +90,11 @@ M: gadget layout*
|
||||||
GENERIC: user-input* ( ch gadget -- ? )
|
GENERIC: user-input* ( ch gadget -- ? )
|
||||||
|
|
||||||
M: gadget user-input* 2drop t ;
|
M: gadget user-input* 2drop t ;
|
||||||
|
|
||||||
|
GENERIC: focusable-child* ( gadget -- gadget/t )
|
||||||
|
|
||||||
|
M: gadget focusable-child* drop t ;
|
||||||
|
|
||||||
|
: focusable-child ( gadget -- gadget )
|
||||||
|
dup focusable-child*
|
||||||
|
dup t = [ drop ] [ nip focusable-child ] ifte ;
|
||||||
|
|
|
||||||
|
|
@ -104,8 +104,9 @@ C: hand ( world -- hand )
|
||||||
#! Called when a gadget is removed or added.
|
#! Called when a gadget is removed or added.
|
||||||
[ dup shape-x swap shape-y ] keep move-hand ;
|
[ dup shape-x swap shape-y ] keep move-hand ;
|
||||||
|
|
||||||
: request-focus ( gadget hand -- )
|
: request-focus ( gadget -- )
|
||||||
dup >r hand-focus
|
focusable-child
|
||||||
|
hand hand-focus
|
||||||
2dup lose-focus
|
2dup lose-focus
|
||||||
swap dup r> set-hand-focus
|
swap dup hand set-hand-focus
|
||||||
gain-focus ;
|
gain-focus ;
|
||||||
|
|
|
||||||
|
|
@ -22,6 +22,9 @@ global [
|
||||||
|
|
||||||
<plain-gadget> add-layer
|
<plain-gadget> add-layer
|
||||||
|
|
||||||
<console> "Stack display goes here" <label> <y-splitter>
|
<console> dup
|
||||||
|
"Stack display goes here" <label> <y-splitter>
|
||||||
3/4 over set-splitter-split add-layer
|
3/4 over set-splitter-split add-layer
|
||||||
|
|
||||||
|
request-focus
|
||||||
] bind
|
] bind
|
||||||
|
|
|
||||||
|
|
@ -70,11 +70,11 @@ C: pack ( align fill vector -- pack )
|
||||||
|
|
||||||
: <pile> { 0 1 0 } <pack> ;
|
: <pile> { 0 1 0 } <pack> ;
|
||||||
|
|
||||||
: <line-pile> 0 1 <pile> ;
|
: <line-pile> 0 0 <pile> ;
|
||||||
|
|
||||||
: <shelf> { 1 0 0 } <pack> ;
|
: <shelf> { 1 0 0 } <pack> ;
|
||||||
|
|
||||||
: <line-shelf> 0 1 <shelf> ;
|
: <line-shelf> 0 0 <shelf> ;
|
||||||
|
|
||||||
M: pack orientation pack-vector ;
|
M: pack orientation pack-vector ;
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -50,12 +50,15 @@ TUPLE: pane output active current input continuation ;
|
||||||
C: pane ( -- pane )
|
C: pane ( -- pane )
|
||||||
<line-pile> over set-delegate
|
<line-pile> over set-delegate
|
||||||
<line-pile> over add-output
|
<line-pile> over add-output
|
||||||
"" <label> over set-pane-current
|
<line-shelf> over set-pane-current
|
||||||
"" <editor> over set-pane-input
|
"" <editor> over set-pane-input
|
||||||
dup init-active-line
|
dup init-active-line
|
||||||
dup pane-paint
|
dup pane-paint
|
||||||
dup pane-actions ;
|
dup pane-actions ;
|
||||||
|
|
||||||
|
M: pane focusable-child* ( pane -- editor )
|
||||||
|
pane-input ;
|
||||||
|
|
||||||
: pane-write-1 ( style text pane -- )
|
: pane-write-1 ( style text pane -- )
|
||||||
[ <presentation> ] keep pane-current add-gadget ;
|
[ <presentation> ] keep pane-current add-gadget ;
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -32,6 +32,9 @@ M: viewport layout* ( viewport -- )
|
||||||
dup viewport-origin
|
dup viewport-origin
|
||||||
swap gadget-child dup prefer set-gadget-loc ;
|
swap gadget-child dup prefer set-gadget-loc ;
|
||||||
|
|
||||||
|
M: viewport focusable-child* ( viewport -- gadget )
|
||||||
|
gadget-child ;
|
||||||
|
|
||||||
: visible-portion ( viewport -- vector )
|
: visible-portion ( viewport -- vector )
|
||||||
dup shape-dim { 1 1 1 } vmax
|
dup shape-dim { 1 1 1 } vmax
|
||||||
swap viewport-dim { 1 1 1 } vmax
|
swap viewport-dim { 1 1 1 } vmax
|
||||||
|
|
@ -135,3 +138,6 @@ C: scroller ( gadget -- scroller )
|
||||||
dup scroller-viewport <x-slider> over add-x-slider
|
dup scroller-viewport <x-slider> over add-x-slider
|
||||||
dup scroller-viewport <y-slider> over add-y-slider
|
dup scroller-viewport <y-slider> over add-y-slider
|
||||||
dup scroller-actions ;
|
dup scroller-actions ;
|
||||||
|
|
||||||
|
M: scroller focusable-child* ( viewport -- gadget )
|
||||||
|
scroller-viewport ;
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue