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

basis/tools/profiler/profiler.factor

@@ -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 [

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

@@ -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"

basis/ui/gadgets/books/books.factor

@@ -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 >>model ; inline
-        swap add-gadgets ; 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 ;
 

basis/ui/gadgets/tabbed/tabbed.factor

@@ -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* ;

basis/ui/tools/profiler/profiler.factor

@@ -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>
+    [ match? ] <search-table> profile-renderer >>renderer ;
-    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>
+        <tabbed-gadget>
-                over vocabs>> <profiler-table>
+            over <words-tab> "Words" add-tab
-                    pick vocab>> >>selected-value
+            over <methods-tab> "Methods" add-tab
-                "Vocabularies" <labelled-gadget>
-            1/2 track-add
-                over <words-model> <profiler-table>
-                "Words" <labelled-gadget>
-            1/2 track-add
         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