hpi-swa · tom95 · Oct 24, 2023 · Oct 11, 2023 · Oct 11, 2023 · Oct 11, 2023
diff --git a/packages/Sandblocks-Babylonian/SBExampleValueDisplay.class.st b/packages/Sandblocks-Babylonian/SBExampleValueDisplay.class.st
@@ -27,7 +27,9 @@ SBExampleValueDisplay >> exampleFinished: anExample [
 	display exampleFinished: anExample.
 
 	statusLabel
-		contents: (hadValue ifTrue: [''] ifFalse: ['- Not reached -']);
+		contents: (hadValue 
+			ifTrue: [''] 
+			ifFalse: ['- Not reached -']);
 		visible: hadValue not
 ]
 

diff --git a/packages/Sandblocks-Babylonian/SBExampleWatch.class.st b/packages/Sandblocks-Babylonian/SBExampleWatch.class.st
@@ -1,5 +1,5 @@
 "
-Observes (watches) an expression locally for added SBExamples. Whenever an example has finished running, it updates its belonging view. Only active watches update their views. Further, with a given modifyExpression, it transforms the watched expression values. Also known as a Probe in the context of Babylonian Smalltalk.
+Observes (watches) an expression locally for added SBExamples. Whenever an example has finished running, it updates its belonging view. Further, with a given modifyExpression, it transforms the watched expression values. Also known as a Probe in the context of Babylonian Smalltalk.
 "
 Class {
 	#name : #SBExampleWatch,
@@ -8,7 +8,6 @@ Class {
 		'identifier',
 		'watchedExpression',
 		'modifyExpression',
-		'isActive',
 		'exampleToDisplay',
 		'exampleToValues'
 	],
@@ -71,7 +70,7 @@ SBExampleWatch class >> registry [
 SBExampleWatch class >> report: aValue for: aSymbol [
 
 	"Compatibility to SBWatch"
-	^ self reportValue: aValue for: aSymbol modifying: (SBStBlockBody identityNamed: 'result').
+	^ self reportValue: aValue for: aSymbol modifying: (SBStBlockBody identityNamed: 'each').
 ]
 
 { #category : #'event handling' }
@@ -112,24 +111,10 @@ SBExampleWatch >> applyModifyExpressionOnValues [
 		anExampleDisplayPair value updateDisplay]
 ]
 
-{ #category : #callbacks }
-SBExampleWatch >> artefactSaved: aBlock [
-
-	"As we are inactive, we have to manually apply our modifyExpression if it changes. 
-	Otherwise, we would reset by examples starting" 
-	(self isActive not and: [aBlock = self containingArtefact]) ifTrue: [self applyModifyExpressionOnValues] 
-]
-
 { #category : #copying }
 SBExampleWatch >> asInactiveCopy [
 
-	^ (self veryDeepCopy) beInactive. 
-]
-
-{ #category : #accessing }
-SBExampleWatch >> beInactive [
-
-	isActive := false
+	^ SBInactiveExampleWatch newFromWatch: self
 ]
 
 { #category : #'colors and color policies' }
@@ -207,7 +192,7 @@ SBExampleWatch >> exampleToValues: anExampleToCollectionOfObjectsDict [
 { #category : #accessing }
 SBExampleWatch >> expression [
 
-	^ watchedExpression
+	^ self submorphs first
 ]
 
 { #category : #accessing }
@@ -245,8 +230,7 @@ SBExampleWatch >> initialize [
 	exampleToDisplay := Dictionary new.
 	exampleToValues := Dictionary new.
 	watchedExpression := SBStMessageSend new.
-	modifyExpression := SBStBlockBody identityNamed: 'result'.
-	isActive := true.
+	modifyExpression := SBStBlockBody identityNamed: 'each'.
 
 	self
 		cellGap: 4;
@@ -268,7 +252,7 @@ SBExampleWatch >> intoWorld: aWorld [
 { #category : #accessing }
 SBExampleWatch >> isActive [
 
-	^ isActive
+	^ true
 ]
 
 { #category : #'*Sandblocks-Babylonian' }
@@ -307,7 +291,7 @@ SBExampleWatch >> layoutCommands [
 { #category : #'*Sandblocks-Babylonian' }
 SBExampleWatch >> listensToExamples [
 
-	^ self isActive 
+	^ true
 ]
 
 { #category : #accessing }
@@ -373,6 +357,12 @@ SBExampleWatch >> reportValue: anObject for: anExample [
 		ifPresent: [:values | values add: anObject]
 ]
 
+{ #category : #accessing }
+SBExampleWatch >> setWatchedExpressionUneditable [
+
+	watchedExpression selectable: false
+]
+
 { #category : #accessing }
 SBExampleWatch >> valuesForExample: anExample [
 

diff --git a/packages/Sandblocks-Babylonian/SBExampleWatch.extension.st b/packages/Sandblocks-Babylonian/SBExampleWatch.extension.st
@@ -15,5 +15,5 @@ SBExampleWatch >> isGlobalWatch [
 { #category : #'*Sandblocks-Babylonian' }
 SBExampleWatch >> listensToExamples [
 
-	^ self isActive 
+	^ true
 ]
diff --git a/packages/Sandblocks-Babylonian/SBInactiveExampleWatch.class.st b/packages/Sandblocks-Babylonian/SBInactiveExampleWatch.class.st
@@ -0,0 +1,50 @@
+"
+Does not update its results anymore. Applying modification expressions is still possible.
+"
+Class {
+	#name : #SBInactiveExampleWatch,
+	#superclass : #SBExampleWatch,
+	#category : #'Sandblocks-Babylonian'
+}
+
+{ #category : #'initialize-release' }
+SBInactiveExampleWatch class >> newFromWatch: anActiveWatch [
+
+	^ (anActiveWatch veryDeepCopy)
+		primitiveChangeClassTo: self basicNew;
+		expression: (SBTextBubble new contents: anActiveWatch expression sourceString);
+		yourself 
+]
+
+{ #category : #callbacks }
+SBInactiveExampleWatch >> artefactSaved: aBlock [
+
+	"As we are inactive, we have to manually apply our modifyExpression if it changes. 
+	Otherwise, we would reset by examples starting" 
+	(aBlock = self containingArtefact) ifTrue: [self applyModifyExpressionOnValues] 
+]
+
+{ #category : #'event handling' }
+SBInactiveExampleWatch >> doubleClick: evt [
+
+	"Nothing"
+]
+
+{ #category : #accessing }
+SBInactiveExampleWatch >> expression: aBlock [
+
+	super expression: aBlock.
+	watchedExpression selectable: false
+]
+
+{ #category : #accessing }
+SBInactiveExampleWatch >> isActive [
+
+	^ false
+]
+
+{ #category : #'*Sandblocks-Babylonian' }
+SBInactiveExampleWatch >> listensToExamples [
+
+	^ false
+]
diff --git a/packages/Sandblocks-Babylonian/SBInactiveExampleWatch.extension.st b/packages/Sandblocks-Babylonian/SBInactiveExampleWatch.extension.st
@@ -0,0 +1,7 @@
+Extension { #name : #SBInactiveExampleWatch }
+
+{ #category : #'*Sandblocks-Babylonian' }
+SBInactiveExampleWatch >> listensToExamples [
+
+	^ false
+]
diff --git a/packages/Sandblocks-Babylonian/SBResultsView.class.st b/packages/Sandblocks-Babylonian/SBResultsView.class.st
@@ -4,6 +4,12 @@ Class {
 	#category : #'Sandblocks-Babylonian'
 }
 
+{ #category : #building }
+SBResultsView >> addAllWatchesFrom: aCollectionOfMethodBlocks [
+
+	self block addAllMorphsBack: (self allWatchesIn: aCollectionOfMethodBlocks)
+]
+
 { #category : #accessing }
 SBResultsView >> allActiveExamples [
 
@@ -65,6 +71,8 @@ SBResultsView >> buildAllPossibleResults [
 	activeExamples := self allActiveExamples.
 	permutations := SBPermutation allPermutationsOf: variants.
 
+	permutations ifEmpty: [self addAllWatchesFrom: watchMethodBlocks].
+
 	[ permutations do: [:aPermutation |
 		SBActiveVariantPermutation value: aPermutation.
 		activeExamples do: #runSynchronouslyIgnoreReturn.

diff --git a/packages/Sandblocks-Babylonian/SBVariantsView.class.st b/packages/Sandblocks-Babylonian/SBVariantsView.class.st
@@ -7,12 +7,18 @@ Class {
 { #category : #building }
 SBVariantsView >> buildMethodSectionFor: aSBStMethod [
 
-	self block addAllMorphsBack: {aSBStMethod methodHeader copy.
+	self block addAllMorphsBack: {aSBStMethod methodDefinition.
 									self containerRow 
 										addAllMorphsBack: (aSBStMethod containedVariants collect: #asProxy).
 									LineMorph from: 0@0 to: 50@0 color: Color black width: 2}
 ]
 
+{ #category : #building }
+SBVariantsView >> buildNoVariantsText [
+
+	self block addMorphBack: (SBOwnTextMorph new contents: 'No variants exist.')
+]
+
 { #category : #initialization }
 SBVariantsView >> initialize [ 
 
@@ -28,5 +34,7 @@ SBVariantsView >> visualize [
 
 	self clean.
 
-	self allMethodBlocksContainingVariants do: [:aSBStMethod | self buildMethodSectionFor: aSBStMethod]
+	self allMethodBlocksContainingVariants 
+		ifNotEmptyDo: [:theMethods | theMethods do: [:aSBStMethod | self buildMethodSectionFor: aSBStMethod]] 
+		ifEmpty: [self buildNoVariantsText]
 ]
diff --git a/packages/Sandblocks-Babylonian/SBWatchValueBlock.class.st b/packages/Sandblocks-Babylonian/SBWatchValueBlock.class.st
@@ -16,7 +16,7 @@ SBWatchValueBlock class >> registerShortcuts: aProvider [
 
 ]
 
-{ #category : #'as yet unclassified' }
+{ #category : #'event handling' }
 SBWatchValueBlock >> doubleClick: evt [
 
 	super doubleClick: evt.
@@ -25,7 +25,7 @@ SBWatchValueBlock >> doubleClick: evt [
 
 { #category : #accessing }
 SBWatchValueBlock >> exploreValue [
-<action>
+	<action>
 
 	self watchValue watchedValue explore
 ]

diff --git a/packages/Sandblocks-Core/SBLabel.class.st b/packages/Sandblocks-Core/SBLabel.class.st
@@ -212,6 +212,14 @@ SBLabel >> symbols [
 	^ delimiter ifNil: [self colorPolicy symbolsForComment: self]
 ]
 
+{ #category : #'as yet unclassified' }
+SBLabel >> text: aSBOwnTextMorph [
+
+	text ifNotNil: [text abandon]. 
+	text := aSBOwnTextMorph.
+	self addMorphBack: text.
+]
+
 { #category : #'as yet unclassified' }
 SBLabel >> textBlock: aBlock [
 

diff --git a/packages/Sandblocks-Core/SBTabView.class.st b/packages/Sandblocks-Core/SBTabView.class.st
@@ -156,6 +156,7 @@ SBTabView >> asTabButton: aNamedBlock [
 
 	aNamedBlock = self active ifTrue: [button makeBold].
 	button when: #contentsChanged send: #updateNameFor:on: to: self withArguments: {aNamedBlock. button}.
+	button when: #doubleClicked send: #triggerEvent: to: self with: #doubleClicked.
 
 	^ button
 ]

diff --git a/packages/Sandblocks-Core/SBTextBubble.class.st b/packages/Sandblocks-Core/SBTextBubble.class.st
@@ -129,6 +129,12 @@ SBTextBubble >> font: aFont [
 	text font: aFont
 ]
 
+{ #category : #'as yet unclassified' }
+SBTextBubble >> guessedClass [ 
+
+	^ nil
+]
+
 { #category : #'as yet unclassified' }
 SBTextBubble >> initialize [
 
@@ -207,7 +213,7 @@ SBTextBubble >> prefix: aString [
 { #category : #'as yet unclassified' }
 SBTextBubble >> printOn: aStream [
 
-	aStream nextPutAll: 'text bubble'
+	aStream nextPutAll: (self contents ifNil: ['text bubble'] ifNotNil: [self contents])
 ]
 
 { #category : #'as yet unclassified' }

diff --git a/packages/Sandblocks-Morphs/SBEditableButton.class.st b/packages/Sandblocks-Morphs/SBEditableButton.class.st
@@ -14,6 +14,10 @@ SBEditableButton >> textMorphFor: aString [
 		when: #clicked
 		send: #doButtonAction  
 		to: self;
+		when: #doubleClicked
+		send: #triggerEvent:
+		to: self
+		with: #doubleClicked;
 		when: #contentsChanged
 		send: #triggerEvent:
 		to: self

diff --git a/packages/Sandblocks-Smalltalk/SBStASTNode.class.st b/packages/Sandblocks-Smalltalk/SBStASTNode.class.st
@@ -24,7 +24,7 @@ SBStASTNode class >> preferredColor [
 SBStASTNode class >> registerShortcuts: aProvider [
 
 	aProvider
-		cmdShortcut: $" do: #wrapInToggledCode;
+		cmdShortcut: $" do: #wrapInOptionalVariant;
 		cmdShortcut: $Q do: #wrapInVariant;
 		noInsertShortcut: $[ do: #wrapInBlock;
 		noInsertShortcut: ${ do: #wrapInDynamicArray;

diff --git a/packages/Sandblocks-Smalltalk/SBStGrammarHandler.class.st b/packages/Sandblocks-Smalltalk/SBStGrammarHandler.class.st
@@ -513,6 +513,29 @@ SBStGrammarHandler >> wrapInMessageSend: aString [
 	^ msg
 ]
 
+{ #category : #actions }
+SBStGrammarHandler >> wrapInOptionalVariant [
+	<multiSelectAction>
+	<actionValidIf: #isSandblock>
+
+	| variant |
+	self assert: self block isSelected.
+	variant := SBVariant new.
+	self block sandblockEditor multiSelectionIsConsecutive ifFalse: [^ self].
+	self block sandblockEditor doMultiSelection: [:selected |
+		SBWrapConsecutiveCommand new
+			selectAfter: #block;
+			outer: variant;
+			targets: selected;
+			wrap: [:outer :inner | 
+				variant 
+					named: inner printString 
+					alternatives:{
+						SBNamedBlock block: (SBStBlockBody new statements: inner) named:'with'. 
+						SBNamedBlock block: (SBStBlockBody empty) named:'without'} 					activeIndex: 2];
+			yourself]
+]
+
 { #category : #actions }
 SBStGrammarHandler >> wrapInReturn [
 	<action>
@@ -559,7 +582,12 @@ SBStGrammarHandler >> wrapInVariant [
 			selectAfter: #block;
 			outer: variant;
 			targets: selected;
-			wrap: [:outer :inner | variant named: inner printString alternatives:{SBNamedBlock block: (SBStBlockBody new statements: inner) named:'alt'} activeIndex: 1];
+			wrap: [:outer :inner | variant 
+				named: inner printString 
+				alternatives: {
+					SBNamedBlock block: (SBStBlockBody new statements: inner) named: 'original'.
+					SBNamedBlock block: (SBStBlockBody new statements: inner veryDeepCopy) named: 'alternative'. } 
+				activeIndex: 2];
 			yourself]
 ]
 

diff --git a/packages/Sandblocks-Smalltalk/SBStMethod.class.st b/packages/Sandblocks-Smalltalk/SBStMethod.class.st
@@ -145,9 +145,15 @@ SBStMethod >> methodClass [
 ]
 
 { #category : #accessing }
-SBStMethod >> methodHeader [
+SBStMethod >> methodDefinition [
 
-	^ self firstSubmorph 
+	^  SBRow new
+			layoutPolicy: SBAlgebraLayout new;
+			addMorphBack: (SBOwnTextMorph new contents: 
+				('{1} >> {2}' 
+					format: {
+					self currentClass name asString.
+					self currentSelector asString})).
 ]
 
 { #category : #'object interface' }