Working on new profiler tool

diff --git a/basis/models/search/search.factor b/basis/models/search/search.factor
index 41d9b5769efe18e4fa571a68cc151ce58ce119ad..62e4db38acefee5ffdf1b4c69edb45f38922da4c 100644 (file)
--- a/basis/models/search/search.factor
+++ b/basis/models/search/search.factor
@@ -1,9 +1,8 @@
 ! Copyright (C) 2008 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays calendar fry kernel models.compose models.delay
-models.filter sequences ;
+USING: arrays fry kernel models.compose models.filter sequences ;
 IN: models.search
 
-: <search-model> ( values search quot -- model )
-    [ 500 milliseconds <delay> 2array <compose> ] dip
-    '[ first2 @ ] <filter> ;
\ No newline at end of file
+: <search> ( values search quot -- model )
+    [ 2array <compose> ] dip
+    '[ first2 _ curry filter ] <filter> ;
\ No newline at end of file

diff --git a/basis/models/sort/sort.factor b/basis/models/sort/sort.factor
new file mode 100644 (file)
index 0000000..cbced93
--- /dev/null
+++ b/basis/models/sort/sort.factor
@@ -0,0 +1,8 @@
+! Copyright (C) 2008 Slava Pestov
+! See http://factorcode.org/license.txt for BSD license.
+USING: arrays fry kernel models.compose models.filter
+sequences sorting ;
+IN: models.sort
+
+: <sort> ( values sort -- model )
+    2array <compose> [ first2 sort ] <filter> ;
\ No newline at end of file

diff --git a/basis/tools/profiler/profiler.factor b/basis/tools/profiler/profiler.factor
index 83915363749f6ef62dfed14c2903cba72b80a153..8ddeb3897f96f11c186da900cd6bb8685c4331d3 100644 (file)
--- a/basis/tools/profiler/profiler.factor
+++ b/basis/tools/profiler/profiler.factor
@@ -3,45 +3,26 @@
 USING: accessors words sequences math prettyprint kernel arrays io
 io.styles namespaces assocs kernel.private strings combinators
 sorting math.parser vocabs definitions tools.profiler.private
-continuations generic compiler.units sets ;
+continuations generic compiler.units sets classes ;
 IN: tools.profiler
 
 : profile ( quot -- )
     [ t profiling call ] [ f profiling ] [ ] cleanup ;
 
-: counters ( words -- assoc )
-    [ dup counter>> ] { } map>assoc ;
+: counters ( words -- alist )
+    [ dup counter>> ] { } map>assoc [ second 0 > ] filter ;
 
-GENERIC: (profile.) ( obj -- )
-
-TUPLE: usage-profile word ;
-
-C: <usage-profile> usage-profile
-
-M: word (profile.)
-    [ name>> "( no name )" or ] [ <usage-profile> ] bi write-object ;
-
-TUPLE: vocab-profile vocab ;
-
-C: <vocab-profile> vocab-profile
-
-M: string (profile.)
-    dup <vocab-profile> write-object ;
-
-M: method-body (profile.)
-    [ synopsis ] [ "method-generic" word-prop <usage-profile> ] bi
-    write-object ;
-
-: counter. ( obj n -- )
-    [
-        [ [ (profile.) ] with-cell ] dip
-        [ number>string write ] with-cell
-    ] with-row ;
+: vocab-counters ( -- alist )
+    vocabs [
+        dup
+        words
+        [ predicate? not ] filter
+        [ counter>> ] sigma
+    ] { } map>assoc ;
 
 : counters. ( assoc -- )
-    [ second 0 > ] filter sort-values
     standard-table-style [
-        [ counter. ] assoc-each
+        sort-values simple-table.
     ] tabular-output ;
 
 : profile. ( -- )
@@ -65,11 +46,7 @@ M: method-body (profile.)
 
 : vocabs-profile. ( -- )
     "Call counts for all vocabularies:" print
-    vocabs [
-        dup words
-        [ "predicating" word-prop not ] filter
-        [ counter>> ] map sum
-    ] { } map>assoc counters. ;
+    vocab-counters counters. ;
 
 : method-profile. ( -- )
     all-words [ subwords ] map concat

