Merge branch 'master' of git://factorcode.org/git/factor

basis/ui/gadgets/grid-lines/grid-lines-docs.factor

@@ -3,4 +3,4 @@ ui.render ;
 IN: ui.gadgets.grid-lines
 
 HELP: grid-lines
-{ $class-description "A class implementing the " { $link draw-boundary } " generic word to draw lines between the cells of a " { $link grid } ". The color of the lines is a color specifier stored in the " { $link grid-lines-color } " slot." } ;
+{ $class-description "A class implementing the " { $link draw-boundary } " generic word to draw lines between the cells of a " { $link grid } ". The color of the lines is a color specifier stored in the " { $snippet "color" } " slot." } ;

basis/ui/gadgets/grid-lines/grid-lines.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2006, 2007 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel math namespaces opengl opengl.gl sequences
+USING: kernel accessors math namespaces opengl opengl.gl sequences
 math.vectors ui.gadgets ui.gadgets.grids ui.render math.geometry.rect ;
 IN: ui.gadgets.grid-lines
 
@@ -10,7 +10,7 @@ C: <grid-lines> grid-lines
 
 SYMBOL: grid-dim
 
-: half-gap grid get grid-gap [ 2/ ] map ; inline
+: half-gap grid get gap>> [ 2/ ] map ; inline
 
 : grid-line-from/to ( orientation point -- from to )
     half-gap v-
