"
 COPYRIGHT (c) 2006 by eXept Software AG
	      All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"
"{ Package: 'stx:libtool' }"

"{ NameSpace: Tools }"

NavigatorModel subclass:#VisualProfilerCanvas
	instanceVariableNames:'profilerStatistics selectedMethods packageFilter
		perspectiveSpecHolder callTreeHolder selectedCallTreeItemHolder
		methodList'
	classVariableNames:''
	poolDictionaries:''
	category:'Interface-Browsers-New-Profiler'
!

HierarchicalItem subclass:#CallTreeItem
	instanceVariableNames:'subjects'
	classVariableNames:''
	poolDictionaries:''
	privateIn:VisualProfilerCanvas
!

!VisualProfilerCanvas class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) 2006 by eXept Software AG
	      All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"
! !

!VisualProfilerCanvas class methodsFor:'interface specs'!

callTreeSpec
    "This resource specification was automatically generated
     by the UIPainter of ST/X."

    "Do not manually edit this!! If it is corrupted,
     the UIPainter may not be able to read the specification."

    "
     UIPainter new openOnClass:Tools::VisualProfilerCanvas andSelector:#callTreeSpec
     Tools::VisualProfilerCanvas new openInterface:#callTreeSpec
    "

    <resource: #canvas>

    ^ 
     #(FullSpec
        name: callTreeSpec
        window: 
       (WindowSpec
          label: 'Visual Profiler - Call Tree'
          name: 'Visual Profiler - Call Tree'
          min: (Point 10 10)
          bounds: (Rectangle 0 0 300 300)
        )
        component: 
       (SpecCollection
          collection: (
           (HierarchicalListViewSpec
              name: 'CallTree'
              layout: (LayoutFrame 0 0 0 0 0 1 0 1)
              model: selectedCallTreeItemHolder
              hasHorizontalScrollBar: true
              hasVerticalScrollBar: true
              listModel: callTreeHolder
              useIndex: false
              highlightMode: line
              useDefaultIcons: false
            )
           )
         
        )
      )

    "Modified: / 10-10-2007 / 08:51:10 / janfrog"
!

methodListSpec
    "This resource specification was automatically generated
     by the UIPainter of ST/X."

    "Do not manually edit this!! If it is corrupted,
     the UIPainter may not be able to read the specification."

    "
     UIPainter new openOnClass:Tools::VisualProfilerCanvas andSelector:#methodListSpec
     Tools::VisualProfilerCanvas new openInterface:#methodListSpec
    "

    <resource: #canvas>

    ^ 
     #(FullSpec
        name: methodListSpec
        window: 
       (WindowSpec
          label: 'Method list'
          name: 'Method list'
          min: (Point 10 10)
          bounds: (Rectangle 0 0 300 300)
        )
        component: 
       (SpecCollection
          collection: (
           (DataSetSpec
              name: 'MethodList'
              layout: (LayoutFrame 0 0 0 0 0 1 0 1)
              model: selectedCallTreeItemHolder
              hasHorizontalScrollBar: true
              hasVerticalScrollBar: true
              dataList: methodListAspect
              useIndex: false
              columnHolder: methodListColumns
            )
           )
         
        )
      )

    "Modified: / 01-12-2007 / 23:57:41 / janfrog"
!

