diff --git a/basis/ui/gadgets/line-support/line-support.factor b/basis/ui/gadgets/line-support/line-support.factor index ab44d45839..5d12d9e75c 100644 --- a/basis/ui/gadgets/line-support/line-support.factor +++ b/basis/ui/gadgets/line-support/line-support.factor @@ -65,14 +65,16 @@ GENERIC: draw-line ( line index gadget -- ) [ -1/0. or * ] [ 1/.0 or * ] bi-curry* bi [ max ] [ min ] bi* ; +: em ( font -- x ) "m" text-width ; + +PRIVATE> + : line-gadget-width ( pref-dim gadget -- w ) - [ first ] [ [ font>> "m" text-width ] [ min-cols>> ] [ max-cols>> ] tri ] bi* clamp ; + [ first ] [ [ font>> em ] [ min-cols>> ] [ max-cols>> ] tri ] bi* clamp ; : line-gadget-height ( pref-dim gadget -- h ) [ second ] [ [ line-height ] [ min-rows>> ] [ max-rows>> ] tri ] bi* clamp ; -PRIVATE> - M: line-gadget pref-viewport-dim [ pref-dim ] keep [ line-gadget-width ] diff --git a/basis/ui/gadgets/search-tables/search-tables.factor b/basis/ui/gadgets/search-tables/search-tables.factor index 44678c5cf1..24343c4180 100644 --- a/basis/ui/gadgets/search-tables/search-tables.factor +++ b/basis/ui/gadgets/search-tables/search-tables.factor @@ -1,10 +1,9 @@ ! Copyright (C) 2008, 2009 Slava Pestov ! See http://factorcode.org/license.txt for BSD license. -USING: accessors kernel delegate fry sequences -models models.search models.delay calendar locals -ui.gadgets.editors ui.gadgets.labels ui.gadgets.scrollers -ui.gadgets.tables ui.gadgets.tracks ui.gadgets.borders -ui.gadgets.buttons ui.gadgets ; +USING: accessors kernel delegate fry sequences models models.search +models.delay calendar locals ui.pens ui.pens.image ui.gadgets.editors +ui.gadgets.labels ui.gadgets.scrollers ui.gadgets.tables +ui.gadgets.tracks ui.gadgets.borders ui.gadgets.buttons ui.gadgets ; IN: ui.gadgets.search-tables TUPLE: search-field < track field ; @@ -12,14 +11,20 @@ TUPLE: search-field < track field ; : clear-search-field ( search-field -- ) field>> editor>> clear-editor ; +: <clear-button-pen> ( -- pen ) + "clear-button" theme-image <image-pen> dup + "clear-button-clicked" theme-image <image-pen> dup dup <button-pen> ; + : <clear-button> ( search-field -- button ) - "X" swap '[ drop _ clear-search-field ] <roll-button> ; + [ f ] dip '[ drop _ clear-search-field ] <button> + <clear-button-pen> >>interior + dup dup interior>> pen-pref-dim >>min-dim ; : <search-field> ( model -- gadget ) horizontal search-field new-track { 5 5 } >>gap +baseline+ >>align - swap <model-field> 10 >>min-width >>field + swap <model-field> 10 >>min-cols >>field dup field>> "Search:" label-on-left 1 track-add dup <clear-button> f track-add ; @@ -28,27 +33,32 @@ TUPLE: search-table < track table field ; ! A protocol with customizable slots SLOT-PROTOCOL: table-protocol renderer -filled-column -column-alignment action hook font +gap selection-color focus-border-color mouse-color column-line-color selection-required? -selected-value ; +single-click? +selected-value +min-rows +min-cols +max-rows +max-cols ; CONSULT: table-protocol search-table table>> ; -:: <search-table> ( values quot -- gadget ) +:: <search-table> ( values renderer quot -- gadget ) f <model> :> search vertical search-table new-track values >>model search <search-field> >>field dup field>> { 2 2 } <filled-border> f track-add - values search 500 milliseconds <delay> quot <search> <table> >>table + values search 500 milliseconds <delay> quot <search> + renderer <table> >>table dup table>> <scroller> 1 track-add ; M: search-table model-changed diff --git a/basis/ui/gadgets/tables/tables-tests.factor b/basis/ui/gadgets/tables/tables-tests.factor new file mode 100644 index 0000000000..11f080af0a --- /dev/null +++ b/basis/ui/gadgets/tables/tables-tests.factor @@ -0,0 +1,22 @@ +IN: ui.gadgets.tables.tests +USING: ui.gadgets.tables ui.gadgets.scrollers accessors +models namespaces tools.test kernel ; + +SINGLETON: test-renderer + +M: test-renderer row-columns drop ; + +M: test-renderer column-titles drop { "First" "Last" } ; + +[ ] [ + { + { "Britney" "Spears" } + { "Justin" "Timberlake" } + { "Don" "Stewart" } + } <model> test-renderer <table> + "table" set +] unit-test + +[ ] [ + "table" get <scroller> "scroller" set +] unit-test \ No newline at end of file diff --git a/basis/ui/gadgets/tables/tables.factor b/basis/ui/gadgets/tables/tables.factor index ac688a72f4..de967e1212 100644 --- a/basis/ui/gadgets/tables/tables.factor +++ b/basis/ui/gadgets/tables/tables.factor @@ -3,27 +3,34 @@ USING: accessors arrays colors colors.constants fry kernel math math.rectangles math.order math.vectors namespaces opengl sequences ui.gadgets ui.gadgets.scrollers ui.gadgets.status-bar -ui.gadgets.worlds ui.gestures ui.render ui.text ui.commands +ui.gadgets.worlds ui.gestures ui.render ui.pens.solid ui.text ui.commands ui.images ui.gadgets.menus ui.gadgets.line-support math.rectangles models math.ranges sequences combinators fonts locals strings ; IN: ui.gadgets.tables ! Row rendererer protocol GENERIC: prototype-row ( renderer -- columns ) +GENERIC: column-alignment ( renderer -- alignment ) +GENERIC: filled-column ( renderer -- n ) +GENERIC: column-titles ( renderer -- strings ) + GENERIC: row-columns ( row renderer -- columns ) GENERIC: row-value ( row renderer -- object ) GENERIC: row-color ( row renderer -- color ) SINGLETON: trivial-renderer -M: trivial-renderer row-columns drop ; M: object prototype-row drop { "" } ; +M: object column-alignment drop f ; +M: object filled-column drop f ; +M: object column-titles drop f ; + +M: trivial-renderer row-columns drop ; M: object row-value drop ; M: object row-color 2drop f ; TUPLE: table < line-gadget { renderer initial: trivial-renderer } -filled-column column-alignment { action initial: [ drop ] } single-click? { hook initial: [ ] } @@ -37,8 +44,9 @@ selected-index selected-value mouse-index focused? ; -: <table> ( rows -- table ) +: <table> ( rows renderer -- table ) table new-line-gadget + swap >>renderer swap >>model f <model> >>selected-value sans-serif-font >>font @@ -64,22 +72,30 @@ M: image-name draw-cell nip draw-image ; : column-offsets ( widths gap -- x xs ) [ 0 ] dip '[ _ + + ] accumulate ; -: initial-widths ( rows -- widths ) - first length 0 <repetition> ; +CONSTANT: column-title-background COLOR: light-gray -: row-column-widths ( font row -- widths ) - [ cell-width ] with map ; +: column-title-font ( font -- font' ) + column-title-background font-with-background t >>bold? ; -: (compute-column-widths) ( gap font rows -- total widths ) - [ 2drop 0 { } ] [ - [ nip initial-widths ] 2keep +: initial-widths ( table rows -- widths ) + over renderer>> column-titles dup + [ [ drop font>> ] dip [ text-width ] with map ] + [ drop nip first length 0 <repetition> ] + if ; + +: row-column-widths ( table row -- widths ) + [ font>> ] dip [ cell-width ] with map ; + +: compute-total-width ( gap widths -- total ) + swap [ column-offsets drop ] keep - ; + +: compute-column-widths ( table -- total widths ) + dup table-rows [ drop 0 { } ] [ + [ drop gap>> ] [ initial-widths ] [ ] 2tri [ row-column-widths vmax ] with each - [ swap [ column-offsets drop ] keep - ] keep + [ compute-total-width ] keep ] if-empty ; -: compute-column-widths ( table -- total-width column-widths ) - [ gap>> ] [ font>> ] [ table-rows ] tri (compute-column-widths) ; - : update-cached-widths ( table -- ) dup compute-column-widths [ >>total-width ] [ >>column-widths ] bi* @@ -90,7 +106,7 @@ M: image-name draw-cell nip draw-image ; : update-filled-column ( table -- ) [ filled-column-width ] - [ filled-column>> ] + [ renderer>> filled-column ] [ column-widths>> ] tri 2dup empty? not and [ [ + ] change-nth ] [ 3drop ] if ; @@ -158,8 +174,8 @@ M: table layout* ] dip ] dip translate-column ; -: column-alignment ( table -- seq ) - dup column-alignment>> +: table-column-alignment ( table -- seq ) + dup renderer>> column-alignment [ ] [ column-widths>> length 0 <repetition> ] ?if ; :: row-font ( row index table -- font ) @@ -167,17 +183,20 @@ M: table layout* row table renderer>> row-color [ >>foreground ] when* index table selected-index>> = [ table selection-color>> >>background ] when ; +: draw-columns ( columns widths alignment font gap -- ) + '[ [ _ ] 3dip _ draw-column ] 3each ; + M: table draw-line ( row index table -- ) [ nip [ renderer>> row-columns ] [ column-widths>> ] - [ column-alignment ] + [ table-column-alignment ] tri ] [ row-font ] [ 2nip gap>> ] 3tri - '[ [ _ ] 3dip _ draw-column ] 3each ; + draw-columns ; M: table draw-gadget* dup control-value empty? [ drop ] [ @@ -346,4 +365,31 @@ table "row" f { { T{ key-down f f "PAGE_DOWN" } next-page } } define-command-map +TUPLE: column-headers < gadget table ; + +: <column-headers> ( table -- gadget ) + column-headers new + swap >>table + column-title-background <solid> >>interior ; + +: draw-column-titles ( table -- ) + { + [ renderer>> column-titles ] + [ column-widths>> ] + [ table-column-alignment ] + [ font>> column-title-font ] + [ gap>> ] + } cleave + draw-columns ; + +M: column-headers draw-gadget* + table>> draw-column-titles ; + +M: column-headers pref-dim* + table>> [ pref-dim first ] [ font>> "" text-height ] bi 2array ; + +M: table viewport-column-header + dup renderer>> column-titles + [ <column-headers> ] [ drop f ] if ; + PRIVATE> \ No newline at end of file diff --git a/basis/ui/tools/debugger/debugger.factor b/basis/ui/tools/debugger/debugger.factor index 65f6e3def2..b20429291d 100644 --- a/basis/ui/tools/debugger/debugger.factor +++ b/basis/ui/tools/debugger/debugger.factor @@ -21,10 +21,9 @@ M: restart-renderer row-columns drop [ name>> ] [ "Abort" ] if* "• " prepend 1array ; : <restart-list> ( debugger -- gadget ) - dup restarts>> f prefix <model> <table> + dup restarts>> f prefix <model> restart-renderer <table> [ [ \ restart invoke-command ] when* ] >>action swap restart-hook>> >>hook - restart-renderer >>renderer t >>selection-required? t >>single-click? ; inline diff --git a/basis/ui/tools/inspector/inspector.factor b/basis/ui/tools/inspector/inspector.factor index cbdc346ac1..29eafb1401 100644 --- a/basis/ui/tools/inspector/inspector.factor +++ b/basis/ui/tools/inspector/inspector.factor @@ -27,6 +27,9 @@ M: inspector-renderer row-columns M: inspector-renderer row-value drop value>> ; +M: inspector-renderer column-titles + drop { "Key" "Value" } ; + : <summary-gadget> ( model -- gadget ) [ standard-table-style [ @@ -60,13 +63,13 @@ M: hashtable make-slot-descriptions call-next-method [ [ key-string>> ] compare ] sort ; : <inspector-table> ( model -- table ) - [ make-slot-descriptions ] <filter> <table> + [ make-slot-descriptions ] <filter> inspector-renderer <table> [ dup primary-operation invoke-command ] >>action - inspector-renderer >>renderer monospace-font >>font ; : <inspector-gadget> ( model -- gadget ) vertical inspector-gadget new-track + { 3 3 } >>gap add-toolbar swap >>model dup model>> <inspector-table> >>table diff --git a/basis/ui/tools/listener/completion/completion.factor b/basis/ui/tools/listener/completion/completion.factor index 4a938ac51c..ce61fcc0bc 100644 --- a/basis/ui/tools/listener/completion/completion.factor +++ b/basis/ui/tools/listener/completion/completion.factor @@ -136,8 +136,7 @@ GENERIC# accept-completion-hook 1 ( item popup -- ) : <completion-table> ( interactor completion-mode -- table ) [ completion-element ] [ completion-quot ] [ nip ] 2tri - [ <completion-model> <table> ] dip - >>renderer + [ <completion-model> ] dip <table> monospace-font >>font t >>selection-required? t >>single-click? diff --git a/basis/ui/tools/profiler/profiler.factor b/basis/ui/tools/profiler/profiler.factor index 3c4ce6470b..0e785303a4 100644 --- a/basis/ui/tools/profiler/profiler.factor +++ b/basis/ui/tools/profiler/profiler.factor @@ -35,14 +35,25 @@ M: profiler-renderer row-value M: vocab-renderer row-value call-next-method dup [ vocab ] when ; +M: profiler-renderer column-alignment drop { 0 1 } ; +M: profiler-renderer filled-column drop 0 ; + +M: word-renderer column-titles drop { "Word" "Count" } ; +M: vocab-renderer column-titles drop { "Vocabulary" "Count" } ; + SINGLETON: method-renderer +M: method-renderer column-alignment drop { 0 1 } ; +M: method-renderer filled-column drop 0 ; + ! Value is a { method-body count } pair M: method-renderer row-columns drop [ first synopsis ] [ second present ] bi 2array ; M: method-renderer row-value drop first ; +M: method-renderer column-titles drop { "Method" "Count" } ; + : <profiler-model> ( values profiler -- model ) [ [ filter-counts ] <filter> ] [ sort>> ] bi* <sort> ; @@ -61,10 +72,8 @@ M: method-renderer row-value drop first ; : match? ( pair/f str -- ? ) swap dup [ first present subseq? ] [ 2drop t ] if ; -: <profiler-table> ( model -- table ) - [ match? ] <search-table> - { 0 1 } >>column-alignment - 0 >>filled-column ; +: <profiler-table> ( model renderer -- table ) + [ match? ] <search-table> ; : <profiler-filter-model> ( counts profiler -- model' ) [ <model> ] dip <profiler-model> [ f prefix ] <filter> ; @@ -115,13 +124,11 @@ M: method-renderer row-value drop first ; :: <words-tab> ( profiler -- gadget ) horizontal <track> { 3 3 } >>gap - profiler vocabs>> <profiler-table> + profiler vocabs>> vocab-renderer <profiler-table> profiler vocab>> >>selected-value - vocab-renderer >>renderer "Vocabularies" <labeled-gadget> 1/2 track-add - profiler <words-model> <profiler-table> - word-renderer >>renderer + profiler <words-model> word-renderer <profiler-table> "Words" <labeled-gadget> 1/2 track-add ; @@ -130,19 +137,16 @@ M: method-renderer row-value drop first ; { 3 3 } >>gap horizontal <track> { 3 3 } >>gap - profiler <generic-model> <profiler-table> + profiler <generic-model> word-renderer <profiler-table> profiler generic>> >>selected-value - word-renderer >>renderer "Generic words" <labeled-gadget> 1/2 track-add - profiler <class-model> <profiler-table> + profiler <class-model> word-renderer <profiler-table> profiler class>> >>selected-value - word-renderer >>renderer "Classes" <labeled-gadget> 1/2 track-add 1/2 track-add - profiler methods>> <profiler-table> - method-renderer >>renderer + profiler methods>> method-renderer <profiler-table> "Methods" <labeled-gadget> 1/2 track-add ; diff --git a/basis/ui/tools/traceback/traceback.factor b/basis/ui/tools/traceback/traceback.factor index f85a1e201a..54f0de7e5c 100644 --- a/basis/ui/tools/traceback/traceback.factor +++ b/basis/ui/tools/traceback/traceback.factor @@ -21,10 +21,9 @@ M: stack-entry-renderer row-columns drop string>> 1array ; M: stack-entry-renderer row-value drop object>> ; : <stack-table> ( model -- table ) - [ [ <stack-entry> ] map ] <filter> <table> + [ [ <stack-entry> ] map ] <filter> stack-entry-renderer <table> monospace-font >>font [ i:inspector ] >>action - stack-entry-renderer >>renderer t >>single-click? ; : <stack-display> ( model quot title -- gadget )