]> gitweb.factorcode.org Git - factor.git/commitdiff
better focus protocol, fix problem with the first line in a pane
authorSlava Pestov <slava@factorcode.org>
Mon, 4 Jul 2005 22:36:07 +0000 (22:36 +0000)
committerSlava Pestov <slava@factorcode.org>
Mon, 4 Jul 2005 22:36:07 +0000 (22:36 +0000)
library/ui/editors.factor
library/ui/gadgets.factor
library/ui/hand.factor
library/ui/init-world.factor
library/ui/layouts.factor
library/ui/panes.factor
library/ui/scrolling.factor

index dd5762609f09a91448c95bf42e88e79c05c5c680..f114215629578d81d3edd97cc98acc5bd4c19f6e 100644 (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 -- )
     [
index 146b97ce8e8ffcd942c82d835710046e1bb7df50..b48ba5553d41e1dc23c0b5b418f8cd361126382f 100644 (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 ;
index 957e8b590082bad331d8e9711806089436e698dd..073fcc1bc05975b2b94b22826549b85ed937d7ad 100644 (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 ;
index 8474ff434f9b4353e14a799e39b5afc749881378..10791ef1eb6ebaf5731a86a05ece91447163adad 100644 (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
index 34497a6fc8e4d94522499a3428d49d3f2e71dc12..f6aa142855617c5aaf16056ad5d39e5ef4a52c1c 100644 (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 ;
 
index 05cf9bfda0565296c22e40c865a8b54f88942a9a..4d994f0dd6d6ede568d728488df25ce6516c1082 100644 (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 ;
 
index f378350b3f13aeb818132802a79eb82356393e07..876e78f52b3f14177f24696038ed7052cb1e10dc 100644 (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 ;