Debugger dynamic layouts

src/NewTools-Debugger/StDebugger.class.st

@@ -93,6 +93,9 @@ Class {
 		'EnableStackColoring',
 		'FastTDD'
 	],
+	#classInstVars : [
+		'layoutConfigurator'
+	],
 	#category : 'NewTools-Debugger-View',
 	#package : 'NewTools-Debugger',
 	#tag : 'View'
@@ -122,6 +125,19 @@ StDebugger class >> closeAllDebuggers [
 	self allInstancesDo: [ :dbg | dbg close ]
 ]
 
+{ #category : 'accessing' }
+StDebugger class >> configureLayout [
+	 ^self layoutConfigurator selectedLayout
+]
+
+{ #category : 'accessing' }
+StDebugger class >> configureLayout: aSymbol [
+
+	self layoutConfigurator selectedLayout: aSymbol.
+	SystemAnnouncer uniqueInstance announce:
+		StDebuggerLayoutChangedAnnouncement new
+]
+
 { #category : 'instance creation' }
 StDebugger class >> debugSession: aDebugSession [
 
@@ -140,6 +156,21 @@ StDebugger class >> debuggerContextClass [
 	^ StDebuggerContext
 ]
 
+{ #category : 'accessing' }
+StDebugger class >> debuggerLayoutSettingsOn: aBuilder [
+
+	<systemsettings>
+	(aBuilder pickOne: #configureLayout)
+		parent: #debugging;
+		label: 'Debugger Layout';
+		target: StDebugger;
+		default: #beVerticalStackThenCode;
+		domainValues:
+			#( #beHorizontalCodeThenStack #beHorizontalStackThenCode
+			   #beVerticalCodeThenStack #beVerticalStackThenCode );
+		description: ''
+]
+
 { #category : 'accessing' }
 StDebugger class >> defaultDebuggerRank [
 
@@ -201,6 +232,13 @@ StDebugger class >> initialize [
 	EnableStackColoring := true
 ]
 
+{ #category : 'accessing' }
+StDebugger class >> layoutConfigurator [
+
+	^ layoutConfigurator ifNil: [
+		  layoutConfigurator := StDebuggerLayoutConfiguration new ]
+]
+
 { #category : 'opening' }
 StDebugger class >> openOn: aDebugSession withFullView: aBool [
 
@@ -370,7 +408,7 @@ StDebugger >> code [
 	^ code
 ]
 
-{ #category : 'specs' }
+{ #category : 'layout' }
 StDebugger >> codeLayout [
 
 	^ SpBoxLayout newTopToBottom
@@ -671,6 +709,7 @@ StDebugger >> initialize [
 	self debuggerActionModel updateContextPredicate.
 	self forceSessionUpdate.
   	self susbcribeToExtensionToggleAnnouncement.
+	self susbcribeToLayoutChangesAnnouncement.
 
 	programmaticallyClosed := false.
 ]
@@ -1144,17 +1183,15 @@ StDebugger >> stack [
 
 ]
 
-{ #category : 'specs' }
+{ #category : 'layout' }
 StDebugger >> stackAndCodeLayout [
 
-	^ SpPanedLayout newTopToBottom
-		positionOfSlider: 30 percent;
-		add: self stackLayout;
-		add: self codeLayout;
-		yourself
+	^ self class layoutConfigurator configureForLayouts: {
+			  (#stack -> self stackLayout).
+			  (#code -> self codeLayout) } asDictionary
 ]
 
-{ #category : 'specs' }
+{ #category : 'layout' }
 StDebugger >> stackAndCodeWithExtensionsLayout [
 
 	^ (SpPanedLayout newLeftToRight
@@ -1199,7 +1236,7 @@ StDebugger >> stackIconForContext: context [
 	^ self iconNamed: #overlayDirty
 ]
 
-{ #category : 'specs' }
+{ #category : 'layout' }
 StDebugger >> stackLayout [
 	^ SpBoxLayout newTopToBottom
 		add: #stackHeader
@@ -1291,6 +1328,15 @@ StDebugger >> susbcribeToExtensionToggleAnnouncement [
 		to: self
 ]
 
+{ #category : 'subscription' }
+StDebugger >> susbcribeToLayoutChangesAnnouncement [
+
+	SystemAnnouncer uniqueInstance weak
+		when: StDebuggerLayoutChangedAnnouncement
+		send: #updateLayout
+		to: self
+]
+
 { #category : 'accessing - presenters' }
 StDebugger >> toolbar [
 
@@ -1443,6 +1489,13 @@ StDebugger >> updateInspectorFromContext: aContext [
 	inspector getRawInspectorPresenterOrNil ifNotNil: [ :p | p update ]
 ]
 
+{ #category : 'updating' }
+StDebugger >> updateLayout [
+
+	self setStackAndCodeContainer.
+	self layout: self defaultLayout
+]
+
 { #category : 'initialization' }
 StDebugger >> updatePresenter [
 

src/NewTools-Debugger/StDebuggerLayoutChangedAnnouncement.class.st

@@ -0,0 +1,10 @@
+"
+I am announced when the debugger layout has changed, to allow open debuggers to dynamically update their layouts.
+"
+Class {
+	#name : 'StDebuggerLayoutChangedAnnouncement',
+	#superclass : 'Announcement',
+	#category : 'NewTools-Debugger-Model',
+	#package : 'NewTools-Debugger',
+	#tag : 'Model'
+}

src/NewTools-Debugger/StDebuggerLayoutConfiguration.class.st

@@ -0,0 +1,83 @@
+"
+A trivial layout configurator for the `StDebugger`. 
+It is configureable through api methods.
+To change the layout, it takes as input a dictionary with the name of the element to layout associated to the element itself.
+"
+Class {
+	#name : 'StDebuggerLayoutConfiguration',
+	#superclass : 'Object',
+	#instVars : [
+		'order',
+		'selectedLayout'
+	],
+	#category : 'NewTools-Debugger-Model',
+	#package : 'NewTools-Debugger',
+	#tag : 'Model'
+}
+
+{ #category : 'configuration' }
+StDebuggerLayoutConfiguration >> beHorizontalCodeThenStack [
+
+	order := #( #code #stack ).
+	^ SpPanedLayout newLeftToRight
+		  positionOfSlider: 30 percent;
+		  yourself
+]
+
+{ #category : 'configuration' }
+StDebuggerLayoutConfiguration >> beHorizontalStackThenCode [
+
+	order := #( #stack #code ).
+	^ SpPanedLayout newLeftToRight
+		  positionOfSlider: 30 percent;
+		  yourself
+]
+
+{ #category : 'configuration' }
+StDebuggerLayoutConfiguration >> beVerticalCodeThenStack [
+
+	order := #( #code #stack ).
+	^ SpPanedLayout newTopToBottom
+		  positionOfSlider: 30 percent;
+		  yourself
+]
+
+{ #category : 'configuration' }
+StDebuggerLayoutConfiguration >> beVerticalStackThenCode [
+
+	order := #( #stack #code ).
+	^ SpPanedLayout newTopToBottom
+		  positionOfSlider: 30 percent;
+		  yourself
+]
+
+{ #category : 'configuration' }
+StDebuggerLayoutConfiguration >> configureForLayouts: layoutsDictionary [
+
+	| layout |
+	layout := self perform: selectedLayout.
+
+	order do: [ :layoutSymbol |
+		layoutsDictionary at: layoutSymbol ifPresent: [ :l | layout add: l ] ].
+
+	^ layout
+]
+
+{ #category : 'initialization' }
+StDebuggerLayoutConfiguration >> initialize [
+
+	order := #( #stack #code ).
+	selectedLayout := #beVerticalStackThenCode
+]
+
+{ #category : 'accessing' }
+StDebuggerLayoutConfiguration >> selectedLayout [
+
+	^ selectedLayout
+]
+
+{ #category : 'accessing' }
+StDebuggerLayoutConfiguration >> selectedLayout: anObject [
+
+	selectedLayout := anObject
+]