sidebarInfoSpec
    "This resource specification was automatically generated
     by the UIPainter of ST/X."

    "Do not manually edit this!! If it is corrupted,
     the UIPainter may not be able to read the specification."

    "
     UIPainter new openOnClass:Tools::VisualProfilerCanvas andSelector:#sidebarInfoSpec
     Tools::VisualProfilerCanvas new openInterface:#sidebarInfoSpec
    "

    <resource: #canvas>

    ^ 
     #(FullSpec
        name: sidebarInfoSpec
        window: 
       (WindowSpec
          label: 'General Info'
          name: 'General Info'
          min: (Point 10 10)
          bounds: (Rectangle 0 0 300 300)
        )
        component: 
       (SpecCollection
          collection: (
           (VerticalPanelViewSpec
              name: 'Panel'
              layout: (LayoutFrame 0 0 0 0 0 1 0 1)
              horizontalLayout: fit
              verticalLayout: topFit
              horizontalSpace: 3
              verticalSpace: 3
              component: 
             (SpecCollection
                collection: (
                 (TransparentBoxSpec
                    name: 'StartTimeBox'
                    component: 
                   (SpecCollection
                      collection: (
                       (LabelSpec
                          label: 'Start time:'
                          name: 'StartTimestampLabel'
                          layout: (LayoutFrame 0 0 0 0 0 1 0 0.5)
                          translateLabel: true
                          adjust: left
                        )
                       (LabelSpec
                          name: 'StartTimestamp'
                          layout: (LayoutFrame 30 0 0 0.5 0 1 0 1)
                          translateLabel: true
                          labelChannel: startTimestampAspect
                          adjust: left
                        )
                       )
                     
                    )
                    extent: (Point 300 50)
                  )
                 (TransparentBoxSpec
                    name: 'ExecutionTimeBox'
                    component: 
                   (SpecCollection
                      collection: (
                       (LabelSpec
                          label: 'Execution time:'
                          name: 'ExecutionTimeLabel'
                          layout: (LayoutFrame 0 0 0 0 0 1 0 0.5)
                          translateLabel: true
                          adjust: left
                        )
                       (LabelSpec
                          label: 'Label'
                          name: 'ExecutionTime'
                          layout: (LayoutFrame 30 0 0 0.5 0 1 0 1)
                          translateLabel: true
                          labelChannel: executionTimeAspect
                          adjust: left
                        )
                       )
                     
                    )
                    extent: (Point 300 50)
                  )
                 (TransparentBoxSpec
                    name: 'NotesBox'
                    component: 
                   (SpecCollection
                      collection: (
                       (LabelSpec
                          label: 'Notes:'
                          name: 'NotesLabel'
                          layout: (LayoutFrame 0 0 0 0 0 1 25 0)
                          translateLabel: true
                          adjust: left
                        )
                       (TextEditorSpec
                          name: 'Notes'
                          layout: (LayoutFrame 30 0 25 0 0 1 0 1)
                          model: notesAspect
                          hasHorizontalScrollBar: true
                          hasVerticalScrollBar: true
                        )
                       )
                     
                    )
                    extent: (Point 300 194)
                  )
                 )
               
              )
            )
           )
         
        )
      )

    "Modified: / 24-11-2007 / 09:27:08 / janfrog"
!

sidebarPackageFilterSpec
    <resource: #canvas>
    "This resource specification was automatically generated
     by the UIPainter of ST/X."
    "Do not manually edit this!! If it is corrupted,
     the UIPainter may not be able to read the specification."
    "
     UIPainter new openOnClass:Tools::VisualProfilerCanvas andSelector:#packageFilterSpec
     Tools::VisualProfilerCanvas new openInterface:#packageFilterSpec"
    
    ^ #( #FullSpec
  #name: #sidebarPackageFilterSpec
  #window:
 #(WindowSpec label: 'Package Filter' name: 'Package Filter' min: (Point 10 10) bounds: (Rectangle 0 0 300 300))
  #component:
 #(SpecCollection collection: ((SubCanvasSpec name: 'PackageFilterCanvas' layout: (LayoutFrame 0 0 0 0 0 1 0 1) hasHorizontalScrollBar: false hasVerticalScrollBar: false majorKey: #'Tools::HierarchicalPackageFilterList' minorKey: windowSpec subAspectHolders: (Array (SubChannelInfoSpec subAspect: packageFilter aspect: packageFilter)) createNewApplication: true createNewBuilder: true))) )

    "Modified: / 24-11-2007 / 08:34:31 / janfrog"
!

sidebarSpec
    "This resource specification was automatically generated
     by the UIPainter of ST/X."

    "Do not manually edit this!! If it is corrupted,
     the UIPainter may not be able to read the specification."

    "
     UIPainter new openOnClass:Tools::VisualProfilerCanvas andSelector:#sidebarSpec
     Tools::VisualProfilerCanvas new openInterface:#sidebarSpec
    "

    <resource: #canvas>

    ^ 
     #(FullSpec
        name: sidebarSpec
        window: 
       (WindowSpec
          label: 'Profiler Sidebar'
          name: 'Profiler Sidebar'
          min: (Point 10 10)
          bounds: (Rectangle 0 0 300 300)
        )
        component: 
       (SpecCollection
          collection: (
           (MenuPanelSpec
              name: 'ToolBar'
              layout: (LayoutFrame 0 0 0 0 0 1 30 0)
              menu: sidebarMenu
              textDefault: true
            )
           (NoteBookViewSpec
              name: 'SidebarNotebook'
              layout: (LayoutFrame 0 0 30 0 0 1 0 1)
              menu: sidebarNotebookTabList
              direction: left
              fitLastRow: false
            )
           )
         
        )
      )

    "Modified: / 24-11-2007 / 09:13:40 / janfrog"
