diff --git a/basis/ui/gadgets/search-tables/search-tables.factor b/basis/ui/gadgets/search-tables/search-tables.factor index fc564b6ffe..9f55c7a67d 100644 --- a/basis/ui/gadgets/search-tables/search-tables.factor +++ b/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 diff --git a/basis/ui/gadgets/tables/tables-docs.factor b/basis/ui/gadgets/tables/tables-docs.factor index 4f016caa8a..81e5f0f778 100644 --- a/basis/ui/gadgets/tables/tables-docs.factor +++ b/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 "selected-indices" } " - the indices of the currently selected rows." } + { { $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 "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." diff --git a/basis/ui/gadgets/tables/tables.factor b/basis/ui/gadgets/tables/tables.factor index 353dd91270..c5cd144f18 100644 --- a/basis/ui/gadgets/tables/tables.factor +++ b/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 -selected-indices* +selection +selection-index +selected-indices mouse-index { takes-focus? initial: t } focused? multiple-selection? ; -: in>out ( array -- val/f ) [ f ] [ first ] if-empty ; -: 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 ] ; -M: table (>>selected-value) [ [ out>in ] ] 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 ] ; -M: table (>>selected-index*) [ [ out>in ] ] dip (>>selected-indices*) ; +> index - [ drop ] [ over selected-indices>> swap suffix natural-sort >>selected-indices ] if ; +: push-selected-index ( table n -- table ) swap [ insert-sorted prune >array ] change-selected-indices ; +: multiple>single ( values -- value/f ? ) [ f f ] [ first t ] if-empty ; +: 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 - { } >>selected-values - { } >>selected-indices* sans-serif-font >>font focus-border-color >>focus-border-color - transparent >>column-line-color ; inline + transparent >>column-line-color + f >>selection-index + f >>selection ; : ( 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 ; > ] bi set-model ] - [ [ selected-indices>> ] [ selected-indices*>> ] bi set-model ] bi ; +: set-table-model ( model value multiple? -- ) [ multiple>single* ] unless swap set-model ; + +: 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 ; > ] dip '[ _ + ] [ 0 ] if* select-row ; + [ dup selected-index ] dip '[ _ + ] [ 0 ] if* select-row ; : previous-row ( table -- ) -1 prev/next-row ; diff --git a/basis/ui/tools/error-list/error-list.factor b/basis/ui/tools/error-list/error-list.factor index e9d4b50bac..1193ca237c 100644 --- a/basis/ui/tools/error-list/error-list.factor +++ b/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 ; diff --git a/extra/recipes/recipes.factor b/extra/recipes/recipes.factor index 7fd7dc559c..5681e4395e 100644 --- a/extra/recipes/recipes.factor +++ b/extra/recipes/recipes.factor @@ -39,7 +39,7 @@ STORED-TUPLE: recipe { title { VARCHAR 100 } } { votes INTEGER } { txt TEXT } { ->% 1 :> search submit ok [ [ drop ] ] <$ 2array merge [ drop ] >>value :> quot viewed 0 [ + ] fold search ok t "all" 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 ] if-empty top-recipes ] 3fmap :> ups ups [ top-genres [ GENRES -> ] map merge ] bind* diff --git a/extra/sequences/extras/extras.factor b/extra/sequences/extras/extras.factor index d8e5e45d3b..5256bea5ce 100644 --- a/extra/sequences/extras/extras.factor +++ b/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 \ No newline at end of file + [ 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 ; \ No newline at end of file diff --git a/extra/ui/gadgets/controls/controls.factor b/extra/ui/gadgets/controls/controls.factor index 26c6184d4c..649c9052fd 100644 --- a/extra/ui/gadgets/controls/controls.factor +++ b/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 >>selected-values V{ } clone >>selected-indices* - f >>actions dup [ actions>> set-model ] curry >>action ; + f >>actions dup actions>> [ set-model ] curry >>action ; :
( model -- table ) table new-table ; : ( -- table ) V{ } clone
; : ( column-model -- table )
[ 1array ] >>quot ; @@ -66,9 +65,7 @@ SYNTAX: IMG-BTN: image-prep [ swap