diff --git a/basis/ui/gadgets/buttons/buttons.factor b/basis/ui/gadgets/buttons/buttons.factor
index 75469671ef14ed47afb7358a84768e3cfc9b0037..f237a427a28e5f96828705fc7b440fb0f13c050b 100644 (file)
--- a/basis/ui/gadgets/buttons/buttons.factor
+++ b/basis/ui/gadgets/buttons/buttons.factor
@@ -197,12 +197,11 @@ M: radio-paint draw-boundary
     GL_LINE_STRIP 0 circle-steps 1+ glDrawArrays ;
 
 :: radio-knob-theme ( gadget -- gadget )
-    [let | radio-paint [ black <radio-paint> ] |
-        gadget
-        f f radio-paint radio-paint <button-paint> >>interior
-        radio-paint >>boundary
-        { 16 16 } >>dim
-    ] ;
+    black <radio-paint> :> radio-paint
+    gadget
+    f f radio-paint radio-paint <button-paint> >>interior
+    radio-paint >>boundary
+    { 16 16 } >>dim ;
 
 : <radio-knob> ( -- gadget )
     <gadget> radio-knob-theme ;
@@ -221,8 +220,8 @@ M: radio-control model-changed
     over value>> = >>selected?
     relayout-1 ;
 
-: <radio-controls> ( assoc model parent quot: ( value model label -- ) -- parent )
-    '[ _ swap _ call add-gadget ] assoc-each ; inline
+: <radio-controls> ( assoc model parent quot: ( value model label -- gadget ) -- parent )
+    '[ _ swap @ add-gadget ] assoc-each ; inline
 
 : radio-button-theme ( gadget -- gadget )
     { 5 5 } >>gap

diff --git a/basis/ui/gadgets/panes/panes-tests.factor b/basis/ui/gadgets/panes/panes-tests.factor
index 8627f7fbfe2b72f0b560f0507f7b0095c8d700ce..1c5123703504fd55ec43be1e6942ae77540c27a1 100644 (file)
--- a/basis/ui/gadgets/panes/panes-tests.factor
+++ b/basis/ui/gadgets/panes/panes-tests.factor
@@ -2,7 +2,7 @@ USING: alien ui.gadgets.panes ui.gadgets namespaces
 kernel sequences io io.styles io.streams.string tools.test
 prettyprint definitions help help.syntax help.markup
 help.stylesheet splitting tools.test.ui models math summary
-inspector accessors ;
+inspector accessors help.topics ;
 IN: ui.gadgets.panes.tests
 
 : #children "pane" get children>> length ;
@@ -79,6 +79,14 @@ IN: ui.gadgets.panes.tests
     ] test-gadget-text
 ] unit-test
 
+[ t ] [
+    [
+        last-element off
+        \ = >link $title
+        "Hello world" print-content
+    ] test-gadget-text
+] unit-test
+
 ARTICLE: "test-article-1" "This is a test article"
 "Hello world, how are you today." ;
 

diff --git a/basis/ui/gadgets/search-tables/search-tables.factor b/basis/ui/gadgets/search-tables/search-tables.factor
index 6110657542f386c090b367f40af767901a31f7ab..508d01dc12b7ef4cc7faaee0ccb8f5f35974b6b6 100644 (file)
--- a/basis/ui/gadgets/search-tables/search-tables.factor
+++ b/basis/ui/gadgets/search-tables/search-tables.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors kernel delegate fry sequences
-models models.search locals
+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 ;
@@ -38,7 +38,7 @@ CONSULT: table-protocol search-table table>> ;
         values >>model
         search <search-field> >>field
         dup field>> 2 <filled-border> f track-add
-        values search quot <search-model> <table> >>table
+        values search 500 milliseconds <delay> quot <search> <table> >>table
         dup table>> <scroller> 1 track-add ;
 
 M: search-table model-changed