@@ -25,7 +25,7 @@ SYMBOL: grid-dim
 M: grid-lines draw-boundary
     origin get [
         -0.5 -0.5 0.0 glTranslated
-        grid-lines-color set-color [
+        color>> set-color [
             dup grid set
             dup rect-dim half-gap v- grid-dim set
             compute-grid

basis/ui/gadgets/grids/grids-docs.factor

@@ -14,9 +14,9 @@ ARTICLE: "ui-grid-layout" "Grid layouts"
 HELP: grid
 { $class-description "A grid gadget lays out its children so that all gadgets in a column have equal width and all gadgets in a row have equal height."
 $nl
-"The " { $link grid-gap } " slot stores a pair of integers, the horizontal and vertical gap between children, respectively."
+"The " { $snippet "gap" } " slot stores a pair of integers, the horizontal and vertical gap between children, respectively."
 $nl
-"The " { $link grid-fill? } " slot stores a boolean, indicating if grid cells should assume their preferred size, or if they should fill the dimensions of the cell. The default is " { $link t } "."
+"The " { $snippet "fill?" } " slot stores a boolean, indicating if grid cells should assume their preferred size, or if they should fill the dimensions of the cell. The default is " { $link t } "."
 $nl
 "Grids are created by calling " { $link <grid> } " and children are managed with " { $link grid-add } " and " { $link grid-remove } "."
 $nl

basis/ui/gadgets/grids/grids.factor

@@ -48,7 +48,7 @@ grid
     dupd add-gaps dim-sum v+ ;
 
 M: grid pref-dim*
-    dup grid-gap swap compute-grid >r over r>
+    dup gap>> swap compute-grid >r over r>
     gap-sum >r gap-sum r> (pair-up) ;
 
 : do-grid ( dims grid quot -- )
@@ -57,7 +57,7 @@ M: grid pref-dim*
     drop ; inline
 
 : grid-positions ( grid dims -- locs )
-    >r grid-gap dup r> add-gaps swap [ v+ ] accumulate nip ;
+    >r gap>> dup r> add-gaps swap [ v+ ] accumulate nip ;
 
 : position-grid ( grid horiz vert -- )
     pick >r
@@ -65,7 +65,7 @@ M: grid pref-dim*
     pair-up r> [ set-rect-loc ] do-grid ;
 
 : resize-grid ( grid horiz vert -- )
-    pick grid-fill? [
+    pick fill?>> [
         pair-up swap [ (>>dim) ] do-grid
     ] [
         2drop grid>> [ [ prefer ] each ] each

basis/ui/gadgets/incremental/incremental.factor

@@ -24,20 +24,20 @@ TUPLE: incremental < pack cursor ;
 
 M: incremental pref-dim*
     dup layout-state>> [
-        dup call-next-method over set-incremental-cursor
+        dup call-next-method over (>>cursor)
-    ] when incremental-cursor ;
+    ] when cursor>> ;
 
 : next-cursor ( gadget incremental -- cursor )
     [
-        swap rect-dim swap incremental-cursor
+        swap rect-dim swap cursor>>
         2dup v+ >r vmax r>
     ] keep orientation>> set-axis ;
 
 : update-cursor ( gadget incremental -- )
-    [ next-cursor ] keep set-incremental-cursor ;
+    [ next-cursor ] keep (>>cursor) ;
 
 : incremental-loc ( gadget incremental -- )
-    dup incremental-cursor swap orientation>> v*
+    dup cursor>> swap orientation>> v*
     swap set-rect-loc ;
 
 : prefer-incremental ( gadget -- )
@@ -57,5 +57,5 @@ M: incremental pref-dim*
     not-in-layout
     dup (clear-gadget)
     dup forget-pref-dim
-    { 0 0 } over set-incremental-cursor
+    { 0 0 } over (>>cursor)
     parent>> [ relayout ] when* ;

basis/ui/gadgets/labelled/labelled.factor

@@ -16,7 +16,7 @@ TUPLE: labelled-gadget < track content ;
     swap >>content
     dup content>> 1 track-add ;
 
-M: labelled-gadget focusable-child* labelled-gadget-content ;
+M: labelled-gadget focusable-child* content>> ;
 
 : <labelled-scroller> ( gadget title -- gadget )
     >r <scroller> r> <labelled-gadget> ;
@@ -53,4 +53,4 @@ TUPLE: closable-gadget < frame content ;
     swap >>content
     dup content>> @center grid-add ;
     
-M: closable-gadget focusable-child* closable-gadget-content ;
+M: closable-gadget focusable-child* content>> ;

basis/ui/gadgets/labels/labels.factor

@@ -14,9 +14,9 @@ TUPLE: label < gadget text font color ;
 
 : set-label-string ( string label -- )
     CHAR: \n pick memq? [
-        >r string-lines r> set-label-text
+        >r string-lines r> (>>text)
     ] [
-        set-label-text
+        (>>text)
     ] if ; inline
 
 : label-theme ( gadget -- gadget )

basis/ui/gadgets/lists/lists.factor

@@ -27,8 +27,8 @@ TUPLE: list < pack index presenter color hook ;
     control-value length 1- min 0 max ;
 
 : bound-index ( list -- )
-    dup list-index over calc-bounded-index
+    dup index>> over calc-bounded-index
-    swap set-list-index ;
+    swap (>>index) ;
 
 : list-presentation-hook ( list -- quot )
     hook>> [ [ list? ] find-parent ] prepend ;
@@ -53,18 +53,18 @@ M: list model-changed
     bound-index ;
 
 : selected-rect ( list -- rect )
-    dup list-index swap children>> ?nth ;
+    dup index>> swap children>> ?nth ;
 
 M: list draw-gadget*
     origin get [
-        dup list-color set-color
+        dup color>> set-color
         selected-rect [ rect-extent gl-fill-rect ] when*
     ] with-translation ;
 
 M: list focusable-child* drop t ;
 
 : list-value ( list -- object )
-    dup list-index swap control-value ?nth ;
+    dup index>> swap control-value ?nth ;
 
 : scroll>selected ( list -- )
     #! We change the rectangle's width to zero to avoid
@@ -79,22 +79,22 @@ M: list focusable-child* drop t ;
         2drop
     ] [
         [ control-value length rem ] keep
-        [ set-list-index ] keep
+        [ (>>index) ] keep
         [ relayout-1 ] keep
         scroll>selected
     ] if ;
 
 : select-previous ( list -- )
-    dup list-index 1- swap select-index ;
+    dup index>> 1- swap select-index ;
 
 : select-next ( list -- )
-    dup list-index 1+ swap select-index ;
+    dup index>> 1+ swap select-index ;
 
 : invoke-value-action ( list -- )
     dup list-empty? [
-        dup list-hook call
+        dup hook>> call
     ] [
-        dup list-index swap nth-gadget invoke-secondary
+        dup index>> swap nth-gadget invoke-secondary
     ] if ;
 
 : select-gadget ( gadget list -- )

basis/ui/gadgets/panes/panes.factor

@@ -173,7 +173,7 @@ M: pane-stream make-span-stream
     >r pick at r> when* ; inline
 
 : apply-foreground-style ( style gadget -- style gadget )
-    foreground [ over set-label-color ] apply-style ;
+    foreground [ over (>>color) ] apply-style ;
 
 : apply-background-style ( style gadget -- style gadget )
     background [ solid-interior ] apply-style ;
@@ -184,7 +184,7 @@ M: pane-stream make-span-stream
     font-size swap at 12 or 3array ;
 
 : apply-font-style ( style gadget -- style gadget )
-    over specified-font over set-label-font ;
+    over specified-font over (>>font) ;
 
 : apply-presentation-style ( style gadget -- style gadget )
     presented [ <presentation> ] apply-style ;
@@ -255,7 +255,7 @@ M: pane-stream make-block-stream
 
 ! Tables
 : apply-table-gap-style ( style grid -- style grid )
-    table-gap [ over set-grid-gap ] apply-style ;
+    table-gap [ over (>>gap) ] apply-style ;
 
 : apply-table-border-style ( style grid -- style grid )
     table-border [ <grid-lines> over (>>boundary) ]
@@ -263,7 +263,7 @@ M: pane-stream make-block-stream
 
 : styled-grid ( style grid -- grid )
     <grid>
-    f over set-grid-fill?
+    f over (>>fill?)
     apply-table-gap-style
     apply-table-border-style
     nip ;