Make Exploriants Singleton

hpi-swa · Aug 24, 2023 · 845cdc3 · 845cdc3
1 parent 2492f86
commit 845cdc3
Show file tree

Hide file tree

Showing 3 changed files with 37 additions and 39 deletions.
diff --git a/packages/Sandblocks-Core/SBEditor.class.st b/packages/Sandblocks-Core/SBEditor.class.st
@@ -1151,30 +1151,7 @@ SBEditor >> openAll: aCollection [
 SBEditor >> openExploriants [
 	<globalAction>
 
-	SBExploriants openIn: self
-
-	"| allCompiledMethodsContainingVariants |
-	allCompiledMethodsContainingVariants := ((self systemNavigation allCallsOn: #named:associations:activeIndex:) 
-		reject: [:aMethodReference | aMethodReference methodSymbol = #openExploriants])
-		collect: #compiledMethod.
-	
-	allCompiledMethodsContainingVariants
-		collect:  #asSandblock
-		thenDo: [:aSBStMethod | 
-		    aSBStMethod body allMorphsMutableDo: [:aMorph | aMorph visible: false].
-		    aSBStMethod containedVariants 
-			do: [:aVariant | |current|
-				current := aVariant.
-				[current := current owner] 
-							doWhileFalse: [current = aSBStMethod].
-				current submorphsDo: [:m| m visible: true]].
-		    self openMorphInView: aSBStMethod]."
-
-		"collect: [:aMethodBlock | aMethodBlock allMorphs 
-				select: [:aMorph | aMorph submorphs 
-						ifEmpty: [false] 
-						ifNotEmpty: [(aMorph submorphOfClass: SBVariant) isNil not]]]
-		thenDo: [:aCollectionOfOwnersOfVariants | aCollectionOfOwnersOfVariants do: [:aVariantOwner| self openMorphInView: aVariantOwner]]"
+	self open: SBExploriants uniqueInstance visualize
 ]
 
 { #category : #'actions creating' }

diff --git a/packages/Sandblocks-Core/SBExploriants.class.st b/packages/Sandblocks-Core/SBExploriants.class.st
@@ -1,24 +1,45 @@
 Class {
 	#name : #SBExploriants,
 	#superclass : #SBBlock,
+	#classInstVars : [
+		'uniqueInstance'
+	],
 	#category : #'Sandblocks-Core'
 }
 
-{ #category : #'as yet unclassified' }
-SBExploriants class >> openIn: anEditor [
+{ #category : #accessing }
+SBExploriants class >> deleteUniqueInstance [ 
 
-	(self new visualize) openIn: anEditor
+	uniqueInstance := nil
 ]
 
-{ #category : #'as yet unclassified' }
+{ #category : #'instance creation' }
+SBExploriants class >> new [
+
+	^ self error: 'Singleton. Use #uniqueInstance'
+]
+
+{ #category : #accessing }
+SBExploriants class >> uniqueInstance [ 
+
+	^ uniqueInstance ifNil: [uniqueInstance := super new]
+]
+
+{ #category : #comparing }
+SBExploriants >> = other [
+
+	^ self class = other class
+]
+
+{ #category : #accessing }
 SBExploriants >> allMethodsContainingVariants [
 
 	^ ((self systemNavigation allCallsOn: SBVariant matchingSelector) 
 		reject: [:aMethodReference | aMethodReference actualClass = SBVariant class])
 		collect: #compiledMethod
 ]
 
-{ #category : #'as yet unclassified' }
+{ #category : #initialization }
 SBExploriants >> initialize [
 
 	super initialize.
@@ -34,20 +55,20 @@ SBExploriants >> initialize [
 		vResizing: #shrinkWrap
 ]
 
-{ #category : #'as yet unclassified' }
-SBExploriants >> openIn: anEditor [
-
-	anEditor openMorphInView: self
-]
-
-{ #category : #'as yet unclassified' }
+{ #category : #initialization }
 SBExploriants >> visualize [
 
+	self submorphs copy do: #delete.
+
 	self allMethodsContainingVariants 
-		collect: #asSandblock
+		collect: [:aCompiledMethod | 
+			self blockFor: aCompiledMethod withInterfaces: #(#isEditor) 
+				ifOpen: [:existingMethodBlock | existingMethodBlock] 
+				ifClosed: [aCompiledMethod asSandblock]]
 		thenDo: [:aSBStMethod | 
 			self addMorphBack: aSBStMethod methodHeader copy.
-			aSBStMethod containedVariants do: [:aSBVariant | self addMorphBack: (SBVariantProxy for: aSBVariant)].
+			aSBStMethod containedVariants do: [:aSBVariant | 
+				self addMorphBack: (SBVariantProxy for: aSBVariant)].
 			self addMorphBack: (LineMorph from: 0@0 to: 50@0 color: Color black width: 2)].
 
 

diff --git a/packages/Sandblocks-Smalltalk/SBStBlockBody.class.st b/packages/Sandblocks-Smalltalk/SBStBlockBody.class.st
@@ -161,7 +161,7 @@ SBStBlockBody >> declareTemporaryVariableCommand: aString [
 { #category : #accessing }
 SBStBlockBody >> detectVariant: aVariant [
 
-	^ (self allBlocksSelect: #isVariant) detect: [:oneOfMyVariants | oneOfMyVariants = aVariant]
+	^ (self containedVariants) detect: [:oneOfMyVariants | oneOfMyVariants = aVariant]
 ]
 
 { #category : #'as yet unclassified' }