4f90f25f464d — Gerald Klix (speedy) tip 5 days ago
SUM: Action buttons are now properly formated in list morphs.
M haver/ui/ActionButtons.pck.st +75 -11
@@ 1,6 1,6 @@ 
-'From Haver 6.0 [latest update: #5485] on 19 September 2022 at 2:08:19 am'!
+'From Haver 6.0 [latest update: #5488] on 19 September 2022 at 8:26:59 pm'!
 'Description '!
-!provides: 'ActionButtons' 1 14!
+!provides: 'ActionButtons' 1 15!
 SystemOrganization addCategory: 'ActionButtons'!
 
 

          
@@ 9,9 9,9 @@ Modules newEnvironment: #ActionButtons!
 
 !interfacesOf: ActionButtons!
 Modules environment: #ActionButtons ::
-	interface: #API exporting: #(#ActionButtonContainer #TargetButton #TargetToggleButton ) ::
-	interface: #SPI aliasFor: #API ::
-	interface: #UTI aliasFor: #API!
+	interface: #API exporting: #(#TargetToggleButton #TargetButton #ActionButtonContainer ) ::
+	interface: #UTI aliasFor: #API ::
+	interface: #SPI aliasFor: #API!
 
 
 !classDefinition: (Modules>>#ActionButtons>>#TextRequestMorph) category: 'ActionButtons'!

          
@@ 121,10 121,48 @@ I am an action button that sends a messa
 !(Modules>>#ActionButtons>>#TargetToggleButton) commentStamp: '<historical>' prior: 0!
 I am a toggle.!
 
-!(Modules>>#ActionButtons>>#ActionButton) class methodsFor: 'instance creation' stamp: 'KLG 8/24/2022 22:05:45'!
+!(Modules>>#ActionButtons>>#ActionButton) class methodsFor: 'instance creation' stamp: 'KLG 9/19/2022 18:27:17'!
 initializedInstance
 
-	^self contents: `'Demo' black, ' ',  'Button' bold`! !
+	^ self source: '"Answer an action button that opens a browser for itself."
+
+	| browser |
+		browser _ Browser new.
+		browser setClass: (Modules>>#ActionButtons>>#ActionButton) selector: nil. 
+		BrowserWindow 
+			open: browser
+			label: ''System Browser: '', ''ActionButton'''! !
+
+!(Modules>>#ActionButtons>>#TargetButton) class methodsFor: 'instance creation' stamp: 'KLG 9/19/2022 18:37:37'!
+initializedInstance
+	"Answer a target button that opens a browser for itself."
+
+	^ self contents: 'Browse ', 'TargetButton' bold block: [ | browser |
+		browser _ Browser new.
+			browser setClass: TargetButton selector: nil. 
+			BrowserWindow 
+				open: browser
+				label: 'System Browser: ', 'TargetButton' ] ::
+					setBalloonText: 'Open a SystemBrowser for ', 'TargetButton' bold! !
+
+!(Modules>>#ActionButtons>>#TargetToggleButton) class methodsFor: 'instance creation' stamp: 'KLG 9/19/2022 18:43:19'!
+initializedInstance
+	"Answer a target button that toogles the Taskbar visibility."
+
+	^ self contents: 'Toggle ', 'taskbar' bold block: [
+		self runningWorld ifNotNil: [ :world |
+			world taskbar
+				ifNotNil: [ world hideTaskbar ]
+				ifNil: [ world showTaskbar ] ] ] ::
+					setBalloonText: [
+						self runningWorld ifNotNil: [ :world |
+							world taskbar
+								ifNil: [ `'Show the ', 'Taskbar' bold` ]
+								ifNotNil: [ `'Hide the ', 'Taskbar' bold` ] ] ] ::
+					isOn: (
+					self runningWorld
+						ifNotNil: [ :world | world taskbar notNil ]
+						ifNil: [ false ])! !
 
 !(Modules>>#ActionButtons>>#TextRequestMorph) methodsFor: 'private' stamp: 'KLG 8/25/2022 15:03:33'!
 getUserResponseOrCancel: aBlock

          
@@ 174,6 212,25 @@ allowsSubmorphDrag
 	"Use a property test to allow individual instances to specify this."
 	^ true! !
 
+!(Modules>>#ActionButtons>>#AbstractActionMorph) methodsFor: 'geometry' stamp: 'KLG 9/19/2022 19:33:01'!
+adjustExtent
+
+	self fit
+
+	
+
+	! !
+
+!(Modules>>#ActionButtons>>#AbstractActionMorph) methodsFor: 'fonts' stamp: 'KLG 9/19/2022 20:03:23'!
+tryToUseOwnersFont: aStringOrText
+	"Try to use my owners font."
+
+	| fontToUse |
+	fontToUse _ [ self owner fontToUse ]
+		onDNU: #fontToUse
+		do: [ ^ aStringOrText ].
+	^ aStringOrText asText font: fontToUse! !
+
 !(Modules>>#ActionButtons>>#AbstractActionButton) methodsFor: 'event handling testing' stamp: 'KLG 8/29/2022 18:21:09'!
 allowsMorphDrop
 	"Answer whether we accept dropping morphs. By default answer false."

          
@@ 459,18 516,25 @@ contents
 
 	^ textComposition textComposed copy! !
 
-!(Modules>>#ActionButtons>>#AbstractActionButton) methodsFor: 'accessing' stamp: 'KLG 8/30/2022 14:33:48'!
+!(Modules>>#ActionButtons>>#AbstractActionButton) methodsFor: 'accessing' stamp: 'KLG 9/19/2022 19:51:59'!
 contents: aStringOrText
 	"Set my contents".
 
 	textComposition	
 		initialize;
-		setModel: (TextModel withText: aStringOrText);
+		setModel: (TextModel withText: (self tryToUseOwnersFont: aStringOrText));
 		extentForComposing: self extentForComposing;
 		composeAll.
 	extent _ textComposition usedExtent + (4 * borderWidth).
 	self redrawNeeded! !
 
+!(Modules>>#ActionButtons>>#AbstractActionButton) methodsFor: 'submorphs-accessing' stamp: 'KLG 9/19/2022 20:00:49'!
+noteNewOwner: aMorph
+	"I have just been added as a submorph of aMorph"
+
+	super noteNewOwner: aMorph.
+	self contents: (self tryToUseOwnersFont: textComposition textComposed)! !
+
 !(Modules>>#ActionButtons>>#ActionButton) methodsFor: 'events' stamp: 'KLG 8/27/2022 22:46:11'!
 performButton1Action: aMouseButtonEvent
 	"Perform the button 1 action"

          
@@ 762,7 826,7 @@ performButton2Action: aMouseButtonEvent
 	isOn _ isOn not.
 	super performButton2Action: aMouseButtonEvent! !
 
-!(Modules>>#ActionButtons>>#TargetToggleButton) methodsFor: 'drawing' stamp: 'KLG 9/18/2022 20:38:41'!
+!(Modules>>#ActionButtons>>#TargetToggleButton) methodsFor: 'drawing' stamp: 'KLG 9/19/2022 19:21:13'!
 backgroundColor
 	"Answer my background color."
 

          
@@ 777,7 841,7 @@ backgroundColor
 				ifFalse: [
 					isOn ifTrue: [ `Color green` ] ifFalse: [ `Color blue` ] ] ]
 			ifFalse: [ 
-				isOn ifTrue: [ `Color black` ] ifFalse: [ `Color darkGray alpha: 0.2` ] ] ]! !
+				isOn ifTrue: [ `Color black alpha: 0.5` ] ifFalse: [ `Color darkGray alpha: 0.2` ] ] ]! !
 
 !(Modules>>#ActionButtons>>#TargetToggleButton) methodsFor: 'accessing' stamp: 'KLG 9/18/2022 22:10:10'!
 isOn

          
M haver/ui/DNDIndentingListItemMorph.pck.st +33 -12
@@ 1,6 1,6 @@ 
-'From Haver 6.0 [latest update: #5485] on 19 September 2022 at 3:48:01 pm'!
+'From Haver 6.0 [latest update: #5488] on 19 September 2022 at 8:27:30 pm'!
 'Description Drag and Drop for the Indenting list item morph.'!
-!provides: 'DNDIndentingListItemMorph' 1 3!
+!provides: 'DNDIndentingListItemMorph' 1 4!
 SystemOrganization addCategory: 'DNDIndentingListItemMorph'!
 
 

          
@@ 10,7 10,7 @@ Modules newEnvironment: #DNDIndentingLis
 !interfacesOf: DNDIndentingListItemMorph!
 Modules environment: #DNDIndentingListItemMorph ::
 	interface: #API exporting: #(#(#HierarchicalListMorph #DNDHierarchicalListMorph ) ) ::
-	interface: #SPI exporting: #(#DNDIndentingListItemMorph #DNDDraggingGuideMorph #DNDInnerHierarchicalListMorph #DNDHierarchicalListMorph ) ::
+	interface: #SPI exporting: #(#DNDHierarchicalListMorph #DNDInnerHierarchicalListMorph #DNDDraggingGuideMorph #DNDIndentingListItemMorph ) ::
 	interface: #UTI aliasFor: #API!
 
 

          
@@ 117,6 117,14 @@ is: aSymbol
 
 	^aSymbol == #DNDInnerHierarchicalListMorph or: [ super is: aSymbol ]! !
 
+!(Modules>>#DNDIndentingListItemMorph>>#DNDInnerHierarchicalListMorph) methodsFor: 'geometry' stamp: 'KLG 9/19/2022 19:07:10'!
+adjustExtent
+	"And reposition submorphs"
+
+	self submorphsDo: [ :subSmurf | 
+		[ subSmurf adjustExtent ] onDNU: #adjustExtent do: [] ].
+	super adjustExtent! !
+
 !(Modules>>#DNDIndentingListItemMorph>>#DNDIndentingListItemMorph) methodsFor: 'event handling testing' stamp: 'KLG 11/20/2020 16:51:31'!
 allowsMorphDrop
 	"Answer whether we accept dropping morphs. By default answer true."

          
@@ 164,7 172,7 @@ initWithContents: anObject prior: priorM
 	[ anObject submorphsToDisplay ] onDNU: #submorphsToDisplay do: [ ^ self ] :: do: [ :morph |
 		self addMorph: morph ]! !
 
-!(Modules>>#DNDIndentingListItemMorph>>#DNDIndentingListItemMorph) methodsFor: 'drawing' stamp: 'KLG 9/19/2022 13:56:30'!
+!(Modules>>#DNDIndentingListItemMorph>>#DNDIndentingListItemMorph) methodsFor: 'drawing' stamp: 'KLG 9/19/2022 20:23:02'!
 drawOn: aCanvas
 
 	| x colorToUse centeringOffset |

          
@@ 191,7 199,7 @@ drawOn: aCanvas
 			ifFalse: [ aCanvas drawNotExpandedAt: x@(extent y//2) ]].
 	x _ x + 18.
 
-	icon isNil ifFalse: [
+	icon ifNotNil: [
 		centeringOffset _ ((extent y - icon height) / 2.0) roundedHAFZ.
 		 aCanvas 
 			image: icon

          
@@ 201,22 209,23 @@ drawOn: aCanvas
 	colorToUse _ complexContents preferredColor ifNil: [ color ].
 	aCanvas
 		drawString: contents asString
-		at: x@0
+		at: x @ ((self morphHeight - self fontToUse pointSize) //4)
 		font: self fontToUse
 		color: colorToUse! !
 
-!(Modules>>#DNDIndentingListItemMorph>>#DNDIndentingListItemMorph) methodsFor: 'layout' stamp: 'KLG 9/19/2022 14:07:40'!
+!(Modules>>#DNDIndentingListItemMorph>>#DNDIndentingListItemMorph) methodsFor: 'layout' stamp: 'KLG 9/19/2022 18:53:23'!
 layoutSubmorphs
 	"Compute a new layout based on the given layout bounds."
 
-	| startX |
+	| runningX |
 	submorphs isEmpty ifTrue: [
 		self layoutNeeded: false.
 		^ self ].
-	startX _ 0.
-	submorphs do: [ :subSmurf |
-		subSmurf morphPosition: (startX @ subSmurf morphPosition y).
-		startX _ startX + subSmurf morphWidth + 3 ].
+	self submorphsDo: [ :subSmurf |		subSmurf ensureMinimimExtent ].
+	runningX _ 0.
+	self submorphsDo: [ :subSmurf |
+		subSmurf morphPosition: (runningX @ subSmurf morphPosition y).
+		runningX _ runningX + subSmurf morphWidth + 3 ].
 	self layoutNeeded: false.! !
 
 !(Modules>>#DNDIndentingListItemMorph>>#DNDIndentingListItemMorph) methodsFor: 'private' stamp: 'KLG 9/19/2022 15:01:31'!

          
@@ 229,6 238,18 @@ toggleRectangle
 	submorphs ifEmpty: [ ^ toggleRectangle ].
 	^ toggleRectangle translatedBy: submorphs last morphWidth @ 0! !
 
+!(Modules>>#DNDIndentingListItemMorph>>#DNDIndentingListItemMorph) methodsFor: 'geometry' stamp: 'KLG 9/19/2022 19:10:11'!
+adjustExtent
+	"And reposition submorphs"
+
+	| h y |
+	y _ 0.
+	self submorphsDo: [ :m |
+		h _ m morphHeight.
+		m morphPosition: 0 @ y extent: m morphWidth @ h.
+		y _ y + h ].
+	self morphExtent: self morphWidth @ y! !
+
 !(Modules>>#DNDIndentingListItemMorph>>#DNDHierarchicalListMorph) methodsFor: 'initialization' stamp: 'KLG 11/20/2020 10:39:00'!
 indentingItemClass
 	"Answer the morphs class that holds the items."

          
M haver/ui/WindowSets.pck.st +7 -11
@@ 1,8 1,8 @@ 
-'From Haver 6.0 [latest update: #5488] on 19 September 2022 at 2:16:50 pm'!
+'From Haver 6.0 [latest update: #5488] on 19 September 2022 at 8:27:09 pm'!
 'Description I provide sets of windows on the desktop.'!
-!provides: 'WindowSets' 1 5!
+!provides: 'WindowSets' 1 6!
 !requires: 'SystemMorphs' 1 5 nil!
-!requires: 'ActionButtons' 1 14 nil!
+!requires: 'ActionButtons' 1 15 nil!
 SystemOrganization addCategory: 'WindowSets'!
 
 

          
@@ 11,8 11,8 @@ Modules newEnvironment: #WindowSets!
 
 !interfacesOf: WindowSets!
 Modules environment: #WindowSets ::
-	interface: #SPI aliasFor: #API ::
-	interface: #UTI aliasFor: #API!
+	interface: #UTI aliasFor: #API ::
+	interface: #SPI aliasFor: #API!
 
 !importsOf: WindowSets!
 Modules environment: #WindowSets :: 

          
@@ 401,15 401,11 @@ initializedModelBlock
 
 	^ [ WindowSetsBrowser new]! !
 
-!(Modules>>#WindowSets>>#WindowSetItemWrapper) methodsFor: 'converting' stamp: 'KLG 9/18/2022 23:06:11'!
+!(Modules>>#WindowSets>>#WindowSetItemWrapper) methodsFor: 'converting' stamp: 'KLG 9/19/2022 20:04:33'!
 asString
 	"Answer a suitable string."
 
-	^ String streamContents: [ :stream |
-		item id printOn: stream length: 2 zeroPadded: true.
-		stream
-			nextPut: `Character space`;
-			nextPutAll: item name ]! !
+	^ item name! !
 
 !(Modules>>#WindowSets>>#WindowSetItemWrapper) methodsFor: 'as yet unclassified' stamp: 'KLG 9/18/2022 23:15:16'!
 preferredColor