simplified ui.gadgets.tables

basis/ui/gadgets/search-tables/search-tables.factor

@@ -58,7 +58,7 @@ mouse-color
 column-line-color
 selection-required?
 single-click?
-selected-value
+selection
 min-rows
 min-cols
 max-rows

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

@@ -16,19 +16,17 @@ $nl
 { $subsection column-titles } ;
 
 ARTICLE: "ui.gadgets.tables.selection" "Table row selection"
-"At any given time, a single row in the table may be selected."
-$nl
 "A few slots in the table gadget concern row selection:"
 { $table
-  { { $slot "selected-values" } { " - if set to a model, an array of the currently selected rows' values, as determined by a " { $link row-value } " call to the renderer, is stored in this model. See " { $link "models" } "." } }
+  { { $slot "selection" } { " - if set to a model, the values of the currently selected row or rows, as determined by a " { $link row-value } " call to the renderer, is stored in this model. See " { $link "models" } "." } }
-  { { $slot "selected-indices" } " - the indices of the currently selected rows." }
+  { { $slot "selection-index" } { " - if set to a model, the indices of the currently selected rows." } }
   { { $slot "selection-required?" } { " - if set to a true value, the table ensures that some row is always selected, if the model is non-empty. If set to " { $link f } ", a state where nothing is selected is permitted to occur. The default is " { $link f } "." } }
   { { $slot "multiple-selection?" } { " - if set to a true value, users are allowed to select more than one value." } }
-
 }
 "Some words for row selection:"
 { $subsection selected-rows }
-{ $subsection (selected-rows) } ;
+{ $subsection (selected-rows) }
+{ $subsection selected } ;
 
 ARTICLE: "ui.gadgets.tables.actions" "Table row actions"
 "When the user double-clicks on a row, or presses " { $command table "row" row-action } " while a row is selected, optional action and hook quotations are invoked. The action receives the row value and the hook receives the table gadget itself. These quotations are stored in the " { $slot "action" } " and " { $snippet "hook" } " slots of a table, respectively."

basis/ui/gadgets/tables/tables.factor

@@ -7,7 +7,7 @@ ui.gadgets.scrollers ui.gadgets.status-bar ui.gadgets.worlds
 ui.gestures ui.render ui.pens.solid ui.text ui.commands ui.images
 ui.gadgets.menus ui.gadgets.line-support models
 combinators combinators.short-circuit
-fonts locals strings sorting ;
+fonts locals strings sequences.extras sets ;
 IN: ui.gadgets.tables
 
 ! Row rendererer protocol
@@ -42,40 +42,33 @@ focus-border-color
 { mouse-color initial: COLOR: black }
 column-line-color
 selection-required?
-selected-indices selected-values
+selection
-selected-indices*
+selection-index
+selected-indices
 mouse-index
 { takes-focus? initial: t }
 focused?
 multiple-selection? ;
 
-: in>out ( array -- val/f ) [ f ] [ first ] if-empty ;
+<PRIVATE
-: out>in ( val/f -- array ) [ 1array ] [ { } ] if* ;
-IN: accessors
-SLOT: selected-value
-SLOT: selected-index
-SLOT: selected-index*
-M: table selected-value>> selected-values>> [ in>out ] <illusion> ;
-M: table (>>selected-value) [ [ out>in ] <activated-illusion> ] dip (>>selected-values) ;
-M: table selected-index>> selected-indices>> in>out ;
-M: table (>>selected-index) [ out>in ] dip (>>selected-indices) ;
-M: table selected-index*>> selected-indices*>> [ in>out ] <illusion> ;
-M: table (>>selected-index*) [ [ out>in ] <activated-illusion> ] dip (>>selected-indices*) ;
 
-IN: ui.gadgets.tables
+: push-selected-index ( table n -- table ) swap [ insert-sorted prune >array ] change-selected-indices ;
-: push-selected-index ( table n -- table ) 2dup swap selected-indices>> index
+: multiple>single ( values -- value/f ? ) [ f f ] [ first t ] if-empty ;
-   [ drop ] [ over selected-indices>> swap suffix natural-sort >>selected-indices ] if ;
+: multiple>single* ( values -- value/f ) multiple>single drop ;
+: selected-index ( table -- n ) selected-indices>> multiple>single* ;
+: set-selected-index ( table n -- table ) 1array >>selected-indices ;
+PRIVATE>
+: selected ( table -- index/indices ) dup multiple-selection?>> [ selected-indices>> ] [ selected-index ] if ;
 
 : new-table ( rows renderer class -- table )
     new-line-gadget
         swap >>renderer
         swap >>model
