From c09f91da6997293a476f6a27fd7f7fe252ca43a9 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 7 Jan 2009 12:18:42 -0600 Subject: [PATCH] Add right-click menu to tables, row-value word --- basis/ui/gadgets/tables/tables.factor | 35 +++++++++++++++++------ basis/ui/tools/inspector/inspector.factor | 9 +++++- basis/ui/tools/profiler/profiler.factor | 19 +++++++----- 3 files changed, 47 insertions(+), 16 deletions(-) diff --git a/basis/ui/gadgets/tables/tables.factor b/basis/ui/gadgets/tables/tables.factor index ee50e7bc0e..a1ab6ec496 100644 --- a/basis/ui/gadgets/tables/tables.factor +++ b/basis/ui/gadgets/tables/tables.factor @@ -3,16 +3,18 @@ USING: accessors arrays colors fry io.styles kernel math math.geometry.rect math.order math.vectors namespaces opengl sequences ui.gadgets ui.gadgets.scrollers ui.gadgets.status-bar -ui.gadgets.worlds ui.gadgets.theme ui.gestures ui.render models -math.ranges sequences combinators ; +ui.gadgets.worlds ui.gadgets.theme ui.gestures ui.render +ui.gadgets.menus models math.ranges sequences combinators ; IN: ui.gadgets.tables ! Row rendererer protocol GENERIC: row-columns ( row renderer -- columns ) +GENERIC: row-value ( row renderer -- object ) SINGLETON: trivial-renderer M: trivial-renderer row-columns drop ; +M: object row-value drop ; TUPLE: table < gadget renderer filled-column column-alignment action @@ -172,10 +174,11 @@ M: table pref-dim* over [ control-value nth ] [ 2drop f ] if ; : selected-row ( table -- value/f ) - [ selected-index>> ] keep nth-row ; + [ selected-index>> ] keep [ nth-row ] keep + over [ renderer>> row-value ] [ drop ] if ; : update-selected-value ( table -- ) - [ selected-row ] keep selected-value>> set-model ; + [ selected-row ] [ selected-value>> ] bi set-model ; M: table model-changed nip @@ -228,21 +231,37 @@ M: table model-changed : hide-mouse-help ( table -- ) f >>mouse-index [ hide-status ] [ relayout-1 ] bi ; +: valid-row? ( row table -- ? ) + control-value length 1- 0 swap between? ; + +: show-row-summary ( row table -- ) + [ renderer>> row-value ] keep show-summary ; + +: if-mouse-row ( table true false -- ) + [ [ mouse-row ] keep 2dup valid-row? ] + [ ] [ '[ nip @ ] ] tri* if ; inline + : show-mouse-help ( table -- ) - [ mouse-row ] keep - 2dup control-value length 1- 0 swap between? [ + [ [ swap >>mouse-index relayout-1 ] [ [ nth-row ] keep - over [ show-summary ] [ 2drop ] if + over [ show-row-summary ] [ 2drop ] if ] 2bi - ] [ nip hide-mouse-help ] if ; + ] [ hide-mouse-help ] if-mouse-row ; + +: table-operations-menu ( table -- ) + [ + [ nth-row ] keep [ renderer>> row-value ] keep + swap show-operations-menu + ] [ drop ] if-mouse-row ; table H{ { T{ mouse-enter } [ show-mouse-help ] } { T{ mouse-leave } [ hide-mouse-help ] } { T{ motion } [ show-mouse-help ] } { T{ button-down } [ table-button-down ] } + { T{ button-down f f 3 } [ table-operations-menu ] } { T{ button-up } [ table-button-up ] } { T{ gain-focus } [ t >>focused? drop ] } { T{ lose-focus } [ f >>focused? drop ] } diff --git a/basis/ui/tools/inspector/inspector.factor b/basis/ui/tools/inspector/inspector.factor index 3b356f4d7f..9dbde4209c 100644 --- a/basis/ui/tools/inspector/inspector.factor +++ b/basis/ui/tools/inspector/inspector.factor @@ -21,6 +21,9 @@ SINGLETON: inspector-renderer M: inspector-renderer row-columns drop [ key-string>> ] [ value-string>> ] bi 2array ; +M: inspector-renderer row-value + drop value>> ; + : ( model -- gadget ) [ standard-table-style [ @@ -52,7 +55,7 @@ DEFER: inspector : ( model -- table ) [ make-slot-descriptions ] - [ value>> inspector ] >>action + [ inspector ] >>action inspector-renderer >>renderer monospace-font >>font ; @@ -88,5 +91,9 @@ inspector-gadget "toolbar" f { { T{ key-down f f "F1" } inspector-help } } define-command-map +inspector-gadget "multi-touch" f { + { T{ up-action } com-refresh } +} define-command-map + : inspector ( obj -- ) "Inspector" open-status-window ; \ No newline at end of file diff --git a/basis/ui/tools/profiler/profiler.factor b/basis/ui/tools/profiler/profiler.factor index fd3c873f18..c37f0bd8b5 100644 --- a/basis/ui/tools/profiler/profiler.factor +++ b/basis/ui/tools/profiler/profiler.factor @@ -1,13 +1,14 @@ ! Copyright (C) 2007, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: ui.tools.browser kernel quotations accessors fry +USING: kernel quotations accessors fry assocs present math.order math.vectors arrays locals models.search models.sort models sequences vocabs -tools.profiler ui ui.commands ui.gadgets ui.gadgets.panes -ui.gadgets.scrollers ui.gadgets.tracks ui.gestures +tools.profiler words prettyprint ui ui.commands ui.gadgets +ui.gadgets.panes ui.gadgets.scrollers ui.gadgets.tracks ui.gestures ui.gadgets.buttons ui.gadgets.tables ui.gadgets.search-tables ui.gadgets.labelled ui.gadgets.buttons ui.gadgets.packs -ui.gadgets.labels ui.gadgets.tabbed words prettyprint ; +ui.gadgets.labels ui.gadgets.tabbed ui.gadgets.status-bar +ui.tools.browser ; FROM: models.filter => ; FROM: models.compose => ; IN: ui.tools.profiler @@ -25,19 +26,23 @@ SINGLETON: word-renderer M: word-renderer row-columns drop [ [ present ] map ] [ { "All" "" } ] if* ; +M: word-renderer row-value drop first ; + SINGLETON: method-renderer ! 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 ; + : ( values profiler -- model ) [ [ filter-counts ] ] [ sort>> ] bi* ; : ( profiler -- model ) [ [ words>> ] [ vocab>> ] bi - [ [ [ first vocabulary>> ] [ first ] bi* = ] when* ] + [ [ [ first vocabulary>> ] dip = ] when* ] ] keep ; : match? ( pair/f str -- ? ) @@ -62,7 +67,7 @@ M: method-renderer row-columns [ class-counters ] dip ; : method-matches? ( method generic class -- ? ) - [ dup [ first ] when ] tri@ + [ first ] 2dip [ drop dup [ subwords memq? ] [ 2drop t ] if ] [ nip dup [ swap "method-class" word-prop = ] [ 2drop t ] if ] 3bi and ; @@ -145,6 +150,6 @@ profiler-gadget "toolbar" f { } define-command-map : profiler-window ( -- ) - "Profiling results" open-window ; + "Profiling results" open-status-window ; MAIN: profiler-window \ No newline at end of file