Moved ProfilerUI here

src/BaselineOfNewTools/BaselineOfNewTools.class.st

@@ -77,11 +77,13 @@ BaselineOfNewTools >> baseline: spec [
 			package: 'NewTools-Debugger-Fuel';
 			package: 'NewTools-Debugger-Fuel-Tests' with: [ spec requires: #( 'NewTools-Debugger-Fuel' ) ];
 			package: 'NewTools-Fuel';
-     			"Rewriter Tools"
+     		"Rewriter Tools"
 			package: 'NewTools-RewriterTools-Backend';
 			package: 'NewTools-RewriterTools' with: [ spec requires: #('NewTools-RewriterTools-Backend') ];
 			package: 'NewTools-RewriterTools-Backend-Tests' with: [ spec requires: #('NewTools-RewriterTools-Backend') ];
-			package: 'NewTools-RewriterTools-Tests' with: [ spec requires: #('NewTools-RewriterTools') ].
+			package: 'NewTools-RewriterTools-Tests' with: [ spec requires: #('NewTools-RewriterTools') ];
+			"ProfilerUI"
+			package: 'NewTools-ProfilerUI'.
 
 		spec
 			group: 'Core' with: #( 'NewTools-Core' 'NewTools-Morphic' );
@@ -125,11 +127,12 @@ BaselineOfNewTools >> baseline: spec [
 			group: #FileBrowser with: #( 
 						'NewTools-FileBrowser' 
 						'NewTools-FileBrowser-Tests' );
-      			group: #RewriterTools with: #(
-				    		'NewTools-RewriterTools-Backend'
-				    		'NewTools-RewriterTools'
-				    		'NewTools-RewriterTools-Backend-Tests'
-				    		'NewTools-RewriterTools-Tests' );
+      		group: #RewriterTools with: #(
+				   		'NewTools-RewriterTools-Backend'
+				   		'NewTools-RewriterTools'
+				   		'NewTools-RewriterTools-Backend-Tests'
+				   		'NewTools-RewriterTools-Tests' );
+			group: #ProfilerUI with: #( 'NewTools-ProfilerUI' );
 			group: 'default' with: #( 
 						'Playground' 
 						'Inspector' 
@@ -139,7 +142,9 @@ BaselineOfNewTools >> baseline: spec [
 						'FontChooser' 
 						'Methods'
 				   		'Spotter'
-            					'RewriterTools') ]
+            			'RewriterTools'
+						'ProfilerUI'
+						) ]
 ]
 
 { #category : 'external projects' }

src/NewTools-ProfilerUI/AndreasSystemProfiler.extension.st

@@ -0,0 +1,23 @@
+Extension { #name : 'AndreasSystemProfiler' }
+
+{ #category : '*NewTools-ProfilerUI' }
+AndreasSystemProfiler >> runBlock: aBlock [
+	"Compatibility with TimeProfiler"
+
+	^ aBlock value
+]
+
+{ #category : '*NewTools-ProfilerUI' }
+AndreasSystemProfiler >> tallyRoot [
+	^ tallyRoot
+]
+
+{ #category : '*NewTools-ProfilerUI' }
+AndreasSystemProfiler >> totalTally [
+	^ totalTally
+]
+
+{ #category : '*NewTools-ProfilerUI' }
+AndreasSystemProfiler >> totalTime [
+	^ totalTime
+]

src/NewTools-ProfilerUI/FTTreeItem.extension.st

@@ -0,0 +1,10 @@
+Extension { #name : 'FTTreeItem' }
+
+{ #category : '*NewTools-ProfilerUI' }
+FTTreeItem >> pathForItemSuchThat: aFullBlockClosure [
+
+	children do: [ :each |
+		(each pathForItemSuchThat: aFullBlockClosure)
+		ifNotEmpty: [ :path | ^ path ] ].
+	^ #()
+]

src/NewTools-ProfilerUI/ManifestNewToolsProfilerUI.class.st

@@ -0,0 +1,10 @@
+"
+Graphical user interface for AndreasProfiler and TimeProfiler
+"
+Class {
+	#name : 'ManifestNewToolsProfilerUI',
+	#superclass : 'PackageManifest',
+	#category : 'NewTools-ProfilerUI-Manifest',
+	#package : 'NewTools-ProfilerUI',
+	#tag : 'Manifest'
+}

src/NewTools-ProfilerUI/MessageTally.extension.st

@@ -0,0 +1,8 @@
+Extension { #name : 'MessageTally' }
+
+{ #category : '*NewTools-ProfilerUI' }
+MessageTally >> asTallyModel [
+	^ StTallyModelTime new
+		item: self;
+		yourself
+]

src/NewTools-ProfilerUI/QSystemTally.extension.st

@@ -0,0 +1,32 @@
+Extension { #name : 'QSystemTally' }
+
+{ #category : '*NewTools-ProfilerUI' }
+QSystemTally >> <= aQSystemTally [
+	^ tally <= aQSystemTally tally
+]
+
+{ #category : '*NewTools-ProfilerUI' }
+QSystemTally >> asTallyModel [
+	^ StTallyModelAndreas new
+		item: self;
+		yourself
+]
+
+{ #category : '*NewTools-ProfilerUI' }
+QSystemTally >> methodClassName [
+	^ class ifNil: [ 'nil' ] ifNotNil: [ class name ]
+]
+
+{ #category : '*NewTools-ProfilerUI' }
+QSystemTally >> methodOrBlock [
+	^ method
+]
+
+{ #category : '*NewTools-ProfilerUI' }
+QSystemTally >> originMethod [
+	| methodOrBlock |
+	methodOrBlock := self methodOrBlock.
+	^ methodOrBlock isCompiledBlock
+		  ifTrue: [ methodOrBlock method ]
+		  ifFalse: [ methodOrBlock ]
+]

src/NewTools-ProfilerUI/SpMorphicProfilerTreeTableAdapter.class.st

@@ -0,0 +1,98 @@
+"
+I am the adapter used to realise a ProfilerTreeTablePresenter.
+
+I will create a tree table (using FTTableMorph), but my datasource uses ProfilerFTBasicItem and ProfilerFTRoot item, which optimize the performance rendering the tree, but use more memory.
+"
+Class {
+	#name : 'SpMorphicProfilerTreeTableAdapter',
+	#superclass : 'SpMorphicTreeTableAdapter',
+	#category : 'NewTools-ProfilerUI-SpecAdapters',
+	#package : 'NewTools-ProfilerUI',
+	#tag : 'SpecAdapters'
+}
+
+{ #category : 'factory' }
+SpMorphicProfilerTreeTableAdapter >> addModelTo: tableMorph [
+
+	self ensureAtLeastOneColumnIn: tableMorph.
+
+	self presenter selection isMultipleSelection ifTrue: [
+		tableMorph beMultipleSelection ].
+
+	tableMorph setBalloonText: self model help.
+
+	self presenter selection isEmpty ifFalse: [
+		self updateSelectionOf: tableMorph ].
+
+	self presenter whenRootsChangedDo: [ tableMorph buildContents ]
+]
+
+{ #category : 'factory' }
+SpMorphicProfilerTreeTableAdapter >> buildWidget [
+	| tableMorph |
+
+	tableMorph := (MorphTreeMorph on: self presenter viewModel)
+		rowInset: 2;
+		columnInset: 4;
+		autoDeselection: true;
+		getMenuSelector:#menu:shifted:;
+		keyDownActionSelector: #keyDown:from:;
+		treeLineWidth: 1;
+		treeLineDashes: {5. 1};
+		lineColorBlock: [:node | {Color gray. Color orange. Color brown. Color magenta. Color blue} at: ((node level \\ 5) + 1)];
+		doubleClickSelector: #browseItem;
+		rowColorForEven: self theme lightBackgroundColor;
+		yourself.
+
+	self addModelTo: tableMorph.
+	tableMorph buildContents.
+
+	widget := tableMorph.
+
+	^ tableMorph
+]
+
+{ #category : 'accessing' }
+SpMorphicProfilerTreeTableAdapter >> collapseAll [
+	^ widget collapseAll
+]
+
+{ #category : 'accessing' }
+SpMorphicProfilerTreeTableAdapter >> collapsePath: anArray [
+
+	widget collapseNodePath: anArray
+]
+
+{ #category : 'accessing' }
+SpMorphicProfilerTreeTableAdapter >> expandAll [
+	^ widget expandAll
+]
+
+{ #category : 'accessing' }
+SpMorphicProfilerTreeTableAdapter >> expandPath: anArray [
+
+	widget expandNodePath: anArray
+]
+
+{ #category : 'accessing' }
+SpMorphicProfilerTreeTableAdapter >> expandRoots [
+
+	widget expandRoots
+]
+
+{ #category : 'updating' }
+SpMorphicProfilerTreeTableAdapter >> refreshTree [
+
+	widget updateList
+]
+
+{ #category : 'accessing' }
+SpMorphicProfilerTreeTableAdapter >> scrollToSelection [
+	self widget scrollSelectionIntoView
+]
+
+{ #category : 'accessing' }
+SpMorphicProfilerTreeTableAdapter >> selectedItem [
+
+	^ self widget selectedMorph complexContents
+]

src/NewTools-ProfilerUI/StCodeProfileItCommand.class.st

@@ -0,0 +1,47 @@
+"
+I'm a ""profile it"" command. 
+I will evalute the selection (or line) of the playground using a profiler.
+"
+Class {
+	#name : 'StCodeProfileItCommand',
+	#superclass : 'SpCodeSelectionCommand',
+	#category : 'NewTools-ProfilerUI-Commands',
+	#package : 'NewTools-ProfilerUI',
+	#tag : 'Commands'
+}
+
+{ #category : 'defaults' }
+StCodeProfileItCommand class >> defaultIconName [
+
+	^ #smallProfile
+]
+
+{ #category : 'defaults' }
+StCodeProfileItCommand class >> defaultName [
+
+	^ 'Profile it'
+]
+
+{ #category : 'execution' }
+StCodeProfileItCommand >> execute [
+
+	| selection receiver evaluationContext stream compiledMethod |
+	selection := self selectedTextOrLine.
+	selection trimBoth ifEmpty: [ ^ self ].
+
+	receiver := self context doItReceiver.
+	evaluationContext := self context doItContext.
+
+	stream := selection readStream.
+	compiledMethod := self
+		                  compile: stream
+		                  for: receiver
+		                  in: evaluationContext.
+	compiledMethod ifNil: [ ^ self ].
+
+	StProfilerPresenter new
+		open;
+		profileBlock: [
+			compiledMethod valueWithReceiver: receiver arguments: #(  ) ]
+		displayCode: selection
+]

src/NewTools-ProfilerUI/StProfilerCodePresenter.class.st

@@ -0,0 +1,36 @@
+"
+I show the source code of the selected node in the profiler results tree
+"
+Class {
+	#name : 'StProfilerCodePresenter',
+	#superclass : 'SpCodePresenter',
+	#category : 'NewTools-ProfilerUI-Presenters',
+	#package : 'NewTools-ProfilerUI',
+	#tag : 'Presenters'
+}
+
+{ #category : 'initialization' }
+StProfilerCodePresenter >> initialize [
+	super initialize.
+	self beNotEditable
+]
+
+{ #category : 'initialization' }
+StProfilerCodePresenter >> methodOrBlock: methodOrBlock [
+
+	methodOrBlock ifNil: [
+		self text: ''.
+		self clearInteractionModel.
+		^ self ].
+
+	self text: methodOrBlock sourceCode.
+	self beForMethod: methodOrBlock originMethod.
+	methodOrBlock isCompiledBlock
+		ifTrue: [
+			self addTextSegmentDecoration:
+				(SpTextPresenterDecorator forHighlight
+					 interval: (methodOrBlock sourceNode sourceInterval first to:
+							  methodOrBlock sourceNode sourceInterval last + 1);
+					 yourself) ]
+		ifFalse: [ self removeAllTextSegmentDecorations ]
+]