-        { } >>selected-indices
-        { } <model> >>selected-values
-        { } <model> >>selected-indices*
         sans-serif-font >>font
         focus-border-color >>focus-border-color
-        transparent >>column-line-color ; inline
+        transparent >>column-line-color
+        f <model> >>selection-index
+        f <model> >>selection ;
 
 : <table> ( rows renderer -- table ) table new-table ;
 
@@ -165,9 +158,9 @@ M: table layout*
 : draw-focused-row ( table -- )
     {
         { [ dup focused?>> not ] [ drop ] }
-        { [ dup selected-index>> not ] [ drop ] }
+        { [ dup selected-index not ] [ drop ] }
         [
-            [ ] [ selected-index>> ] [ focus-border-color>> gl-color ] tri
+            [ ] [ selected-index ] [ focus-border-color>> gl-color ] tri
             row-bounds gl-rect
         ]
     } cond ;
@@ -264,16 +257,16 @@ PRIVATE>
 
 : selected-rows ( table -- {value} )
     [ (selected-rows) ] [ renderer>> ] bi [ row-value ] curry map ;
-
-: multiple>single ( values -- value/f ? ) [ f f ] [ first t ] if-empty ;
 : (selected-row) ( table -- value/f ? ) (selected-rows) multiple>single ;
 : selected-row ( table -- value/f ? ) selected-rows multiple>single ;
 
 <PRIVATE
 
-: update-selected-values ( table -- )
+: set-table-model ( model value multiple? -- ) [ multiple>single* ] unless swap set-model ;
-    [ [ selected-rows ] [ selected-values>> ] bi set-model ]
+
-    [ [ selected-indices>> ] [ selected-indices*>> ] bi set-model ] bi ;
+: update-selected ( table -- )
+    [ [ selection>> ] [ selected-rows ] [ multiple-selection?>> ] tri set-table-model ]
+    [ [ selection-index>> ] [ selected-indices>> ] [ multiple-selection?>> ] tri set-table-model ] bi ;
 
 : show-row-summary ( table n -- )
     over nth-row
@@ -295,7 +288,7 @@ PRIVATE>
     } 1&& ;
 
 : (update-selected-indices) ( table -- {n}/f )
-    [ selected-values>> value>> ] keep
+    [ selection>> value>> dup array? [ 1array ] unless ] keep
     [ find-row-index ] curry map [ ] filter [ f ] when-empty ;
 
 : update-selected-indices ( table -- {n}/f )
@@ -308,7 +301,7 @@ M: table model-changed
     nip dup update-selected-indices [ { } ] unless* {
         [ >>selected-indices f >>mouse-index drop ]
         [ [ f ] [ first ] if-empty show-row-summary ]
-        [ drop update-selected-values ]
+        [ drop update-selected ]
         [ drop relayout ]
     } 2cleave ;
 
@@ -324,7 +317,7 @@ M: table model-changed
 
 : (select-row) ( table n -- )
     [ scroll-to-row ]
-    [ >>selected-index relayout-1 ]
+    [ set-selected-index relayout-1 ]
     2bi ;
 
 : mouse-row ( table -- n )
