basis/ui/tools/profiler/profiler.factor

   1 ! Copyright (C) 2007 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: ui.tools.workspace kernel quotations tools.profiler
   4 ui.commands ui.gadgets ui.gadgets.panes ui.gadgets.scrollers
   5 ui.gadgets.tracks ui.gestures ui.gadgets.buttons accessors fry ;
   6 IN: ui.tools.profiler
   7
   8 TUPLE: profiler-gadget < track pane ;
   9
  10 : <profiler-gadget> ( -- gadget )
  11     { 0 1 } profiler-gadget new-track
  12         add-toolbar
  13         <pane> >>pane
  14         dup pane>> <scroller> 1 track-add ;
  15
  16 : with-profiler-pane ( gadget quot -- )
  17     [ pane>> ] dip with-pane ;
  18
  19 : com-full-profile ( gadget -- )
  20     [ profile. ] with-profiler-pane ;
  21
  22 : com-vocabs-profile ( gadget -- )
  23     [ vocabs-profile. ] with-profiler-pane ;
  24
  25 : com-method-profile ( gadget -- )
  26     [ method-profile. ] with-profiler-pane ;
  27
  28 : profiler-help ( -- ) "ui-profiler" help-window ;
  29
  30 \ profiler-help H{ { +nullary+ t } } define-command
  31
  32 profiler-gadget "toolbar" f {
  33     { f com-full-profile }
  34     { f com-vocabs-profile }
  35     { f com-method-profile }
  36     { T{ key-down f f "F1" } profiler-help }
  37 } define-command-map
  38
  39 GENERIC: profiler-presentation ( obj -- quot )
  40
  41 M: usage-profile profiler-presentation
  42     word>> '[ _ usage-profile. ] ;
  43
  44 M: vocab-profile profiler-presentation
  45     vocab>> '[ _ vocab-profile. ] ;
  46
  47 M: f profiler-presentation
  48     drop [ vocabs-profile. ] ;
  49
  50 M: profiler-gadget call-tool* ( obj gadget -- )
  51     swap profiler-presentation with-profiler-pane ;