Merge pull request #494 from pharo-graphics/dev

merged from dev
pharo-graphics · Apr 15, 2024 · 9c6f7c8 · 9c6f7c8
2 parents 723424d + 9499998
commit 9c6f7c8
Show file tree

Hide file tree

Showing 42 changed files with 137 additions and 275 deletions.
diff --git a/src/Bloc-DevTool/BlElementSelection.class.st b/src/Bloc-DevTool/BlElementSelection.class.st
@@ -122,14 +122,14 @@ BlElementSelection >> initializeActions [
 	resizeButton addEventHandler: (BlEventHandler on: BlDragStartEvent do: [ :evt |
 		initialPosition := evt position.
 		initialSize := self client extent.
-		evt consumed: true ]).
-	resizeButton addEventHandler: (BlEventHandler on: BlDragEndEvent do: [ :evt |  evt consumed: true.]).
+		evt consume ]).
+	resizeButton addEventHandler: (BlEventHandler on: BlDragEndEvent do: [ :evt |  evt consume.]).
 	resizeButton addEventHandler: (BlEventHandler on: BlDragEvent do: [ :evt |
-		evt consumed: true.
+		evt consume.
 		self client size: (initialSize + evt position - initialPosition) ]).
 
 	inspectButton addEventHandler: (BlEventHandler on: BlClickEvent do: [ :evt | 
-		evt consumed: true.
+		evt consume.
 		self client inspect]).
 
 	self addChild: removeButton.
@@ -148,21 +148,21 @@ BlElementSelection >> initializeHandlers [
 	self addEventHandler: (BlEventHandler
 			 on: BlDoubleClickEvent
 			 do: [ :anEvent |
-				 anEvent consumed: true.
+				 anEvent consume.
 				 self close ]).
 	self addEventHandler: (BlEventHandler
 			 on: BlClickEvent
 			 do: [ :anEvent |
 				 anEvent modifiers isShift ifTrue: [
-					 anEvent consumed: true.
+					 anEvent consume.
 					 self client hasParent ifTrue: [
 						 BlElementSelection on: self client parent.
 						 self close ] ] ]).
 	self addEventHandler: (BlEventHandler
 			 on: BlDragStartEvent
 			 do: [ :anEvent |
 				 | aClientOldGlobalPosition aClientNewGlobalPosition |
-				 anEvent consumed: true.
+				 anEvent consume.
 
 				 aClientOldGlobalPosition := self client positionInSpace.
 				 aClientNewGlobalPosition := self space root globalPointToLocal:
@@ -182,7 +182,7 @@ BlElementSelection >> initializeHandlers [
 			 on: BlDragEvent
 			 do: [ :anEvent |
 				 | aPosition |
-				 anEvent consumed: true.
+				 anEvent consume.
 				 aPosition := anEvent position - self dragOffset.
 				 self client position: aPosition ])
 ]

diff --git a/src/Bloc-DevTool/BlSelectionTool.class.st b/src/Bloc-DevTool/BlSelectionTool.class.st
@@ -40,8 +40,8 @@ BlSelectionTool >> dragEvent: anEvent [
 
 { #category : #'dnd handlers' }
 BlSelectionTool >> dragStartEvent: anEvent [
-	anEvent consumed: true.
-
+
+	anEvent consume.
 	self resetCurrentSelections.
 	startPosition := anEvent position.
 	selectionRect size:50@50; position:startPosition.

diff --git a/src/Bloc-Examples/BlClickEventTest.class.st b/src/Bloc-Examples/BlClickEventTest.class.st
@@ -196,18 +196,18 @@ BlClickEventTest >> threeElementsInScripter [
 				   on: BlClickEvent
 				   do: [ :anEvent |
 					   anEventCollection add: #parent.
-					   anEvent consumed: true ]).
+					   anEvent consume ]).
 		  aChild := anElement childAt: 1.
 		  aChild addEventHandler: (BlEventHandler
 				   on: BlClickEvent
 				   do: [ :anEvent |
 					   anEventCollection add: #child.
-					   anEvent consumed: true ]).
+					   anEvent consume ]).
 		  (aChild childAt: 1) addEventHandler: (BlEventHandler
 				   on: BlClickEvent
 				   do: [ :anEvent |
 					   anEventCollection add: #grandchild.
-					   anEvent consumed: true ]).
+					   anEvent consume ]).
 		  anElement ]
 ]
 