!

windowSpec
    "This resource specification was automatically generated
     by the UIPainter of ST/X."

    "Do not manually edit this!! If it is corrupted,
     the UIPainter may not be able to read the specification."

    "
     UIPainter new openOnClass:Tools::VisualProfilerCanvas andSelector:#windowSpec
     Tools::VisualProfilerCanvas new openInterface:#windowSpec
     Tools::VisualProfilerCanvas open
    "

    <resource: #canvas>

    ^ 
     #(FullSpec
        name: windowSpec
        window: 
       (WindowSpec
          label: 'Visual Profiler'
          name: 'Visual Profiler'
          min: (Point 10 10)
          bounds: (Rectangle 0 0 714 332)
        )
        component: 
       (SpecCollection
          collection: (
           (VariableHorizontalPanelSpec
              name: 'SidebarAndPerspectivePanel'
              layout: (LayoutFrame 0 0 0 0 0 1 0 1)
              showHandle: true
              snapMode: both
              component: 
             (SpecCollection
                collection: (
                 (UISubSpecification
                    name: 'SidebarSpec'
                    minorKey: sidebarSpec
                  )
                 (NoteBookViewSpec
                    name: 'PerspectiveNoteBook'
                    menu: perspectiveNotebookTabList
                    direction: bottom
                    fitLastRow: false
                  )
                 )
               
              )
              handles: (Any 0.3 1.0)
            )
           )
         
        )
      )

    "Modified: / 24-11-2007 / 09:07:56 / janfrog"
! !

!VisualProfilerCanvas class methodsFor:'list specs'!

perspectiveNotebookTabList
    "This resource specification was automatically generated
     by the TabListEditor of ST/X."

    "Do not manually edit this!! If it is corrupted,
     the TabListEditor may not be able to read the specification."

    "
     TabListEditor new openOnClass: self andSelector:#perspectiveNotebookTabList
    "

    <resource: #tabList>

    ^     #(
       (TabItem
          label: 'Call tree'
          createNewBuilder: false
          minorKey: callTreeSpec
        )
       (TabItem
          label: 'Method list'
          createNewBuilder: false
          minorKey: methodListSpec
        )
       )
     
      collect:[:aTab| TabItem new fromLiteralArrayEncoding:aTab ]

    "Modified: / 02-12-2007 / 00:03:42 / janfrog"
!

sidebarNotebookTabList
    "This resource specification was automatically generated
     by the TabListEditor of ST/X."

    "Do not manually edit this!! If it is corrupted,
     the TabListEditor may not be able to read the specification."

    "
     TabListEditor new openOnClass: self andSelector:#sidebarNotebookTabList
    "

    <resource: #tabList>

    ^     #(
       (TabItem
          label: 'Statistics'
          minorKey: sidebarInfoSpec
        )
       (TabItem
          label: 'Packages'
          createNewBuilder: false
          minorKey: sidebarPackageFilterSpec
        )
       )
     
      collect:[:aTab| TabItem new fromLiteralArrayEncoding:aTab ]

    "Modified: / 24-11-2007 / 08:45:36 / janfrog"
! !

!VisualProfilerCanvas class methodsFor:'menu specs'!

sidebarMenu
    "This resource specification was automatically generated
     by the MenuEditor of ST/X."

    "Do not manually edit this!! If it is corrupted,
     the MenuEditor may not be able to read the specification."

    "
     MenuEditor new openOnClass:Tools::VisualProfilerCanvas andSelector:#sidebarMenu
     (Menu new fromLiteralArrayEncoding:(Tools::VisualProfilerCanvas sidebarMenu)) startUp
    "

    <resource: #menu>

    ^ 
     #(Menu
        (
         (MenuItem
            label: 'Save'
            itemValue: saveProfilerAction
            translateLabel: true
            labelImage: (ResourceRetriever XPToolbarIconLibrary saveToFileIcon)
          )
         )
        nil
        nil
      )

    "Modified: / 24-11-2007 / 09:10:50 / janfrog"
! !

