--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/Tools__VisualProfilerCanvas.st Fri Jul 01 15:28:12 2011 +0200
@@ -0,0 +1,1069 @@
+"
+ 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 §'
+! !