@@ -260,18 +260,18 @@ BlClickEventTest >> threeElementsWithFalseChildClippingInScripter [
 				   on: BlClickEvent
 				   do: [ :anEvent |
 					   anEventCollection add: #parent.
-					   anEvent consumed: true ]).
+					   anEvent consume ]).
 		  aChild := anElement childAt: 1.
 		  aChild addEventHandler: (BlEventHandler
 				   on: BlClickEvent
 				   do: [ :anEvent |
 					   anEventCollection add: #child.
-					   anEvent consumed: true ]).
+					   anEvent consume ]).
 		  (aChild childAt: 1) addEventHandler: (BlEventHandler
 				   on: BlClickEvent
 				   do: [ :anEvent |
 					   anEventCollection add: #grandchild.
-					   anEvent consumed: true ]).
+					   anEvent consume ]).
 		  anElement ]
 ]
 
@@ -300,18 +300,18 @@ BlClickEventTest >> threeElementsWithTrueChildClippingInScripter [
 				   on: BlClickEvent
 				   do: [ :anEvent |
 					   anEventCollection add: #parent.
-					   anEvent consumed: true ]).
+					   anEvent consume ]).
 		  aChild := anElement childAt: 1.
 		  aChild addEventHandler: (BlEventHandler
 				   on: BlClickEvent
 				   do: [ :anEvent |
 					   anEventCollection add: #child.
-					   anEvent consumed: true ]).
+					   anEvent consume ]).
 		  (aChild childAt: 1) addEventHandler: (BlEventHandler
 				   on: BlClickEvent
 				   do: [ :anEvent |
 					   anEventCollection add: #grandchild.
-					   anEvent consumed: true ]).
+					   anEvent consume ]).
 		  anElement ]
 ]
 
@@ -338,11 +338,11 @@ BlClickEventTest >> twoElementsInScripter [
 				   on: BlClickEvent
 				   do: [ :anEvent |
 					   anEventCollection add: #parent.
-					   anEvent consumed: true ]).
+					   anEvent consume ]).
 		  (anElement childAt: 1) addEventHandler: (BlEventHandler
 				   on: BlClickEvent
 				   do: [ :anEvent |
 					   anEventCollection add: #child.
-					   anEvent consumed: true ]).
+					   anEvent consume ]).
 		  anElement ]
 ]
