Merge 808c56c

src/BaselineOfNewTools/BaselineOfNewTools.class.st

@@ -163,18 +163,18 @@ BaselineOfNewTools >> baseline: spec [
 { #category : 'external projects' }
 BaselineOfNewTools >> chest: spec [
 
-	spec baseline: 'Chest' with: [ 
+	spec baseline: 'Chest' with: [
 		spec
-			repository: (self packageRepositoryURL ifEmpty: [ 
+			repository: ((self packageRepositoryURLForSpec: spec) ifEmpty: [
 						 'github://pharo-spec/Chest:v0.4.1' ]);
 			loads: 'default' ]
 ]
 
-{ #category : 'external projects' }
-BaselineOfNewTools >> packageRepositoryURL [
+{ #category : 'accessing' }
+BaselineOfNewTools >> packageRepositoryURLForSpec: spec [
 	| url |
 
-	url := super packageRepositoryURL.
+	url := super packageRepositoryURLForSpec: spec.
 	url ifEmpty: [ ^ url ].
 	"Verify if I am running in CI"
 	"travis or github actions"
@@ -200,9 +200,9 @@ BaselineOfNewTools >> preload: loader package: packageSpec [
 { #category : 'external projects' }
 BaselineOfNewTools >> sindarin: spec [
 
-	spec baseline: 'Sindarin' with: [ 
+	spec baseline: 'Sindarin' with: [
 		spec
-			repository: (self packageRepositoryURL 
-				ifEmpty: [ 'github://pharo-spec/ScriptableDebugger:Pharo12/src' ]);
+			repository: ((self packageRepositoryURLForSpec: spec) ifEmpty: [
+						 'github://pharo-spec/ScriptableDebugger:Pharo12/src' ]);
 			loads: 'default' ]
 ]

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 ]
+]