steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

New ui.gadgets.tabbed vocab, working on 'Methods' tab in profiler tool

db4
Slava Pestov 2008-12-22 05:40:38 -06:00
parent c1f50f0ad6
commit a39a644362
5 changed files with 78 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
basis/tools/profiler/profiler.factor
View File

@ -9,8 +9,11 @@ IN: tools.profiler
: profile ( quot -- )
[ t profiling call ] [ f profiling ] [ ] cleanup ;
: filter-counts ( alist -- alist' )
[ second 0 > ] filter ;
: counters ( words -- alist )
[ dup counter>> ] { } map>assoc [ second 0 > ] filter ;
[ dup counter>> ] { } map>assoc filter-counts ;
: vocab-counters ( -- alist )
vocabs [

12
basis/ui/gadgets/books/books-docs.factor
View File

@ -8,11 +8,17 @@ $nl
HELP: <book>
{ $values { "pages" "a sequence of gadgets" } { "model" model } { "book" book } }
{ $description "Creates a " { $link book } " control, which contains the gadgets in " { $snippet "pages" } ". A book shows one child at a time, determined by the value of the model, which must be an integer " } ;
{ $description "Creates a " { $link book } " control, which contains the gadgets in " { $snippet "pages" } "." } ;
HELP: <empty-book>
{ $values { "model" model } { "book" book } }
{ $description "Creates a " { $link book } " control with no children." }
{ $notes "Children must be added to the book before it is grafted, otherwise an error will be thrown." } ;
ARTICLE: "ui-book-layout" "Book layouts"
"Books can contain any number of children, and display one child at a time."
"Books can contain any number of children, and display one child at a time. The currently visible child is determined by the value of the model, which must be an integer."
{ $subsection book }
{ $subsection <book> } ;
{ $subsection <book> }
{ $subsection <empty-book> } ;
ABOUT: "ui-book-layout"

11
basis/ui/gadgets/books/books.factor
View File

@ -16,12 +16,15 @@ M: book model-changed ( model book -- )
dup current-page show-gadget
relayout ;
: new-book ( pages model class -- book )
: new-book ( model class -- book )
new-gadget
swap >>model
swap add-gadgets ; inline
swap >>model ; inline
: <book> ( pages model -- book ) book new-book ;
: <book> ( pages model -- book )
book new-book swap add-gadgets ;
: <empty-book> ( model -- book )
book new-book ;
M: book pref-dim* ( book -- dim ) children>> pref-dims max-dim ;

25
basis/ui/gadgets/tabbed/tabbed.factor Normal file
View File

@ -0,0 +1,25 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: ui.gadgets.tracks ui.gadgets.buttons ui.gadgets.books
ui.gadgets.packs ui.gadgets sequences models accessors kernel ;
IN: ui.gadgets.tabbed
TUPLE: tabbed-gadget < track tabs book ;
: <tabbed-gadget> ( -- gadget )
{ 0 1 } tabbed-gadget new-track
0 <model> >>model
<shelf> >>tabs
dup tabs>> f track-add
dup model>> <empty-book> >>book
dup book>> 1 track-add ;
: add-tab/book ( tabbed child -- tabbed )
[ dup book>> ] dip add-gadget drop ;
: add-tab/button ( tabbed label -- tabbed )
[ [ dup tabs>> dup children>> length ] [ model>> ] bi ] dip
<toggle-button> add-gadget drop ;
: add-tab ( tabbed child label -- tabbed )
[ add-tab/book ] [ add-tab/button ] bi* ;

48
basis/ui/tools/profiler/profiler.factor
View File

@ -1,13 +1,13 @@
! Copyright (C) 2007, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: ui.tools.workspace kernel quotations accessors fry
assocs present math math.order math.vectors arrays
assocs present math 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
ui.gadgets.buttons ui.gadgets.tables ui.gadgets.search-tables
ui.gadgets.labelled ui.gadgets.buttons ui.gadgets.packs
ui.gadgets.labels ;
ui.gadgets.labels ui.gadgets.tabbed ;
FROM: models.filter => <filter> ;
FROM: models.compose => <compose> ;
IN: ui.tools.profiler
@ -21,7 +21,7 @@ M: profile-renderer row-columns
drop [ [ present ] map ] [ { "All" "" } ] if* ;
: <profiler-model> ( values profiler -- model )
[ [ [ second 0 > ] filter ] <filter> ] [ sort>> ] bi* <sort> ;
[ [ filter-counts ] <filter> ] [ sort>> ] bi* <sort> ;
: <words-model> ( profiler -- model )
[
@ -29,9 +29,11 @@ M: profile-renderer row-columns
[ [ [ first vocabulary>> ] [ first ] bi* = ] when* ] <search>
] keep <profiler-model> ;
: match? ( pair/f str -- ? )
swap dup [ first present subseq? ] [ 2drop t ] if ;
: <profiler-table> ( model -- table )
[ swap dup [ first present subseq? ] [ 2drop t ] if ] <search-table>
profile-renderer >>renderer ;
[ match? ] <search-table> profile-renderer >>renderer ;
: <vocab-model> ( profiler -- model )
[ vocab-counters <model> ] dip
@ -43,12 +45,33 @@ M: profile-renderer row-columns
{ [ [ second ] compare invert-comparison ] "by call count" }
} ;
: <sort-options> ( model -- gadget )
sort-options <radio-buttons> { 1 0 } >>orientation ;
: <profiler-tool-bar> ( profiler -- gadget )
<shelf>
{ 5 5 } >>gap
over <toolbar> add-gadget
"Sort by:" <label> add-gadget
swap sort>> sort-options <radio-buttons> { 1 0 } >>orientation add-gadget ;
swap sort>> <sort-options> add-gadget ;
:: <words-tab> ( profiler -- gadget )
{ 1 0 } <track>
profiler vocabs>> <profiler-table>
profiler vocab>> >>selected-value
"Vocabularies" <labelled-gadget>
1/2 track-add
profiler <words-model> <profiler-table>
"Words" <labelled-gadget>
1/2 track-add ;
:: <methods-tab> ( profiler -- gadget )
{ 0 1 } <track>
{ 1 0 } <track>
f <model> <profiler-table> "Generic words" <labelled-gadget> 1/2 track-add
f <model> <profiler-table> "Classes" <labelled-gadget> 1/2 track-add
1/2 track-add
f <model> <profiler-table> "Methods" <labelled-gadget> 1/2 track-add ;
: <profiler-gadget> ( -- profiler )
{ 0 1 } profiler-gadget new-track
@ -57,14 +80,9 @@ M: profile-renderer row-columns
dup <vocab-model> >>vocabs
{ f 0 } <model> >>vocab
dup <profiler-tool-bar> f track-add
{ 1 0 } <track>
over vocabs>> <profiler-table>
pick vocab>> >>selected-value
"Vocabularies" <labelled-gadget>
1/2 track-add
over <words-model> <profiler-table>
"Words" <labelled-gadget>
1/2 track-add
<tabbed-gadget>
over <words-tab> "Words" add-tab
over <methods-tab> "Methods" add-tab
1 track-add ;
M: profiler-gadget pref-dim* call-next-method { 700 400 } vmax ;
@ -78,6 +96,6 @@ profiler-gadget "toolbar" f {
} define-command-map
: profiler-window ( -- )
<profiler-gadget> "Profiler" open-window ;
<profiler-gadget> "Profiling results" open-window ;
MAIN: profiler-window