!VisualProfilerCanvas class methodsFor:'plugIn spec'!

aspectSelectors
    "This resource specification was automatically generated
     by the UIPainter of ST/X."

    "Do not manually edit this. If it is corrupted,
     the UIPainter may not be able to read the specification."

    "Return a description of exported aspects;
     these can be connected to aspects of an embedding application
     (if this app is embedded in a subCanvas)."

    ^ #(
        #packageFilter
        #profilerStatistics
        #selectedMethods
      ).

    "Modified: / 01-12-2007 / 23:57:41 / janfrog"
! !

!VisualProfilerCanvas class methodsFor:'tableColumns specs'!

methodListColumns
    "This resource specification was automatically generated
     by the DataSetBuilder of ST/X."

    "Do not manually edit this!! If it is corrupted,
     the DataSetBuilder may not be able to read the specification."

    "
     DataSetBuilder new openOnClass:Tools::VisualProfilerCanvas andSelector:#methodListColumns
    "

    <resource: #tableColumns>

    ^#(
      (DataSetColumnSpec
         labelButtonType: Button
         rendererType: rowSelector
         showRowSeparator: false
         showSelectionHighLighted: false
         showColSeparator: false
       )
      (DataSetColumnSpec
         label: 'Tally'
         labelButtonType: Button
         type: number
         model: tally
         canSelect: false
         showRowSeparator: false
         showSelectionHighLighted: false
         showColSeparator: false
       )
      (DataSetColumnSpec
         label: 'Method'
         labelButtonType: Button
         model: methodLabel
         canSelect: false
         showRowSeparator: false
         showSelectionHighLighted: false
         showColSeparator: false
       )
      (DataSetColumnSpec
         label: 'Package'
         labelButtonType: Button
         model: packageLabel
         canSelect: false
         showRowSeparator: false
         showSelectionHighLighted: false
         showColSeparator: false
       )
      )

    "Modified: / 01-12-2007 / 23:56:15 / janfrog"
! !

!VisualProfilerCanvas methodsFor:'aspects'!

callTreeHolder
    "automatically generated by UIPainter ..."

    "*** the code below creates a default model when invoked."
    "*** (which may not be the one you wanted)"
    "*** Please change as required and accept it in the browser."
    "*** (and replace this comment by something more useful ;-)"

    callTreeHolder isNil ifTrue:[
        callTreeHolder := HierarchicalList new.
        callTreeHolder application: self.
"/ if your app needs to be notified of changes, uncomment one of the lines below:
"/       callTreeHolder addDependent:self.
"/       callTreeHolder onChangeSend:#callTreeHolderChanged to:self.
    ].
    ^ callTreeHolder.

    "Created: / 10-10-2007 / 08:34:26 / janfrog"
    "Modified: / 10-10-2007 / 12:48:20 / janfrog"
!

executionTimeAspect

    ^(PluggableAdaptor on: profilerStatistics)
        getBlock:[:model|
            model value
                ifNil:['N/A']
                ifNotNil:[model value computationTime printString 
                            , 'ms'
                                ,' (', (TimeDuration new setMilliseconds:model value computationTime) printString , ')']]
        putBlock:[:ign1 :ign2|self shouldNeverBeReached]
        updateBlock:[:ign1 :ign2 :ign3|true]

    "Created: / 24-11-2007 / 08:44:49 / janfrog"
!

methodListAspect

    methodList ifNil:[methodList := List new].
    ^methodList

    "Created: / 01-12-2007 / 23:38:16 / janfrog"
!

