Merge pull request #18657 from Ducasse/cleaningUIManager

Ducasse · web-flow · commit 6d01f4cc07c0 · 2025-10-14T14:32:50.000+02:00
Make sure that we move on Morphic fading out.
diff --git a/bootstrap/scripts/4-build.sh b/bootstrap/scripts/4-build.sh
diff --git a/bootstrap/scripts/runKernelTests.sh b/bootstrap/scripts/runKernelTests.sh
diff --git a/src/Calypso-Browser/ClyBrowserMorph.class.st b/src/Calypso-Browser/ClyBrowserMorph.class.st
@@ -311,7 +311,7 @@ ClyBrowserMorph >> close [
 { #category : 'tools support' }
 ClyBrowserMorph >> confirmDiscardChanges [
 
-	^self confirm: 'Changes have not been saved.
+	^ (Smalltalk at: #StPharoApplication) current confirm: 'Changes have not been saved.
 Is it OK to discard changes?'
 ]
 
diff --git a/src/Calypso-SystemPlugins-ClassScripts-Queries/ClyClassScriptsExample.class.st b/src/Calypso-SystemPlugins-ClassScripts-Queries/ClyClassScriptsExample.class.st
@@ -9,40 +9,56 @@ Class {
 	#package : 'Calypso-SystemPlugins-ClassScripts-Queries'
 }
 
-{ #category : 'class initialization' }
-ClyClassScriptsExample class >> initialize [
-	self inform: 'it is class initialization example from ', self name
-]
-
 { #category : 'methods with examples' }
 ClyClassScriptsExample class >> methodWithExample [
+	"
+	Don't use self inform: it does not exist anymore
+	But you can get the logic of the pragma.
+	
 	<example>
-	self inform: 'it is example string from ', self name.
-
-	^'it is example string'
+	^ 'it is example string from ', self name.
+"
 ]
 
 { #category : 'methods with samples' }
 ClyClassScriptsExample class >> methodWithSample [
+	"
+Don't use self inform: it does not exist anymore
+	But you can get the logic of the pragma.
+	
 	<sampleInstance>
 
-	^'it is string sample instance from ', self name
+	^'it is string sample instance from ', self name"
 ]
 
 { #category : 'methods with scripts' }
 ClyClassScriptsExample class >> methodWithScript [
+	"
+	Don't use self inform: it does not exist anymore
+	But you can get the logic of the pragma.
+	
 	<script>
-	self inform: 'It is example method with script from ', self name
+	self inform: 'It is example method with script from ', self name"
 ]
 
 { #category : 'methods with scripts' }
 ClyClassScriptsExample class >> methodWithScriptWithArgument [
-	<script: 'self inform: ''It is example method with script with argument from '', self name'>
+	"
+	Don't use self inform: it does not exist anymore
+	But you can get the logic of the pragma.
+	
+	<script: 'self inform: ''It is example method with script with argument from '', self name'>"
 ]
 
 { #category : 'methods with script' }
 ClyClassScriptsExample >> instSideMethodWithScriptWithArgument [
+	"
+	Don't use self inform: it does not exist anymore
+	But you can get the logic of the pragma.
+	
+	
 	<script: 'self inform: ''It is example inst side method with script with argument from '', self name'>
+	"
 ]
 
 { #category : 'see class side' }
diff --git a/src/Calypso-SystemTools-QueryBrowser/ClyBrowserMorph.extension.st b/src/Calypso-SystemTools-QueryBrowser/ClyBrowserMorph.extension.st
@@ -95,7 +95,7 @@ ClyBrowserMorph >> spawnQueryBrowserOn: aQuery withState: navigationBlock [
 		In that case we do not need a query browser because it will be always empty and useless"
 		targetQuery semiAsync hasEmptyResult ifTrue: [
 			"For slow queries we will not wait and open a browser to indicate execution progress"
-			^self inform: 'There are no ', targetQuery description ]  ].
+			^ (Smalltalk at: #StPharoApplication) current inform: 'There are no ', targetQuery description ]  ].
 
 	self 
 		spawnBrowser: (Smalltalk tools toolNamed: #messageList)
diff --git a/src/Debugger-Model/DebugContext.class.st b/src/Debugger-Model/DebugContext.class.st
@@ -84,7 +84,8 @@ DebugContext >> checkSelectorUnchanged: aSelector [
 
 { #category : 'ui requests' }
 DebugContext >> confirm: message trueChoice: trueChoice falseChoice: falseChoice [
-
+	self halt.
+	"YOU SHOULD NOT CALL UIMANAGER"
 	^ UIManager default
 		confirm: message
 		trueChoice: trueChoice
diff --git a/src/Debugger-Model/DebuggerEmmergencyLogger.class.st b/src/Debugger-Model/DebuggerEmmergencyLogger.class.st
@@ -28,7 +28,6 @@ DebuggerEmmergencyLogger >> logError: anError forSession: aDebugSession [
 		                  on: Error
 		                  do: [ 'a ' , anError class printString ].
 
-	self inform: errDescription.
 	[
 	Smalltalk
 		logError: errDescription contents
diff --git a/src/EpiceaBrowsers/EpLogBrowserPresenter.class.st b/src/EpiceaBrowsers/EpLogBrowserPresenter.class.st
@@ -250,7 +250,6 @@ EpLogBrowserPresenter >> fileOutSelection [
 	| entries |
 	entries := self selectedCodeChanges collect: [ :each | each content ].
 	EpChunkExporter new
-		"application: application;"
 		application: StPharoApplication current; 
 		fileOut: entries.
 
diff --git a/src/Kernel-CodeModel/Class.class.st b/src/Kernel-CodeModel/Class.class.st
@@ -910,9 +910,7 @@ Class >> rename: aString [
 		ifTrue: [^ self error: newName , ' already exists'].
 	self setName: newName.
 	self environment renameClass: self from: oldName.
-	(self undeclaredRegistry includesKey: newName)
-		ifTrue: [self inform: 'There are references to, ' , aString printString , '
-from the undeclared registry. Check them after this change.']
+	
 ]
 
 { #category : 'private' }
diff --git a/src/Kernel-Tests/BlockClosureTest.class.st b/src/Kernel-Tests/BlockClosureTest.class.st
@@ -445,99 +445,6 @@ BlockClosureTest >> testSetUp [
 	self assert: (aBlock method isNil or: [ aBlock method isKindOf: CompiledCode ])
 ]
 
-{ #category : 'tests' }
-BlockClosureTest >> testSupplyAnswerOfFillInTheBlank [
-
-	self
-		assert:
-			([ ProvideAnswerNotification signal: 'Your favorite color?' ]
-				 valueSupplyingAnswer: #( 'Your favorite color?'
-				    'blue' ))
-		equals: 'blue'
-]
-
-{ #category : 'tests' }
-BlockClosureTest >> testSupplyAnswerOfFillInTheBlankUsingDefaultAnswer [
-
-	self
-		assert: ([
-			 (ProvideAnswerNotification signal: 'Your favorite color?')
-			 == #default ifTrue: [ 'red' ] ] valueSupplyingAnswer:
-				 #( 'Your favorite color?' #default ))
-		equals: 'red'
-]
-
-{ #category : 'tests' }
-BlockClosureTest >> testSupplyAnswerThroughNestedBlocks [
-
-	self should: [true = ([[self confirm: 'You like Smalltalk?']
-		valueSupplyingAnswer: #('Blub' false)] valueSupplyingAnswer: #('Smalltalk' true))]
-]
-
-{ #category : 'tests' }
-BlockClosureTest >> testSupplyAnswerUsingOnlySubstringOfQuestion [
-
-	self should: [false = ([self confirm: 'You like Smalltalk?']
-		valueSupplyingAnswer: #('like' false))]
-]
-
-{ #category : 'tests' }
-BlockClosureTest >> testSupplyAnswerUsingRegexMatchOfQuestion [
-
-	(String includesSelector: #matchesRegex:) ifFalse: [^ self].
-
-	self should: [true = ([self confirm: 'You like Smalltalk?']
-		valueSupplyingAnswer: #('.*Smalltalk\?' true))]
-]
-
-{ #category : 'tests' }
-BlockClosureTest >> testSupplyAnswerUsingTraditionalMatchOfQuestion [
-
-	self should: [true = ([self confirm: 'You like Smalltalk?']
-		valueSupplyingAnswer: #('*Smalltalk#' true))]
-]
-
-{ #category : 'tests' }
-BlockClosureTest >> testSupplySameAnswerToAllQuestions [
-
-	self should: [true = ([self confirm: 'You like Smalltalk?'] valueSupplyingAnswer: true)].
-
-	self should: [#(true true) = ([{self confirm: 'One'. self confirm: 'Two'}] valueSupplyingAnswer: true)]
-]
-
-{ #category : 'tests' }
-BlockClosureTest >> testSupplySeveralAnswersToSeveralQuestions [
-
-	self should: [#(false true) = ([{self confirm: 'One'. self confirm: 'Two'}]
-		valueSupplyingAnswers: #( ('One' false) ('Two' true) ))].
-
-	self should: [#(true false) = ([{self confirm: 'One'. self confirm: 'Two'}]
-		valueSupplyingAnswers: #( ('One' true) ('Two' false) ))]
-]
-
-{ #category : 'tests' }
-BlockClosureTest >> testSupplySpecificAnswerToQuestion [
-
-	self should: [false = ([self confirm: 'You like Smalltalk?']
-		valueSupplyingAnswer: #('You like Smalltalk?' false))]
-]
-
-{ #category : 'tests' }
-BlockClosureTest >> testSuppressInform [
-
-	self should: [[nil inform: 'Should not see this message or this test failed!'] valueSuppressingAllMessages isNil]
-]
-
-{ #category : 'tests' }
-BlockClosureTest >> testSuppressInformUsingStringMatchOptions [
-
-	self should: [([nil inform: 'Should not see this message or this test failed!'] valueSuppressingMessages: #('Should not see this message or this test failed!')) isNil].
-
-	self should: [([nil inform: 'Should not see this message or this test failed!'] valueSuppressingMessages: #('not see this message')) isNil].
-
-	self should: [([nil inform: 'Should not see this message or this test failed!'] valueSuppressingMessages: #('*message*failed#')) isNil]
-]
-
 { #category : 'tests - evaluating' }
 BlockClosureTest >> testValueWithArguments [
 
diff --git a/src/Morphic-Core/PasteUpMorph.class.st b/src/Morphic-Core/PasteUpMorph.class.st
@@ -229,7 +229,7 @@ PasteUpMorph >> closeAllUnchangedWindows [
 
 { #category : 'Morphic-Base-Windows' }
 PasteUpMorph >> closeAllWindowsDiscardingChanges [
-	self world systemWindows do: [:w | [w delete] valueSupplyingAnswer: false]
+	self world systemWindows do: [:w | w delete ]
 ]
 
 { #category : 'Morphic-Base-Windows' }
diff --git a/src/Refactoring-UI/ReInteractionDriver.class.st b/src/Refactoring-UI/ReInteractionDriver.class.st
@@ -153,11 +153,20 @@ ReInteractionDriver >> furtherActionFor: aReport [
 	aReport browse
 ]
 
+{ #category : 'ui requests' }
+ReInteractionDriver >> inform: aString [
+
+	self informDialog
+				label: aString;
+				title: 'Watch out!';
+				openModal 
+]
+
 { #category : 'private' }
 ReInteractionDriver >> informConditions: conditions [ 
 	"The receiver has multiple failed applicability conditions and more than one could fail, inform all failures"
 
-	conditions do: [ : cond | self inform: cond errorString ].
+	conditions do: [ :cond | self inform: cond errorString ].
 ]
 
 { #category : 'private' }
diff --git a/src/System-Settings-Core/AbstractStoredSetting.class.st b/src/System-Settings-Core/AbstractStoredSetting.class.st
@@ -90,8 +90,8 @@ AbstractStoredSetting >> settingNodeIdentifier: aString [
 AbstractStoredSetting >> updateSettingNode: aSettingNode [
 	| value |
 	[ value := self realValue ] on: Error do: [ :exception | "ignore and leave"
-		self inform: 'Cannot read stored value of ', self settingNodeIdentifier, '. Exception: ', exception printString.
+			Warning signal: 'Cannot read stored value of ', self settingNodeIdentifier, '. Exception: ', exception printString.
 		^ self ].
 	[ aSettingNode realValue: value ] on: Error do: [ :exception | "inform and ignore"
-		self inform: 'Cannot update ', self settingNodeIdentifier, '. Exception: ', exception printString ]
+		Warning signal: 'Cannot update ', self settingNodeIdentifier, '. Exception: ', exception printString ]
 ]
diff --git a/src/System-Settings-Tests/SettingsStonReaderTest.class.st b/src/System-Settings-Tests/SettingsStonReaderTest.class.st
@@ -44,8 +44,12 @@ SettingsStonReaderTest >> testLoadNotExistingClassNameForRealValue [
 	reader load.
 	self assert: reader storedSettings isNotNil.
 	self assert: reader storedSettings size equals: 1.
-	self should: [  reader storedSettings first realValue ] raise: NotFound.
-	reader storedSettings first updateSettingNode: nil
+	self should: [  
+			[ reader storedSettings first realValue ] 
+				on: Warning 
+				do: [ :ex | ex resume ]
+		 ] raise: KeyNotFound.
+	self should: [ reader storedSettings first updateSettingNode: nil ] raise: Warning
 ]
 
 { #category : 'tests' }
diff --git a/src/UIManager/Object.extension.st b/src/UIManager/Object.extension.st
@@ -6,15 +6,17 @@ Object >> confirm: queryString [
 	response is yes, false if no. This is a modal question--the user must
 	respond yes or no."
 
-	"nil confirm: 'Are you hungry?'"
-
+	self halt.
+	"DO NOT CALL THIS METHOD!"
 	^ UIManager default confirm: queryString
 ]
 
 { #category : '*UIManager' }
 Object >> inform: aString [
 	"Display a message for the user to read and then dismiss."
-
+	
+	self halt.
+	"DO NOT CALL THIS METHOD!"
 	aString isEmptyOrNil
 		ifFalse: [ UIManager default inform: aString ]
 ]
@@ -29,5 +31,7 @@ Object >> primitiveError: aString [
 
 { #category : '*UIManager' }
 Object >> uiManager [
+
+	self halt.
 	^ UIManager default
 ]
diff --git a/tests/run-cli-tests.sh b/tests/run-cli-tests.sh

Original file line number	Diff line number	Diff line change
`@@ -311,7 +311,7 @@ ClyBrowserMorph >> close [`
`311`	`311`	`{ #category : 'tools support' }`
`312`	`312`	`ClyBrowserMorph >> confirmDiscardChanges [`
`313`	`313`
`314`		`- ^self confirm: 'Changes have not been saved.`
	`314`	`+ ^ (Smalltalk at: #StPharoApplication) current confirm: 'Changes have not been saved.`
`315`	`315`	`Is it OK to discard changes?'`
`316`	`316`	`]`
`317`	`317`
Original file line number	Diff line number	Diff line change
`@@ -28,7 +28,6 @@ DebuggerEmmergencyLogger >> logError: anError forSession: aDebugSession [`
`28`	`28`	`on: Error`
`29`	`29`	`do: [ 'a ' , anError class printString ].`
`30`	`30`
`31`		`- self inform: errDescription.`
`32`	`31`	`[`
`33`	`32`	`Smalltalk`
`34`	`33`	`logError: errDescription contents`