diff --git a/basis/ui/gadgets/tables/tables.factor b/basis/ui/gadgets/tables/tables.factor
index b83b8e26bc63fb08c1b0ac26934925b903511310..5c247672400a000afc447008684fc64ebf2d3c81 100644 (file)
--- a/basis/ui/gadgets/tables/tables.factor
+++ b/basis/ui/gadgets/tables/tables.factor
@@ -41,7 +41,7 @@ CONSTANT: table-gap 5
 
 : column-widths ( font rows -- total widths )
     [ drop 0 { } ] [
-        tuck [ length 0 <repetition> ] 2dip [
+        tuck [ first length 0 <repetition> ] 2dip [
             [ string-width ] with map vmax
         ] with each
         0 [ table-gap + + ] accumulate

diff --git a/basis/ui/tools/operations/operations.factor b/basis/ui/tools/operations/operations.factor
index a9405424dc283d72cd1f4f49cce790fb9e5d29b2..6f83a43a66b27604691fcfe8cbd9e33a044fb9fe 100644 (file)
--- a/basis/ui/tools/operations/operations.factor
+++ b/basis/ui/tools/operations/operations.factor
@@ -167,20 +167,13 @@ M: word com-stack-effect def>> com-stack-effect ;
     { +listener+ t }
 } define-operation
 
-: com-show-profile ( workspace -- )
-    profiler-gadget call-tool ;
-
-: com-profile ( quot -- ) profile f com-show-profile ;
+: com-profile ( quot -- ) profile f profiler-window ;
 
 [ quotation? ] \ com-profile H{
     { +keyboard+ T{ key-down f { C+ } "r" } }
     { +listener+ t }
 } define-operation
 
-! Profiler presentations
-[ dup usage-profile? swap vocab-profile? or ]
-\ com-show-profile H{ { +primary+ t } } define-operation
-
 ! Operations -> commands
 source-editor
 "word"

diff --git a/basis/ui/tools/profiler/profiler.factor b/basis/ui/tools/profiler/profiler.factor
index 7280efe8850a2b3389b5ec391cbca2f55b5687ef..b2d14e10bf8880b575e42bf4f44deb72964da29c 100644 (file)
--- a/basis/ui/tools/profiler/profiler.factor
+++ b/basis/ui/tools/profiler/profiler.factor
@@ -1,51 +1,83 @@
-! Copyright (C) 2007 Slava Pestov.
+! Copyright (C) 2007, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: ui.tools.workspace kernel quotations tools.profiler
-ui.commands ui.gadgets ui.gadgets.panes ui.gadgets.scrollers
-ui.gadgets.tracks ui.gestures ui.gadgets.buttons accessors fry ;
+USING: ui.tools.workspace kernel quotations accessors fry
+assocs present math math.order math.vectors arrays
+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 ;
+FROM: models.filter => <filter> ;
+FROM: models.compose => <compose> ;
 IN: ui.tools.profiler
 
-TUPLE: profiler-gadget < track pane ;
+TUPLE: profiler-gadget < track sort vocabs vocab words ;
 
-: <profiler-gadget> ( -- gadget )
-    { 0 1 } profiler-gadget new-track
-        add-toolbar
-        <pane> >>pane
-        dup pane>> <scroller> 1 track-add ;
+SINGLETON: profile-renderer
+
+! Value is a { word count } pair
+M: profile-renderer row-columns
+    drop [ [ present ] map ] [ { "All" "" } ] if* ;
+
+: <profiler-model> ( values profiler -- model )
+    [ [ [ second 0 > ] filter ] <filter> ] [ sort>> ] bi* <sort> ;
+
+: <words-model> ( profiler -- model )
+    [
+        [ words>> ] [ vocab>> ] bi
+        [ [ [ first vocabulary>> ] [ first ] bi* = ] when* ] <search>
+    ] keep <profiler-model> ;
+
+: <profiler-table> ( model -- table )
+    [ swap dup [ first present subseq? ] [ 2drop t ] if ] <search-table>
+    profile-renderer >>renderer ;
 
-: with-profiler-pane ( gadget quot -- )
-    [ pane>> ] dip with-pane ;
+: <vocab-model> ( profiler -- model )
+    [ vocab-counters <model> ] dip
+    <profiler-model> [ f prefix ] <filter> ;
 
-: com-full-profile ( gadget -- )
-    [ profile. ] with-profiler-pane ;
+: sort-options ( -- alist )
+    {
+        { [ [ first ] compare ] "by name" }
+        { [ [ second ] compare invert-comparison ] "by call count" }
+    } ;
 
-: com-vocabs-profile ( gadget -- )
-    [ vocabs-profile. ] with-profiler-pane ;
+: <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 ;
 
-: com-method-profile ( gadget -- )
-    [ method-profile. ] with-profiler-pane ;
+: <profiler-gadget> ( -- profiler )
+    { 0 1 } profiler-gadget new-track
+        [ [ first ] compare ] <model> >>sort
+        all-words counters <model> >>words
+        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
+        1 track-add ;
+
+M: profiler-gadget pref-dim* call-next-method { 700 400 } vmax ;
 
 : profiler-help ( -- ) "ui-profiler" help-window ;
 
 \ profiler-help H{ { +nullary+ t } } define-command
 
 profiler-gadget "toolbar" f {
-    { f com-full-profile }
-    { f com-vocabs-profile }
-    { f com-method-profile }
     { T{ key-down f f "F1" } profiler-help }
 } define-command-map
 
-GENERIC: profiler-presentation ( obj -- quot )
-
-M: usage-profile profiler-presentation
-    word>> '[ _ usage-profile. ] ;
-
-M: vocab-profile profiler-presentation
-    vocab>> '[ _ vocab-profile. ] ;
-
-M: f profiler-presentation
-    drop [ vocabs-profile. ] ;
+: profiler-window ( -- )
+    <profiler-gadget> "Profiler" open-window ;
 
-M: profiler-gadget call-tool* ( obj gadget -- )
-    swap profiler-presentation with-profiler-pane ;
+MAIN: profiler-window
\ No newline at end of file

diff --git a/basis/ui/tools/tools-docs.factor b/basis/ui/tools/tools-docs.factor
index 8e1cc8d8f06b592e829a4428ec28dd525ab14bbc..2b20b8fbff4f0dcc596ad7c8c5aa59f40de1b1cd 100644 (file)
--- a/basis/ui/tools/tools-docs.factor
+++ b/basis/ui/tools/tools-docs.factor
@@ -62,7 +62,9 @@ ARTICLE: "ui-profiler" "UI profiler"
 $nl
 "To use the profiler, enter a piece of code in the listener input area and press " { $operation com-profile } "."
 $nl
-"Vocabulary and word presentations in the profiler pane can be clicked on to show profiler results pertaining to the object in question. Clicking a vocabulary in the profiler yields the same output as the " { $link vocab-profile. } " word, and clicking a word yields the same output as the " { $link usage-profile. } " word. Consult " { $link "profiling" } " for details."
+"Clicking on a vocabulary in the vocabulary list narrows down the word list to only include words from that vocabulary. The sorting options control the order of elements in the vocabulary and word lists. The search fields narrow down the list to only include words or vocabularies whose names contain a substring."
+$nl
+"Consult " { $link "profiling" } " for details about the profiler itself."
 { $command-map profiler-gadget "toolbar" } ;
 
 ARTICLE: "ui-cocoa" "Functionality specific to Mac OS X"

diff --git a/basis/ui/tools/tools.factor b/basis/ui/tools/tools.factor
index 9927f9e5ae9353683012f132d177cab5d3105b38..45cb67ba730e5bb84cd8f2d15125f9d7508c3727 100644 (file)
--- a/basis/ui/tools/tools.factor
+++ b/basis/ui/tools/tools.factor
@@ -2,14 +2,14 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays assocs debugger ui.tools.workspace
 ui.tools.operations ui.tools.traceback ui.tools.browser
-ui.tools.inspector ui.tools.listener ui.tools.profiler
-ui.tools.operations inspector io kernel math models namespaces
-prettyprint quotations sequences ui ui.commands ui.gadgets
+ui.tools.inspector ui.tools.listener
+ui.tools.operations ui ui.commands ui.gadgets
 ui.gadgets.books ui.gadgets.buttons ui.gadgets.labelled
 ui.gadgets.scrollers ui.gadgets.tracks ui.gadgets.worlds
 ui.gadgets.presentations ui.gestures words vocabs.loader
 tools.test tools.vocabs ui.gadgets.buttons ui.gadgets.status-bar
-mirrors fry ;
+mirrors fry inspector io kernel math models namespaces
+prettyprint quotations sequences ;
 IN: ui.tools
 
 : <workspace-tabs> ( workspace -- tabs )
@@ -22,8 +22,7 @@ IN: ui.tools
         <gadget>
         <browser-gadget>
         <inspector-gadget>
-        <profiler-gadget>
-    4array
+    3array
     swap model>> <book> ;
   
 : <workspace> ( -- workspace )
@@ -62,13 +61,10 @@ M: workspace model-changed
 
 : com-inspector ( workspace -- ) 2 select-tool ;
 
-: com-profiler ( workspace -- ) 3 select-tool ;
-
 workspace "tool-switching" f {
     { T{ key-down f { A+ } "1" } com-listener }
     { T{ key-down f { A+ } "2" } com-browser }
     { T{ key-down f { A+ } "3" } com-inspector }
-    { T{ key-down f { A+ } "4" } com-profiler }
 } define-command-map
 
 workspace "multi-touch" f {