notesAspect

    ^(AspectAdaptor forAspect:#notes)
        subjectChannel: self profilerStatistics

    "Created: / 24-11-2007 / 09:27:47 / janfrog"
!

packageFilter
    "return/create the 'packageFilter' value holder (automatically generated)"

    packageFilter isNil ifTrue:[
        packageFilter := ValueHolder new.
    ].
    ^ packageFilter

    "Created: / 09-10-2007 / 21:27:32 / janfrog"
!

packageFilter:something
    "set the 'packageFilter' value holder (automatically generated)"

    packageFilter ifNotNil:[packageFilter removeDependent: self].
    packageFilter := something.
    packageFilter ifNotNil:[packageFilter addDependent: self].

    "Created: / 09-10-2007 / 21:27:32 / janfrog"
    "Modified: / 10-10-2007 / 12:47:08 / janfrog"
!

perspectiveNotebookTabList
    "Generated by the TabListEditor"

    |list|

    (list := builder bindingAt:#perspectiveNotebookTabList) isNil ifTrue:[
        builder aspectAt:#perspectiveNotebookTabList put:(list := self class perspectiveNotebookTabList).
    ].
    ^ list

    "Created: / 10-10-2007 / 10:10:07 / janfrog"
!

perspectiveSpecHolder
    "automatically generated by UIPainter ..."

    "*** the code below creates a default model when invoked."
    "*** (which may not be the one you wanted)"
    "*** Please change as required and accept it in the browser."
    "*** (and replace this comment by something more useful ;-)"

    perspectiveSpecHolder isNil ifTrue:[
        perspectiveSpecHolder := #callTreeSpec asValue.
"/ if your app needs to be notified of changes, uncomment one of the lines below:
"/       perspectiveSpecHolder addDependent:self.
"/       perspectiveSpecHolder onChangeSend:#perspectiveSpecHolderChanged to:self.
    ].
    ^ perspectiveSpecHolder.

    "Created: / 10-10-2007 / 08:31:35 / janfrog"
!

profilerStatistics
    "return/create the 'profilerStatistics' value holder (automatically generated)"

    profilerStatistics isNil ifTrue:[
        profilerStatistics := ValueHolder new.
    ].
    ^ profilerStatistics

    "Created: / 09-10-2007 / 21:53:38 / janfrog"
!

profilerStatistics:something
    "set the 'profilerStatistics' value holder (automatically generated)"

    profilerStatistics ifNotNil:[profilerStatistics removeDependent: self].
    profilerStatistics := something.
    profilerStatistics ifNotNil:[profilerStatistics addDependent: self].

    "Created: / 09-10-2007 / 21:53:38 / janfrog"
    "Modified: / 10-10-2007 / 08:46:46 / janfrog"
!

selectedCallTreeItemHolder
    "automatically generated by UIPainter ..."

    "*** the code below creates a default model when invoked."
    "*** (which may not be the one you wanted)"
    "*** Please change as required and accept it in the browser."
    "*** (and replace this comment by something more useful ;-)"

    selectedCallTreeItemHolder isNil ifTrue:[
        selectedCallTreeItemHolder := ValueHolder new.
        selectedCallTreeItemHolder onChangeSend:#selectedCallTreeItemChanged to:self.
    ].
    ^ selectedCallTreeItemHolder.

    "Created: / 10-10-2007 / 08:51:34 / janfrog"
!

selectedMethods
    "return/create the 'selectedMethods' value holder (automatically generated)"

    selectedMethods isNil ifTrue:[
        selectedMethods := ValueHolder new.
    ].
    ^ selectedMethods

    "Created: / 09-10-2007 / 21:18:18 / janfrog"
!

selectedMethods:something
    "set the 'selectedMethods' value holder (automatically generated)"

    selectedMethods := something.

    "Created: / 09-10-2007 / 21:18:18 / janfrog"
!

sidebarNotebookTabList
    "Generated by the TabListEditor"

    |list|

    (list := builder bindingAt:#sidebarNotebookTabList) isNil ifTrue:[
        builder aspectAt:#sidebarNotebookTabList put:(list := self class sidebarNotebookTabList).
    ].
    ^ list

    "Created: / 10-10-2007 / 10:10:35 / janfrog"
!

startTimestampAspect

    ^(PluggableAdaptor on: profilerStatistics)
        getBlock:[:model|
            model value
                ifNil:['N/A']
                ifNotNil:[model value startTimestamp printString]]
        putBlock:[:ign1 :ign2|self shouldNeverBeReached]
        updateBlock:[:ign1 :ign2 :ign3|true]

    "Created: / 24-11-2007 / 08:57:58 / janfrog"
! !

!VisualProfilerCanvas methodsFor:'change & update'!

methodsSelectionChanged

    self topApplication == self
        ifFalse:[self topApplication methodsSelectionChanged]

    "Created: / 09-10-2007 / 21:33:50 / janfrog"
!

selectedCallTreeItemChanged

    self selectedCallTreeItemHolder value ifNil:[^self].
    self switchToMethod: self selectedCallTreeItemHolder value method

    "Created: / 10-10-2007 / 08:52:33 / janfrog"
!

update: aspect with: value from: sender

    sender == self profilerStatistics 
        ifTrue:[^self updateCallTreeRoot; updateMethodList].

    sender == self packageFilter 
        ifTrue:[self updateCallTree; updateMethodList]

    "Created: / 10-10-2007 / 08:46:59 / janfrog"
    "Modified: / 01-12-2007 / 23:52:07 / janfrog"
!

updateCallTree

    self callTreeHolder root updateChildren

    "Created: / 10-10-2007 / 12:57:36 / janfrog"
!

updateCallTreeRoot

    |  callTree callTreeRootItem |
    callTree := self callTreeHolder.
    profilerStatistics value ifNil:[^callTree root: nil].
    callTreeRootItem := CallTreeItem 
                            subject: profilerStatistics value tree
                            parent: callTree.
    callTree root: callTreeRootItem.
    callTree showRoot: true.

    "Created: / 10-10-2007 / 12:59:07 / janfrog"
!

updateMethodList

    | items |
    self methodListAspect removeAll.
    self profilerStatistics value ifNil:[^self].
    items := ProfilerInfoBuilder::MethodList new 
                packages: self packageFilter value;
                build: self profilerStatistics value tree;
                items.

    self methodListAspect addAll: items

    "Created: / 01-12-2007 / 23:39:15 / janfrog"
! !

!VisualProfilerCanvas methodsFor:'hooks'!

commonPostBuild

    super commonPostBuild.
    self updateCallTreeRoot.
    self updateMethodList.

    "Created: / 09-10-2007 / 20:05:18 / janfrog"
    "Modified: / 01-12-2007 / 23:39:34 / janfrog"
!

postBuildEditModeInfoLabel: view

    "Created: / 09-10-2007 / 21:06:35 / janfrog"
!

postBuildEditorNoteBook: view

    "Created: / 09-10-2007 / 21:05:39 / janfrog"
! !

!VisualProfilerCanvas methodsFor:'user actions'!

switchToMethod: aMethod

    self selectedMethods value:(Array with: aMethod).
    self methodsSelectionChanged

    "Created: / 09-10-2007 / 21:36:35 / janfrog"
! !

!VisualProfilerCanvas methodsFor:'user actions-profiler'!

profilerTestAction

    self switchToMethod:(Object >> #yourself).

    "Created: / 09-10-2007 / 21:07:53 / janfrog"
!

saveProfilerAction

    | file profiler |
    file := Dialog requestFileName:'Select file' pattern:'*.profiler.boss'.
    file isNilOrEmptyCollection ifTrue:[^self].
    profiler := self profilerStatistics value.
    profiler storeStatisticsOn: file asFilename writeStream

    "Created: / 24-11-2007 / 09:16:38 / janfrog"
! !

!VisualProfilerCanvas::CallTreeItem class methodsFor:'documentation'!

version
    ^'$Id: Tools__VisualProfilerCanvas.st,v 1.1 2011-07-01 13:28:12 cg Exp $'
! !

!VisualProfilerCanvas::CallTreeItem class methodsFor:'instance creation'!

subject: subject parent: parent

    ^self new
        subject: subject;
        parent: parent;
        yourself

    "Created: / 10-10-2007 / 08:35:55 / janfrog"
! !

!VisualProfilerCanvas::CallTreeItem methodsFor:'accessing'!

children

    children ifNil:[children := self createChildren].
    ^children

    "Created: / 10-10-2007 / 08:38:28 / janfrog"
    "Modified: / 10-10-2007 / 13:24:06 / janfrog"
!

createChildren
    |childrenTmp childrenStream|

    self subject ifNil:[ ^ children := #() ].
    childrenStream := (OrderedCollection new:self subject called size) 
                writeStream.
    self createChildrenOn:childrenStream.
    childrenTmp := childrenStream contents.
    childrenTmp := self mergeChildren: childrenTmp.
    childrenTmp do:[:child | child parent:self].
    ^ childrenTmp

    "Created: / 10-10-2007 / 13:17:04 / janfrog"
    "Modified: / 24-11-2007 / 09:43:30 / janfrog"
!

createChildrenOn:aStream 
    self directChildren do:[:child | 
        child isFiltered ifTrue:[
            child createChildrenOn:aStream
        ] ifFalse:[
            aStream nextPut:child
        ]
    ]

    "Created: / 10-10-2007 / 13:05:52 / janfrog"
!

directChildren
    self subject called ifNil:[ ^ #() ].
    ^ self subject called 
        collect:[:childSubject | self class subject:childSubject parent:self ]

    "Created: / 10-10-2007 / 13:07:24 / janfrog"
    "Modified: / 24-11-2007 / 09:18:56 / janfrog"
!

label
    ^ self totalTally printString , '% in ' 
        , (self subject isBlock ifTrue:[ '[] in ' ] ifFalse:[ '' ]) 
            , (self subject selector ? '<no selector>') , ' ' 
        , ('[' , (self subject methodClass 
                        ifNil:[ 'nil class' ]
                        ifNotNil:[ self subject methodClass name ]) 
                , ']') allBold 
            , ' [' , self methodPackage asString allItalic 
        , ']'

    "Created: / 10-10-2007 / 08:40:44 / janfrog"
    "Modified: / 24-11-2007 / 09:42:16 / janfrog"
    "Modified: / 07-11-2008 / 08:40:35 / Jan Vrany <vranyj1@fel.cvut.cz>"
!

method
    self subject methodClass ifNil:[ ^ nil ].
    ^ self subject methodClass >> self subject selector asSymbol

    "Created: / 10-10-2007 / 08:49:58 / janfrog"
    "Modified: / 24-11-2007 / 09:18:56 / janfrog"
!

methodPackage

    | mth |
    mth := self method.
    mth ifNil:[^#__NoProject__].
    ^self method package

    "Created: / 10-10-2007 / 13:03:21 / janfrog"
!

subject
    ^ subjects anyOne

    "Created: / 10-10-2007 / 08:35:21 / janfrog"
    "Modified: / 24-11-2007 / 09:41:22 / janfrog"
!

subject:anObject
    subjects := Array with: anObject

    "Created: / 10-10-2007 / 08:35:21 / janfrog"
    "Modified: / 24-11-2007 / 09:41:33 / janfrog"
!

subjects
    ^ subjects

    "Created: / 24-11-2007 / 09:41:14 / janfrog"
!

subjects:something
    subjects := something.

    "Created: / 24-11-2007 / 09:41:14 / janfrog"
!

totalTally

    ^subjects inject:0 into:[:tally :subject| tally + subject totalTally]

    "Created: / 24-11-2007 / 09:43:01 / janfrog"
! !

!VisualProfilerCanvas::CallTreeItem methodsFor:'change & update'!

updateChildren

    self removeAll.
    self addAll:self createChildren

    "Created: / 10-10-2007 / 13:02:13 / janfrog"
! !

!VisualProfilerCanvas::CallTreeItem methodsFor:'comparing'!

shouldBeMergedWith:anotherCallTreeItem 
    ^ self subject methodClass = anotherCallTreeItem subject methodClass 
        and:[
            self subject selector = anotherCallTreeItem subject selector 
                and:[ self subject isBlock not ]
        ]

    "Created: / 24-11-2007 / 09:50:34 / janfrog"
! !

!VisualProfilerCanvas::CallTreeItem methodsFor:'private'!

mergeChildren: rawChildren

    |mergedChildren|

    mergedChildren := OrderedCollection new.
    [rawChildren isEmpty] whileFalse:
        [|childToMerge childrenToMerge|
        childToMerge := mergedChildren add:(rawChildren removeFirst).
        childrenToMerge := rawChildren select:[:e|e shouldBeMergedWith:childToMerge].
        rawChildren removeAll: childrenToMerge.
        childrenToMerge do:[:e|childToMerge subjects addAll:e subjects].
        ].
    ^mergedChildren

    "Created: / 24-11-2007 / 09:20:07 / janfrog"
! !

!VisualProfilerCanvas::CallTreeItem methodsFor:'testing'!

isFiltered

    | isFiltered |
    isFiltered := false.
    self application packageFilter value 
        ifNotNil:[isFiltered := (self application packageFilter value includes: self methodPackage) not].
    ^isFiltered

    "Created: / 10-10-2007 / 13:09:46 / janfrog"
! !

!VisualProfilerCanvas class methodsFor:'documentation'!

version_CVS
    ^ '$Header: /cvs/stx/stx/libtool/Tools__VisualProfilerCanvas.st,v 1.1 2011-07-01 13:28:12 cg Exp $'
!

version_SVN
    ^ '§Id: Tools__VisualProfilerCanvas.st 7486 2009-10-26 22:06:24Z vranyj1 §'
! !