Inspectable Blocks through enter, scrollpane in watch view

hpi-swa · Aug 15, 2023 · 853ebfd · 853ebfd
1 parent ddf9978
commit 853ebfd
Show file tree

Hide file tree

Showing 12 changed files with 132 additions and 33 deletions.
diff --git a/packages/Sandblocks-Babylonian/Collection.extension.st b/packages/Sandblocks-Babylonian/Collection.extension.st
@@ -3,7 +3,7 @@ Extension { #name : #Collection }
 { #category : #'*Sandblocks-Babylonian' }
 Collection >> sbWatchValueMorphFor: traceValue [
 
-	^ SBWatchValue newContainerMorph 
+	^ (SBWatchValue newContainerMorphFor: traceValue) 
 		addMorph: (SBStringMorph new contents: self printString)
 		yourself
 ]
diff --git a/packages/Sandblocks-Babylonian/Color.extension.st b/packages/Sandblocks-Babylonian/Color.extension.st
@@ -3,7 +3,7 @@ Extension { #name : #Color }
 { #category : #'*Sandblocks-Babylonian' }
 Color >> sbWatchValueMorphFor: traceValue [
 
-	^ SBWatchValue newContainerMorph 
+	^ (SBWatchValue newContainerMorphFor: traceValue) 
 		addMorph: self asMorph; 
 		yourself
 ]
diff --git a/packages/Sandblocks-Babylonian/Form.extension.st b/packages/Sandblocks-Babylonian/Form.extension.st
@@ -9,7 +9,7 @@ Form >> sbSnapshot [
 { #category : #'*Sandblocks-Babylonian' }
 Form >> sbWatchValueMorphFor: traceValue [
 
-	^ SBWatchValue newContainerMorph 
+	^ (SBWatchValue newContainerMorphFor: traceValue)  
 		addMorphBack: (SBIcon iconFor: traceValue watchedValueIdentityHash) asMorph;
 		addMorphBack: self asMorph;
 		yourself

diff --git a/packages/Sandblocks-Babylonian/Morph.extension.st b/packages/Sandblocks-Babylonian/Morph.extension.st
@@ -3,7 +3,7 @@ Extension { #name : #Morph }
 { #category : #'*Sandblocks-Babylonian' }
 Morph >> sbWatchValueMorphFor: traceValue [
 
-	^ SBWatchValue newContainerMorph 
+	^ (SBWatchValue newContainerMorphFor: traceValue)  
 		addMorphBack: (SBIcon iconFor: traceValue watchedValueIdentityHash) asMorph;
 		addMorphBack: self asMorph;
 		yourself

diff --git a/packages/Sandblocks-Babylonian/Number.extension.st b/packages/Sandblocks-Babylonian/Number.extension.st
@@ -3,7 +3,7 @@ Extension { #name : #Number }
 { #category : #'*Sandblocks-Babylonian' }
 Number >> sbWatchValueMorphFor: traceValue [
 
-	^ SBWatchValue newContainerMorph 
+	^ (SBWatchValue newContainerMorphFor: traceValue)  
 		addMorphBack:  (SBStringMorph new contents: self printString);
 		yourself
 ]
diff --git a/packages/Sandblocks-Babylonian/Object.extension.st b/packages/Sandblocks-Babylonian/Object.extension.st
@@ -20,7 +20,7 @@ Object >> sbWatchValueMorphFor: traceValue [
 
 	"This has to return a container block"
 
-	^ SBWatchValue newContainerMorph 
+	^ (SBWatchValue newContainerMorphFor: traceValue) 
 		addMorphBack: (SBIcon iconFor: traceValue watchedValueIdentityHash) asMorph;
 		addMorphBack: (SBStringMorph new contents: (' ' , self printString));
 		yourself

diff --git a/packages/Sandblocks-Babylonian/SBWatchValue.class.st b/packages/Sandblocks-Babylonian/SBWatchValue.class.st
@@ -9,9 +9,10 @@ Class {
 }
 
 { #category : #utility }
-SBWatchValue class >> newContainerMorph [
+SBWatchValue class >> newContainerMorphFor: aWatchValue [
 
-	^ SBBlock new
+	^ SBWatchValueBlock new
+		watchValue: aWatchValue;
 		layoutPolicy: SBHorizontalLayout new;
 		vResizing: #shrinkWrap;
 		hResizing: #shrinkWrap;
@@ -33,6 +34,21 @@ SBWatchValue >> asValueMorph [
 	^ self watchedValue sbWatchValueMorphFor: self
 ]
 
+{ #category : #accessing }
+SBWatchValue >> explore [
+
+	self watchedValue explore
+]
+
+{ #category : #'initialize-release' }
+SBWatchValue >> initialize [ 
+
+	super initialize.
+
+	watchedValue := 0.
+	watchedValueIdentityHash := 0 identityHash.
+]
+
 { #category : #printing }
 SBWatchValue >> printOn: aSteam [
 

diff --git a/packages/Sandblocks-Babylonian/SBWatchValueBlock.class.st b/packages/Sandblocks-Babylonian/SBWatchValueBlock.class.st
@@ -0,0 +1,36 @@
+Class {
+	#name : #SBWatchValueBlock,
+	#superclass : #SBBlock,
+	#instVars : [
+		'watchValue'
+	],
+	#category : #'Sandblocks-Babylonian'
+}
+
+{ #category : #'as yet unclassified' }
+SBWatchValueBlock class >> registerShortcuts: aProvider [
+
+	aProvider registerShortcut: Character cr do: #exploreValue.
+	aProvider cmdShortcut: $i do: #exploreValue.
+
+
+]
+
+{ #category : #accessing }
+SBWatchValueBlock >> exploreValue [
+<action>
+
+	self watchValue watchedValue explore
+]
+
+{ #category : #accessing }
+SBWatchValueBlock >> watchValue [
+
+	^ watchValue ifNil: [watchValue := SBWatchValue new] 
+]
+
+{ #category : #accessing }
+SBWatchValueBlock >> watchValue: aSBWatchValue [
+
+	watchValue := aSBWatchValue
+]
diff --git a/packages/Sandblocks-Babylonian/String.extension.st b/packages/Sandblocks-Babylonian/String.extension.st
@@ -3,7 +3,7 @@ Extension { #name : #String }
 { #category : #'*Sandblocks-Babylonian' }
 String >> sbWatchValueMorphFor: traceValue [
 
-	^ SBWatchValue newContainerMorph 
+	^ (SBWatchValue newContainerMorphFor: traceValue) 
 		addMorphBack: (SBStringMorph new contents: self asText)
 		yourself
 ]
diff --git a/packages/Sandblocks-Babylonian/Text.extension.st b/packages/Sandblocks-Babylonian/Text.extension.st
@@ -3,7 +3,7 @@ Extension { #name : #Text }
 { #category : #'*Sandblocks-Babylonian' }
 Text >> sbWatchValueMorphFor: traceValue [
 
-	^ SBWatchValue newContainerMorph 
+	^ (SBWatchValue newContainerMorphFor: traceValue)  
 		addMorphBack: (SBStringMorph new contents: self)
 		yourself
 ]
diff --git a/packages/Sandblocks-Watch/SBExampleWatchView.class.st b/packages/Sandblocks-Watch/SBExampleWatchView.class.st
@@ -7,14 +7,6 @@ Class {
 	#category : #'Sandblocks-Watch'
 }
 
-{ #category : #accessing }
-SBExampleWatchView >> display [
-
-	(self submorphCount >= 2)
-		ifFalse: [self addMorph: (self defaultDisplay) atIndex: 2].
-	^self submorphs second
-]
-
 { #category : #'event handling' }
 SBExampleWatchView >> exampleFinished: anExample [
 

diff --git a/packages/Sandblocks-Watch/SBWatchView.class.st b/packages/Sandblocks-Watch/SBWatchView.class.st
@@ -47,7 +47,7 @@ SBWatchView >> clear [
 	count contents: '0'.
 	watchValues := LinkedList new.
 
-	self display replaceBy: (self placeholder: 0 @ 0).
+	self scroller removeAllMorphs.
 	clear
 		disableLayout: true;
 		visible: false
@@ -60,28 +60,42 @@ SBWatchView >> count [
 ]
 
 { #category : #display }
-SBWatchView >> defaultDisplay [ 
+SBWatchView >> defaultDisplay [
 
-	^ SBBlock new 
-		layoutPolicy: SBHorizontalLayout new;
+	^ SBBlock new
+		changeTableLayout;
+		listDirection: #topToBottom;
+		hResizing: #shrinkWrap;
 		vResizing: #shrinkWrap;
-		hResizing: #shrinkWrap
+		addMorphBack: (ScrollPane new
+			color: Color transparent;
+			borderWidth: 0;
+			vScrollBarPolicy: #never;
+			showHScrollBarOnlyWhenNeeded;
+			scrollBarThickness: self scrollBarHeight;
+			width: 20;
+			height: 20)
 ]
 
 { #category : #accessing }
 SBWatchView >> display [
 
-	(self submorphCount >= 3)
-		ifFalse: [self addMorph: (self defaultDisplay) atIndex: 2].
 	^self submorphs second
 ]
 
 { #category : #display }
 SBWatchView >> displayWatchValues [
-
-	self display delete.
-
-	watchValues do: [:v | self display addMorphBack: (self valueMorphFor: v)]
+
+	| valuesMorph |
+	self scroller removeAllMorphs.
+	valuesMorph := self watchValuesContainer.
+	watchValues do: [:v | valuesMorph addMorphBack: (self valueMorphFor: v)].
+
+	self scroller addMorph: valuesMorph.
+	self scrollPane height: valuesMorph height + self scrollBarHeight.
+	self scrollPane width: (valuesMorph width <= self maxWidth 
+		ifTrue: [valuesMorph width] 
+		ifFalse: [self maxWidth]).
 ]
 
 { #category : #'colors and color policies' }
@@ -118,7 +132,7 @@ SBWatchView >> initialize [
 			contents: '0';
 			balloonText: 'Number of reported values';
 			yourself);
-		addMorphBack: (self placeholder: 0 @ 0);
+		addMorphBack: self defaultDisplay;
 		addMorphBack: (clear := SBIcon iconTrash
 			on: #click send: #clear to: self;
 			disableLayout: true;
@@ -139,10 +153,16 @@ SBWatchView >> layoutCommands [
 		data: (self submorphs collect: #layoutCommands separatedBy: [SBAlgebraCommand gap])
 ]
 
+{ #category : #accessing }
+SBWatchView >> maxWidth [
+
+	^ 450
+]
+
 { #category : #'event handling' }
 SBWatchView >> noValue [
 
-	self display ifNotNil: [self display replaceBy: (self placeholder: self display fullBounds extent)]
+	self scroller removeAllMorphs 
 ]
 
 { #category : #accessing }
@@ -159,9 +179,9 @@ SBWatchView >> object [
 ]
 
 { #category : #'event handling' }
-SBWatchView >> placeholder: aPoint [
+SBWatchView >> placeholder [
 
-	^ Morph new color: Color transparent; extent: aPoint
+	^  Morph new color: Color transparent; extent: (0@0)
 ]
 
 { #category : #printing }
@@ -182,6 +202,24 @@ SBWatchView >> reportValue: anObject [
 		Project current addDeferredUIMessage: [self updateDisplay]]
 ]
 
+{ #category : #accessing }
+SBWatchView >> scrollBarHeight [
+
+	^ 5 sbScaled 
+]
+
+{ #category : #accessing }
+SBWatchView >> scrollPane [
+
+	^ self display lastSubmorph
+]
+
+{ #category : #accessing }
+SBWatchView >> scroller [
+
+	^ self scrollPane scroller
+]
+
 { #category : #'object interface' }
 SBWatchView >> storeAsExample [
 
@@ -211,6 +249,7 @@ SBWatchView >> updateDisplay [
 { #category : #display }
 SBWatchView >> useDisplay: aDisplay [
 
+	self flag:#todo.
 	self display delete.
 	self addMorph: aDisplay atIndex: 2. 
 ]
@@ -221,12 +260,14 @@ SBWatchView >> valueMorphFor: traceValue [
 	| morph |
 	morph := traceValue asValueMorph.
 	morph on: #doubleClick send: #value to: [traceValue watchedValue explore].
+	morph on: #keyStroke send: #keyStroke to: traceValue.
 	^ morph 
 ]
 
 { #category : #accessing }
 SBWatchView >> values [
 
+	watchValues ifEmpty: [^{}].
 	^ numSavedValues = 1 ifTrue: [watchValues last watchedValue] ifFalse: [^ watchValues collect: [:value | value watchedValue]]
 ]
 
@@ -256,3 +297,17 @@ SBWatchView >> watchValues: aLinkedList [
 
 	watchValues := aLinkedList
 ]
+
+{ #category : #display }
+SBWatchView >> watchValuesContainer [
+
+	^ SBRow new
+		color: Color transparent;
+		vResizing: #shrinkWrap;
+		hResizing: #shrinkWrap;
+		cellPositioning: #topLeft;
+		changeTableLayout;
+		listDirection: #leftToRight;
+		layoutInset: 1;
+		borderWidth: 0
+]