Filter Exploriants History for individual widgets

packages/Sandblocks-Babylonian/ImageMorph.extension.st

@@ -8,3 +8,13 @@ ImageMorph >> applyResize: aPoint [
 	form := form applyResize: aPoint.
 	^ form asMorph
 ]
+
+{ #category : #'*Sandblocks-Babylonian' }
+ImageMorph >> layoutedTaggedCopy [
+
+	^ super layoutedTaggedCopy
+		image: self image;
+		yourself
+
+
+]

packages/Sandblocks-Babylonian/Morph.extension.st

@@ -12,18 +12,43 @@ Morph class >> exampleObject [
 	^ self new
 ]
 
+{ #category : #'*Sandblocks-Babylonian' }
+Morph >> hasBeenTagged [
+
+	^ self tag isNilTag not
+]
+
 { #category : #'*Sandblocks-Babylonian' }
 Morph >> isVariantProxy [
 
 	^ false
 ]
 
+{ #category : #'*Sandblocks-Babylonian' }
+Morph >> layoutedTaggedCopy [
+
+	^ self class new
+		extent: self extent;
+		color: self color;
+		layoutProperties: self layoutProperties;
+		layoutPolicy: self layoutPolicy;
+		borderStyle: self borderStyle;
+		tag: self tag;
+		yourself 
+]
+
 { #category : #'*Sandblocks-Babylonian' }
 Morph >> listensToPermutations [ 
 
 	^ false
 ]
 
+{ #category : #'*Sandblocks-Babylonian' }
+Morph >> satisfiesTag: anotherSBTag [
+
+	^ self tag satisfiesTag: anotherSBTag
+]
+
 { #category : #'*Sandblocks-Babylonian' }
 Morph >> sbWatchValueMorphFor: aSBWatchValue sized: aSBMorphResizer [
 
@@ -32,6 +57,65 @@ Morph >> sbWatchValueMorphFor: aSBWatchValue sized: aSBMorphResizer [
 		yourself
 ]
 
+{ #category : #'*Sandblocks-Babylonian' }
+Morph >> snapshot [
+
+	^ self snapshotSatisfying: {} 
+]
+
+{ #category : #'*Sandblocks-Babylonian' }
+Morph >> snapshotSatisfying: aCollectionOfTags [
+
+	| emptyCopy |
+	"normal morph, doesn't even know tags!"
+	(self hasBeenTagged not and: [ self topLevelTaggedChildren isEmpty ])
+		ifTrue: [^ ImageMorph new newForm: self imageForm ]. 
+
+	"there are some tags in this layout that we want to preserve"
+	emptyCopy := self layoutedTaggedCopy.
+
+	"Not satisfying tag, filter out" 
+	(self hasBeenTagged and: [aCollectionOfTags anySatisfy: [:aTag | (self satisfiesTag: aTag) not ]])
+		ifTrue: [ ^ nil ]. 
+
+	"When this is the last tag in the hierarchy, we can stop right here."
+	(self hasBeenTagged and: [self topLevelTaggedChildren isEmpty]) 
+		ifTrue: [ ^ (ImageMorph new newForm: self imageForm) tag: self tag].
+
+	"Process and add tagged children."
+	^ emptyCopy addAllMorphsBack: ((self submorphs 
+											collect: [:aChild | aChild snapshotSatisfying: aCollectionOfTags])
+											reject: #isNil)
+
+]
+
+{ #category : #'*Sandblocks-Babylonian' }
+Morph >> tag [
+
+	^ self valueOfProperty: #SBTag ifAbsentPut: [ SBNilTag new ]
+]
+
+{ #category : #'*Sandblocks-Babylonian' }
+Morph >> tag: aSBTag [
+
+	self setProperty: #SBTag toValue: aSBTag 
+]
+
+{ #category : #'*Sandblocks-Babylonian' }
+Morph >> topLevelTaggedChildren [
+
+	| childrenToCheck foundTaggedChildren |
+	childrenToCheck := self submorphs asOrderedCollection.
+	foundTaggedChildren := OrderedCollection new.
+	[childrenToCheck isEmpty] whileFalse: [ | child |
+		child := childrenToCheck removeFirst. 
+		child hasBeenTagged
+			ifTrue: [foundTaggedChildren add: child]
+			ifFalse: [childrenToCheck addAll: child submorphs]].
+	^ foundTaggedChildren 
+
+]
+
 { #category : #'*Sandblocks-Babylonian' }
 Morph >> topLevelVariants [
 

packages/Sandblocks-Babylonian/SBCluster.class.st

@@ -114,7 +114,7 @@ SBCluster >> newTopRowFrom: aCollectionOfMorphs [
 		cellPositioning: #topCenter;
 		hResizing: #spaceFill;
 		addAllMorphsBack: (aCollectionOfMorphs collect: [:aMorph | 
-			self morphResizer applyOn: aMorph])
+			self newContainerMorph addMorphBack: (self morphResizer applyOn: aMorph)])
 ]
 
 { #category : #visualisation }
@@ -172,7 +172,7 @@ SBCluster >> wrapInCell: aMorph [
 { #category : #helper }
 SBCluster >> wrapInCell: aMorph flexVertically: aVBoolean flexHorizontally: aHBoolean [
 
-	| cell targetExtent|
+	| cell targetExtent |
 	cell := self newCellMorph.
 	cell on: #click send: #value to: [aMorph triggerEvent: #clicked].
 
@@ -192,7 +192,8 @@ SBCluster >> wrapInCell: aMorph flexVertically: aVBoolean flexHorizontally: aHBo
 	self flag: #todo. "Another way besides turning into an image to keep interactions.-jb"
 	cell addMorph: (ImageMorph new 
 		newForm: (aMorph imageForm scaledIntoFormOfSize: targetExtent);
-		when: #clicked send: #triggerEvent: to: aMorph with: #clicked).
-
+		when: #clicked send: #triggerEvent: to: aMorph with: #clicked;
+		tag: aMorph tag).
+
 	^ cell
 ]

packages/Sandblocks-Babylonian/SBCorrelationCluster.class.st

@@ -55,10 +55,16 @@ SBCorrelationCluster >> buildDisplayMatrix [
 		rows: 2
 		columns: self correlatingUniverses size + 1.
 
-	matrix atRow: 1 put: ({TextMorph new contents: self basePermutation asVariantString}, 
+	matrix atRow: 1 put: ({TextMorph new
+								tag: (SBTag newFromPermutation: self basePermutation); 
+								contents: self basePermutation asVariantString;
+								yourself}, 
 	(self extractedTopHeadingsFrom: self correlatingUniverses)).
 
-	matrix at: 2 at: 1 put: (SBPermutationLabel newDisplaying: self basePermutation).
+	matrix at: 2 at: 1 put: ((SBPermutationLabel 
+								newDisplaying: self basePermutation)
+								tag: (SBTag newFromPermutation: self basePermutation);
+								yourself).
 
 	self extractRow withIndexDo: [:aCellMorph :column | matrix at: 2 at: column+1 put: aCellMorph].
 
@@ -105,19 +111,24 @@ SBCorrelationCluster >> displayedWatch: anSBExampleWatch [
 SBCorrelationCluster >> extractRow [
 
 	^ self correlatingUniverses 
-		collect: [:aUniverse | | display | 
-		display := ((aUniverse watches detect: [:aWatch | aWatch originalIdentifier = self displayedWatch identifier]) 
-					exampleToDisplay at: self displayedExample) value display.
-		self compressedMorphsForDisplay: display]
+		collect: [:aUniverse | | display watchMorph |
+		watchMorph :=  aUniverse watches detect: [:aWatch | aWatch originalIdentifier = self displayedWatch identifier].
+		display := (watchMorph exampleToDisplay at: self displayedExample) value display.
+		(self compressedMorphsForDisplay: display)
+			tag: (SBTag new
+				addFromExample: self displayedExample;
+				addFromWatch: self displayedWatch;
+				addFromPermutation: aUniverse activePermutation )]
 ]
 
 { #category : #building }
 SBCorrelationCluster >> extractedTopHeadingsFrom: aCollectionOfCorrelatingUniverses [
 
-	^ aCollectionOfCorrelatingUniverses collect: [:aCorrelatingUniverse |  
-		SBPartialPermutationLabel 
-			newDisplaying: (aCorrelatingUniverse activePermutation copyRemovingVariants: self basePermutation referencedVariants)
-			referingTo: aCorrelatingUniverse]
+	^ aCollectionOfCorrelatingUniverses collect: [:aCorrelatingUniverse | | partialPermutation |
+		partialPermutation :=  (aCorrelatingUniverse activePermutation copyRemovingVariants: self basePermutation referencedVariants).
+		(SBPartialPermutationLabel 
+			newDisplaying: partialPermutation
+			referingTo: aCorrelatingUniverse)]
 ]
 
 { #category : #visualisation }
@@ -143,7 +154,7 @@ SBCorrelationCluster >> newTopRowFrom: aCollectionOfPermutationLabels [
 		cellPositioning: #bottomCenter;
 		hResizing: #spaceFill;
 		addAllMorphsBack: (aCollectionOfPermutationLabels collect: [:aLabel | 
-			self morphResizer applyOn: aLabel])
+				self newContainerMorph addMorphBack: (self morphResizer applyOn: aLabel)])
 ]
 
 { #category : #helper }
@@ -152,5 +163,4 @@ SBCorrelationCluster >> wrapInCell: aMorph [
 	^ self morphResizer label = SBMorphResizer newIdentity label
 		ifTrue: [self wrapInCell: aMorph flexVertically: true flexHorizontally: true] 
 		ifFalse: [self wrapInCell: aMorph flexVertically: true flexHorizontally: false]
-
 ]

packages/Sandblocks-Babylonian/SBCorrelationView.class.st

@@ -23,19 +23,21 @@ SBCorrelationView >> buildAllPossibleResults [
 
 { #category : #building }
 SBCorrelationView >> buildForExample: anExample watching: aWatch [
-
-	gridContainer addMorphBack: (self containerRow cellPositioning: #center;
-		addAllMorphsBack: {
-			self containerRow listDirection: #topToBottom;
-				addAllMorphsBack: { 
-					SBOwnTextMorph new contents: (
+	gridContainer addMorphBack: (
+		self containerRow 
+			cellPositioning: #center;
+			tag: (SBTag new 
+					addFromExample: anExample;
+					addFromWatch: aWatch);
+			addAllMorphsBack: {
+        SBOwnTextMorph new contents: (
 						'{1} {2}' format: {anExample label.
 											 (aWatch cleanedExpression sourceString withoutLineEndings)}).
-					self containerRow 
-						listDirection: #topToBottom;
-						cellPositioning:  #rightCenter;
-						cellInset: 0@10;
-						addAllMorphsBack: ((self buildGridsFor: anExample watching: aWatch) flatten)}})
+        self containerRow 
+          listDirection: #topToBottom;
+          cellPositioning:  #rightCenter;
+          cellInset: 0@10;
+          addAllMorphsBack: ((self buildGridsFor: anExample watching: aWatch) flatten)})
 ]
 
 { #category : #building }

packages/Sandblocks-Babylonian/SBCustomView.class.st

@@ -42,8 +42,7 @@ SBCustomView >> initialize [
 	self name: 'Results'.
 
 	self buildButtonRow.
-	self block addMorphBack: self selectedView
-
+	self block addMorphBack: self selectedView block.
 ]
 
 { #category : #accessing }

packages/Sandblocks-Babylonian/SBExample.class.st

@@ -25,7 +25,7 @@ SBExample class >> instanceSuggestion [
 		self new
 			self: SBStGrammarHandler new newNullBlock
 			args: (SBStArray new type: #dynamic)
-			label: 'example']
+			label: self nameSuggestion]
 ]
 
 { #category : #'as yet unclassified' }
@@ -47,6 +47,12 @@ SBExample class >> matchingSelectors [
 	^ #(#self:args:label: #self:args:label:assert: #example:args:label: #example:args:label:assert:)
 ]
 
+{ #category : #'as yet unclassified' }
+SBExample class >> nameSuggestion [
+
+	^ 'example {1}' format: {Random generateInteger}
+]
+
 { #category : #'as yet unclassified' }
 SBExample class >> newFor: aMessage [
 
@@ -126,6 +132,16 @@ SBExample >> assertionBlock [
 	^ self submorphCount > 7 ifTrue: [self submorphs ninth] ifFalse: [nil]
 ]
 
+{ #category : #actions }
+SBExample >> backtrack [
+	<action>
+
+	SBExploriants backtrack: #backtrackForExample: withArguments: {self}
+
+
+
+]
+
 { #category : #'event handling' }
 SBExample >> click: anEvent [