Block which opens all methods containing variants

hpi-swa · Aug 17, 2023 · 9ace940 · 9ace940
1 parent 5c9c15c
commit 9ace940
Show file tree

Hide file tree

Showing 4 changed files with 101 additions and 1 deletion.
diff --git a/packages/Sandblocks-Core/SBBlock.class.st b/packages/Sandblocks-Core/SBBlock.class.st
@@ -1705,6 +1705,12 @@ SBBlock >> isValidAction: aPragmaOrMethod [
 	^ validMode and: [validInvocation]
 ]
 
+{ #category : #testing }
+SBBlock >> isVariant [
+
+	^ false
+]
+
 { #category : #testing }
 SBBlock >> isWatch [
 

diff --git a/packages/Sandblocks-Core/SBEditor.class.st b/packages/Sandblocks-Core/SBEditor.class.st
@@ -1147,6 +1147,36 @@ SBEditor >> openAll: aCollection [
 	aCollection do: [:object | self open: object]
 ]
 
+{ #category : #actions }
+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]]"
+]
+
 { #category : #'actions creating' }
 SBEditor >> openFile [
 	<addAction>

diff --git a/packages/Sandblocks-Core/SBExploriants.class.st b/packages/Sandblocks-Core/SBExploriants.class.st
@@ -0,0 +1,52 @@
+Class {
+	#name : #SBExploriants,
+	#superclass : #SBBlock,
+	#category : #'Sandblocks-Core'
+}
+
+{ #category : #'as yet unclassified' }
+SBExploriants class >> openIn: anEditor [
+
+	(self new visualize) openIn: anEditor
+]
+
+{ #category : #'as yet unclassified' }
+SBExploriants >> allMethodsContainingVariants [
+
+	^ ((self systemNavigation allCallsOn: SBVariant matchingSelector) 
+		reject: [:aMethodReference | aMethodReference actualClass = SBVariant class])
+		collect: #compiledMethod
+]
+
+{ #category : #'as yet unclassified' }
+SBExploriants >> initialize [
+
+	super initialize.
+
+	self
+		attachDecorator: SBMoveDecorator new;
+		attachDecorator: SBResizableDecorator new;
+		changeTableLayout;
+		listDirection: #topToBottom;
+		layoutInset: 8;
+		cellGap: 16;
+		hResizing: #shrinkWrap;
+		vResizing: #shrinkWrap
+]
+
+{ #category : #'as yet unclassified' }
+SBExploriants >> openIn: anEditor [
+
+	anEditor openMorphInView: self
+]
+
+{ #category : #'as yet unclassified' }
+SBExploriants >> visualize [
+
+	self allMethodsContainingVariants 
+		collect: #asSandblock
+		thenDo: [:aSBStMethod | self addMorphBack: aSBStMethod].
+
+
+
+]
diff --git a/packages/Sandblocks-Smalltalk/SBVariant.class.st b/packages/Sandblocks-Smalltalk/SBVariant.class.st
@@ -32,7 +32,13 @@ SBVariant class >> matches: aBlock [
 
 	^ aBlock receiver isBinding
 		and: [aBlock receiver contents = 'SBVariant']
-		and: [aBlock selector = 'named:associations:activeIndex:']
+		and: [aBlock selector = self matchingSelector]
+]
+
+{ #category : #constants }
+SBVariant class >> matchingSelector [
+
+	^ #named:associations:activeIndex:
 ]
 
 { #category : #'instance creation' }
@@ -134,6 +140,12 @@ SBVariant >> initialize [
 		hResizing: #shrinkWrap
 ]
 
+{ #category : #testing }
+SBVariant >> isVariant [ 
+
+	^ true
+]
+
 { #category : #accessing }
 SBVariant >> name [