@@ -341,7 +334,7 @@ M: table model-changed
 : table-button-down ( table -- ) [ (select-row) ] swap (table-button-down) ;
 : continued-button-down ( table -- ) dup multiple-selection?>> [ [ add-selected-row ] swap (table-button-down) ] [ table-button-down ] if ;
 : thru-button-down ( table -- ) dup multiple-selection?>> [
-    [ 2dup over selected-index>> (a,b) swap
+    [ 2dup over selected-index (a,b) swap
       [ swap push-selected-index drop ] curry each add-selected-row ]
     swap (table-button-down) ] [ table-button-down ] if ;
 
@@ -360,7 +353,7 @@ PRIVATE>
 
 : table-button-up ( table -- )
     dup [ mouse-row ] keep valid-line? [
-        dup row-action? [ row-action ] [ update-selected-values ] if
+        dup row-action? [ row-action ] [ update-selected ] if
     ] [ drop ] if ;
 
 PRIVATE>
@@ -368,14 +361,14 @@ PRIVATE>
 : select-row ( table n -- )
     over validate-line
     [ (select-row) ]
-    [ drop update-selected-values ]
+    [ drop update-selected ]
     [ show-row-summary ]
     2tri ;
 
 <PRIVATE
 
 : prev/next-row ( table n -- )
-    [ dup selected-index>> ] dip '[ _ + ] [ 0 ] if* select-row ;
+    [ dup selected-index ] dip '[ _ + ] [ 0 ] if* select-row ;
     
 : previous-row ( table -- )
     -1 prev/next-row ;

basis/ui/tools/error-list/error-list.factor

@@ -71,7 +71,7 @@ M: source-file-renderer filled-column drop 1 ;
         60 >>min-cols
         60 >>max-cols
         t >>selection-required?
-        error-list source-file>> >>selected-value ;
+        error-list source-file>> >>selection ;
 
 SINGLETON: error-renderer
 
@@ -120,7 +120,7 @@ M: error-renderer column-alignment drop { 0 1 0 0 } ;
         60 >>min-cols
         60 >>max-cols
         t >>selection-required?
-        error-list error>> >>selected-value ;
+        error-list error>> >>selection ;
 
 TUPLE: error-display < track ;
 

extra/recipes/recipes.factor

@@ -39,7 +39,7 @@ STORED-TUPLE: recipe { title { VARCHAR 100 } } { votes INTEGER } { txt TEXT } {
       <spacer> <model-field*> ->% 1 :> search
       submit ok [ [ drop ] ] <$ 2array merge [ drop ] >>value :> quot
       viewed 0 [ + ] fold search ok t <basic> "all" <model-btn> ALL ->
-      tbl selected-value>> votes [ [ + ] curry change-votes modify-tuple ] 2$>
+      tbl selection>> votes [ [ + ] curry change-votes modify-tuple ] 2$>
         4array merge
         [ drop [ f ] [ "%" dup surround <pattern> ] if-empty top-recipes ] 3fmap :> ups
       ups [ top-genres [ <model-btn> GENRES -> ] map merge ] bind*

extra/sequences/extras/extras.factor

@@ -16,4 +16,6 @@ IN: sequences.extras
 
 :: combos ( list1 list2 -- result ) list2 [ [ 2array ] curry list1 swap map ] map concat ;
 : find-all ( seq quot -- elts ) [ [ length iota ] keep ] dip
-    [ dupd call( a -- ? ) [ 2array ] [ 2drop f ] if ] curry 2map [ ] filter ; inline
+    [ dupd call( a -- ? ) [ 2array ] [ 2drop f ] if ] curry 2map [ ] filter ; inline
+
+: insert-sorted ( elt seq -- seq ) 2dup [ < ] with find drop over length or swap insert-nth ;

extra/ui/gadgets/controls/controls.factor

@@ -24,8 +24,7 @@ M: table tbl:row-value val-quot>> [ call( a -- b ) ]  [ drop f ] if* ;
 M: table tbl:row-color color-quot>> [ call( a -- b ) ]  [ drop f ] if* ;
 
 : new-table ( model class -- table ) f swap tbl:new-table dup >>renderer
-   V{ } clone <basic> >>selected-values V{ } clone <basic> >>selected-indices*
+   f <basic> >>actions dup actions>> [ set-model ] curry >>action ;
-   f <basic> >>actions dup [ actions>> set-model ] curry >>action ;
 : <table> ( model -- table ) table new-table ;
 : <table*> ( -- table ) V{ } clone <model> <table> ;
 : <list> ( column-model -- table ) <table> [ 1array ] >>quot ;
@@ -66,9 +65,7 @@ SYNTAX: IMG-BTN: image-prep [ swap <button> ] curry over push-all ;
 
 GENERIC: output-model ( gadget -- model )
 M: gadget output-model model>> ;
-M: table output-model dup multiple-selection?>>
+M: table output-model dup val-quot>> [ selection>> ] [ selection-index>> ] if ;
-   [ dup val-quot>> [ selected-values>> ] [ selected-indices*>> ] if ]
-   [ dup val-quot>> [ selected-value>> ] [ selected-index*>> ] if ] if ;
 M: model-field output-model model*>> ;
 M: scroller output-model viewport>> children>> first output-model ;
 M: slider output-model model>> range-model ;