better focus protocol, fix problem with the first line in a pane

cvs
Slava Pestov 2005-07-04 22:36:07 +00:00
parent 06e0804b5b
commit 43348dd4c4
7 changed files with 29 additions and 10 deletions

View File

@ -50,9 +50,7 @@ TUPLE: editor line caret ;
[ line-text get x>offset caret set ] with-editor ;
: click-editor ( editor -- )
hand
2dup relative shape-x pick set-caret-x
request-focus ;
dup hand relative shape-x over set-caret-x request-focus ;
: editor-actions ( editor -- )
[

View File

@ -90,3 +90,11 @@ M: gadget layout*
GENERIC: user-input* ( ch gadget -- ? )
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 ;

View File

@ -104,8 +104,9 @@ C: hand ( world -- hand )
#! Called when a gadget is removed or added.
[ dup shape-x swap shape-y ] keep move-hand ;
: request-focus ( gadget hand -- )
dup >r hand-focus
: request-focus ( gadget -- )
focusable-child
hand hand-focus
2dup lose-focus
swap dup r> set-hand-focus
swap dup hand set-hand-focus
gain-focus ;

View File

@ -22,6 +22,9 @@ global [
<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
request-focus
] bind

View File

@ -70,11 +70,11 @@ C: pack ( align fill vector -- pack )
: <pile> { 0 1 0 } <pack> ;
: <line-pile> 0 1 <pile> ;
: <line-pile> 0 0 <pile> ;
: <shelf> { 1 0 0 } <pack> ;
: <line-shelf> 0 1 <shelf> ;
: <line-shelf> 0 0 <shelf> ;
M: pack orientation pack-vector ;

View File

@ -50,12 +50,15 @@ TUPLE: pane output active current input continuation ;
C: pane ( -- pane )
<line-pile> over set-delegate
<line-pile> over add-output
"" <label> over set-pane-current
<line-shelf> over set-pane-current
"" <editor> over set-pane-input
dup init-active-line
dup pane-paint
dup pane-actions ;
M: pane focusable-child* ( pane -- editor )
pane-input ;
: pane-write-1 ( style text pane -- )
[ <presentation> ] keep pane-current add-gadget ;

View File

@ -32,6 +32,9 @@ M: viewport layout* ( viewport -- )
dup viewport-origin
swap gadget-child dup prefer set-gadget-loc ;
M: viewport focusable-child* ( viewport -- gadget )
gadget-child ;
: visible-portion ( viewport -- vector )
dup shape-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 <y-slider> over add-y-slider
dup scroller-actions ;
M: scroller focusable-child* ( viewport -- gadget )
scroller-viewport ;