diff --git a/src/Bloc-Examples/BlExampleEventsCountingElement.class.st b/src/Bloc-Examples/BlExampleEventsCountingElement.class.st
@@ -258,85 +258,85 @@ BlExampleEventsCountingElement >> initialize [
 	self addEventHandler: (BlEventHandler
 			 on: BlClickEvent
 			 do: [ :anEvent |
-				 anEvent consumed: true.
+				 anEvent consume.
 				 anEvent currentTarget incrementClickCount ]).
 
 	self addEventHandler: (BlEventHandler
 			 on: BlMouseEnterEvent
 			 do: [ :anEvent |
-				 anEvent consumed: true.
+				 anEvent consume.
 				 anEvent currentTarget incrementMouseEnterCount ]).
 
 	self addEventHandler: (BlEventHandler
 			 on: BlMouseLeaveEvent
 			 do: [ :anEvent |
-				 anEvent consumed: true.
+				 anEvent consume.
 				 anEvent currentTarget incrementMouseLeaveCount ]).
 
 	self addEventHandler: (BlEventHandler
 			 on: BlMouseMoveEvent
 			 do: [ :anEvent |
-				 anEvent consumed: true.
+				 anEvent consume.
 				 anEvent currentTarget incrementMouseMoveCount ]).
 
 	self addEventHandler: (BlEventHandler
 			 on: BlMouseOverEvent
 			 do: [ :anEvent |
-				 anEvent consumed: true.
+				 anEvent consume.
 				 anEvent currentTarget incrementMouseOverCount ]).
 
 	self addEventHandler: (BlEventHandler
 			 on: BlMouseOutEvent
 			 do: [ :anEvent |
-				 anEvent consumed: true.
+				 anEvent consume.
 				 anEvent currentTarget incrementMouseOutCount ]).
 
 	self addEventHandler: (BlEventHandler
 			 on: BlMouseDownEvent
 			 do: [ :anEvent |
-				 anEvent consumed: true.
+				 anEvent consume.
 				 anEvent currentTarget incrementMouseDownCount ]).
 
 	self addEventHandler: (BlEventHandler
 			 on: BlMouseUpEvent
 			 do: [ :anEvent |
-				 anEvent consumed: true.
+				 anEvent consume.
 				 anEvent currentTarget incrementMouseUpCount ]).
 
 	self addEventHandler: (BlEventHandler
 			 on: BlDragStartEvent
 			 do: [ :anEvent |
-				 anEvent consumed: true.
+				 anEvent consume.
 				 anEvent currentTarget incrementDragStartCount ]).
 
 	self addEventHandler: (BlEventHandler
 			 on: BlDragEvent
 			 do: [ :anEvent |
-				 anEvent consumed: true.
+				 anEvent consume.
 				 anEvent currentTarget incrementDragCount ]).
 
 	self addEventHandler: (BlEventHandler
 			 on: BlDragEndEvent
 			 do: [ :anEvent |
-				 anEvent consumed: true.
+				 anEvent consume.
 				 anEvent currentTarget incrementDragEndCount ]).
 
 	self addEventHandler: (BlEventHandler
 			 on: BlDragEnterEvent
 			 do: [ :anEvent |
-				 anEvent consumed: true.
+				 anEvent consume.
 				 anEvent currentTarget incrementDragEnterCount ]).
 
 	self addEventHandler: (BlEventHandler
 			 on: BlDragLeaveEvent
 			 do: [ :anEvent |
-				 anEvent consumed: true.
+				 anEvent consume.
 				 anEvent currentTarget incrementDragLeaveCount ]).
 
 	self addEventHandler: (BlEventHandler
 			 on: BlDropEvent
 			 do: [ :anEvent |
-				 anEvent consumed: true.
+				 anEvent consume.
 				 anEvent currentTarget incrementDropCount ]).
 
 	self addEventHandler: (BlEventHandler

diff --git a/src/Bloc-Examples/BlMouseOverOutAndEnterLeaveEventExample.class.st b/src/Bloc-Examples/BlMouseOverOutAndEnterLeaveEventExample.class.st
@@ -128,7 +128,7 @@ BlMouseOverOutAndEnterLeaveEventExample >> mouseEnterAndLeaveConsumed [
 	aMouseEnterHandler := BlEventHandler
 		                      on: BlMouseEnterEvent
 		                      do: [ :anEvent |
-			                      anEvent consumed: true.
+			                      anEvent consume.
 			                      anEvent currentTarget background:
 				                      Color veryVeryLightGray.
 			                      anEvent currentTarget border:
@@ -137,7 +137,7 @@ BlMouseOverOutAndEnterLeaveEventExample >> mouseEnterAndLeaveConsumed [
 	aMouseLeaveHandler := BlEventHandler
 		                      on: BlMouseLeaveEvent
 		                      do: [ :anEvent |
-			                      anEvent consumed: true.
+			                      anEvent consume.
 			                      anEvent currentTarget background: Color white.
 			                      anEvent currentTarget border: BlBorder empty ].
 
@@ -184,7 +184,7 @@ BlMouseOverOutAndEnterLeaveEventExample >> mouseOverAndOutConsumed [
 	aMouseOverHandler := BlEventHandler
 		                     on: BlMouseOverEvent
 		                     do: [ :anEvent |
-			                     anEvent consumed: true.
+			                     anEvent consume.
 			                     anEvent currentTarget background:
 				                     Color veryVeryLightGray.
 			                     anEvent currentTarget border:
@@ -193,7 +193,7 @@ BlMouseOverOutAndEnterLeaveEventExample >> mouseOverAndOutConsumed [
 	aMouseOutHandler := BlEventHandler
 		                    on: BlMouseOutEvent
 		                    do: [ :anEvent |
-			                    anEvent consumed: true.
+			                    anEvent consume.
 			                    anEvent currentTarget background: Color white.
 			                    anEvent currentTarget border: BlBorder empty ].
 

diff --git a/src/Bloc-FocusFinder-Examples/BlFocusExamples.class.st b/src/Bloc-FocusFinder-Examples/BlFocusExamples.class.st
@@ -81,10 +81,12 @@ BlFocusExamples >> cell [
 	^ BlElement new
 		size: 50 @ 30;
 		background: Color random muchLighter darker;
-		addEventHandlerOn: BlFocusEvent do: [ :anEvent | anEvent target border: (BlBorder paint: Color blue width: 2) ];
-		addEventHandlerOn: BlBlurEvent do: [ :anEvent | anEvent target border: BlBorder empty ];
+		addEventHandlerOn: BlFocusEvent
+			do: [ :anEvent | anEvent target border: (BlBorder paint: Color blue width: 2) ];
+		addEventHandlerOn: BlBlurEvent
+			do: [ :anEvent | anEvent target border: BlBorder empty ];
 		addEventHandlerOn: BlClickEvent do: [ :anEvent | 
-			anEvent consumed: true.
+			anEvent consume.
 			anEvent target requestFocus ];
 		yourself
 ]

diff --git a/src/Bloc-FocusFinder-Examples/BlFocusFinderExamples.class.st b/src/Bloc-FocusFinder-Examples/BlFocusFinderExamples.class.st
@@ -17,7 +17,7 @@ BlFocusFinderExamples >> cell [
 			  anEvent currentTarget border:
 					  (BlBorder paint: Color gray width: 1) ];
 		  addEventHandlerOn: BlClickEvent do: [ :anEvent |
-			  anEvent consumed: true.
+			  anEvent consume.
 			  anEvent currentTarget requestFocus ];
 		yourself
 ]

diff --git a/src/Bloc-Infinite/BlInfiniteHorizontalOrientation.class.st b/src/Bloc-Infinite/BlInfiniteHorizontalOrientation.class.st
@@ -133,7 +133,7 @@ BlInfiniteHorizontalOrientation >> mouseWheelEvent: anEvent [
 	dX isZero ifTrue: [ ^ self ].
 
 	anInfiniteElement smoothScrollBy: (dX @ 0) * 200.
-	anEvent consumed: true
+	anEvent consume
 ]
 
 { #category : #'children - geometry' }

diff --git a/src/Bloc-Infinite/BlInfiniteVerticalOrientation.class.st b/src/Bloc-Infinite/BlInfiniteVerticalOrientation.class.st
@@ -131,7 +131,7 @@ BlInfiniteVerticalOrientation >> mouseWheelEvent: anEvent [
 	dY isZero ifTrue: [ ^ self ].
 
 	anInfiniteElement smoothScrollBy: (0 @ dY) * 200.
-	anEvent consumed: true.
+	anEvent consume
 ]
 
 { #category : #'children - geometry' }

diff --git a/src/Bloc-Layout-Resizer/TBlLayoutResizable.trait.st b/src/Bloc-Layout-Resizer/TBlLayoutResizable.trait.st
@@ -31,15 +31,18 @@ TBlLayoutResizable >> fitContentLimited [
 
 { #category : #'t  - layout resizeable' }
 TBlLayoutResizable >> hExact: aNumber [
-
 	"we have to set the size in the constraints because the resizer state is stateless and does not propagate the actual size value"
-	self resizableConstraintsDo: [ :c | c horizontal exact: aNumber ]
+
+	self resizableConstraintsDo: [ :c |
+		(c horizontal isExact and: [ c horizontal resizer size = aNumber ])
+			ifFalse: [ c horizontal exact: aNumber ] ]
 ]
 
 { #category : #'t  - layout resizeable' }
 TBlLayoutResizable >> hFitContent [
 
-	self resizableConstraintsDo: [ :c | c horizontal fitContent ]
+	self resizableConstraintsDo: [ :c |
+		c horizontal isFitContent ifFalse: [ c horizontal fitContent ] ]
 ]
 
 { #category : #'t  - layout resizeable' }
@@ -50,8 +53,9 @@ TBlLayoutResizable >> hFitContentLimited [
 
 { #category : #'t  - layout resizeable' }
 TBlLayoutResizable >> hMatchParent [
-
-	self resizableConstraintsDo: [ :c | c horizontal matchParent ]
+
+	self resizableConstraintsDo: [ :c |
+		c horizontal isMatchParent ifFalse: [ c horizontal matchParent ] ]
 ]
 
 { #category : #'t  - layout resizeable' }
@@ -80,15 +84,18 @@ TBlLayoutResizable >> resizableConstraintsDo: aBlock [
 
 { #category : #'t  - layout resizeable' }
 TBlLayoutResizable >> vExact: aNumber [
-
 	"we have to set the size in the constraints because the resizer state is stateless and does not propagate the actual size value"
-	self resizableConstraintsDo: [ :c | c vertical exact: aNumber ]
+
+	self resizableConstraintsDo: [ :c |
+		(c vertical isExact and: [ c vertical resizer size = aNumber ])
+			ifFalse: [ c vertical exact: aNumber ] ]
 ]
 
 { #category : #'t  - layout resizeable' }
 TBlLayoutResizable >> vFitContent [
-
-	self resizableConstraintsDo: [ :c | c vertical fitContent ]
+
+	self resizableConstraintsDo: [ :c |
+		c vertical isFitContent ifFalse: [ c vertical fitContent ] ]
 ]
 
 { #category : #'t  - layout resizeable' }
@@ -99,6 +106,7 @@ TBlLayoutResizable >> vFitContentLimited [
 
 { #category : #'t  - layout resizeable' }
 TBlLayoutResizable >> vMatchParent [
-
-	self resizableConstraintsDo: [ :c | c vertical matchParent ]
+
+	self resizableConstraintsDo: [ :c |
+		c vertical isMatchParent ifFalse: [ c vertical matchParent ] ]
 ]