]> gitweb.factorcode.org Git - factor.git/commitdiff
field fix
authorSlava Pestov <slava@factorcode.org>
Sat, 12 Feb 2005 00:11:31 +0000 (00:11 +0000)
committerSlava Pestov <slava@factorcode.org>
Sat, 12 Feb 2005 00:11:31 +0000 (00:11 +0000)
examples/gadget-test.factor
library/ui/fields.factor

index 9b47faa4da8b84f8dd14cc06fe0284614b3da393..8cea1637d4f8f2bf750a220bfceccd108505163b 100644 (file)
@@ -75,8 +75,8 @@ USE: words
     "Filled?" <checkbox> dup "filled" set "shelf" get add-gadget
     "shelf" get "pile" get add-gadget
     "Welcome to Factor " version cat2 <label> "pile" get add-gadget
-    "Welcome to Factor " version cat2 <label> <field> "pile" get add-gadget
-    "Welcome to Factor " version cat2 <label> <field> "pile" get add-gadget
+    "Welcome to Factor " version cat2 <field> "pile" get add-gadget
+    "Welcome to Factor " version cat2 <field> "pile" get add-gadget
 
     "pile" get bevel-border dup "dialog" set dup  
  moving-actions
index 40c9e7015a9e230cb06a13ffa212db9c213f7110..8e394d66e9730935d261c4645305219fba267fa9 100644 (file)
@@ -5,29 +5,33 @@ USING: generic kernel lists math namespaces sdl line-editor ;
 
 TUPLE: field active? delegate ;
 
-: field-border ( gadget -- border )
-    bevel-border dup f bevel-up? set-paint-property ;
-
-C: field ( delegate -- field )
-    [ >r field-border r> set-field-delegate ] keep
-    {{
-        [[ [ gain-focus ] [ dup blue foreground set-paint-property redraw ] ]]
-        [[ [ lose-focus ] [ dup black foreground set-paint-property redraw ] ]]
-        [[ [ button-down 1 ] [ my-hand request-focus ] ]]
-        [[ [ "RETURN" ] [ drop "foo!" USE: stdio print ] ]]
-    }} over set-gadget-gestures ;
-
 TUPLE: editor line delegate ;
 
-C: editor ( -- )
-    0 0 0 0 <rectangle> <gadget> over set-editor-delegate
-    [ <line-editor> set-editor-line ] keep ;
-
 : editor-text ( editor -- text )
     editor-line [ line-text get ] bind ;
 
+: set-editor-text ( text editor -- )
+    editor-line [ line-text set ] bind ;
+
+C: editor ( text -- )
+    0 0 0 0 <rectangle> <gadget> over set-editor-delegate
+    [ <line-editor> swap set-editor-line ] keep
+    [ set-editor-text ] keep ;
+
 M: editor layout* ( label -- )
     [ editor-text dup shape-w swap shape-h ] keep resize-gadget ;
 
 M: editor draw-shape ( label -- )
     dup [ editor-text draw-shape ] with-translation ;
+
+: field-border ( gadget -- border )
+    bevel-border dup f bevel-up? set-paint-property ;
+
+C: field ( text -- field )
+    [ >r <editor> field-border r> set-field-delegate ] keep
+    {{
+        [[ [ gain-focus ] [ dup blue foreground set-paint-property redraw ] ]]
+        [[ [ lose-focus ] [ dup black foreground set-paint-property redraw ] ]]
+        [[ [ button-down 1 ] [ my-hand request-focus ] ]]
+        [[ [ "RETURN" ] [ drop "foo!" USE: stdio print ] ]]
+    }} over set-gadget-gestures ;