From 6a043dcf726f4a075e6d5c36963c92752775cd21 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?St=C3=A9phaneDucasse?= Date: Sat, 15 Nov 2025 21:11:51 +0100 Subject: [PATCH 1/2] Cleaning a bit more inform: --- .../CmdShortcutSetting.class.st | 4 ++-- src/Debugger-Model/DebugContext.class.st | 4 ++-- src/Debugger-Model/DebugSession.class.st | 2 +- src/Debugger-Model/DebuggerEmmergencyLogger.class.st | 2 +- src/Monticello/MCNoChangesException.class.st | 2 +- src/Refactoring-Core/RBInlineAllSendersRefactoring.class.st | 2 +- src/SUnit-Basic-CLI/ClapTestRunner.class.st | 2 +- src/System-Hashing/DigitalSignatureAlgorithm.class.st | 6 ++---- src/Text-Edition/TextPrintIt.extension.st | 2 +- src/Tool-Base/ToolShortcutsCategory.class.st | 2 +- src/Tools/InformDebugger.class.st | 3 ++- 11 files changed, 15 insertions(+), 16 deletions(-) diff --git a/src/Commander-Activators-Shortcut/CmdShortcutSetting.class.st b/src/Commander-Activators-Shortcut/CmdShortcutSetting.class.st index 4e2a9a915fc..13799631598 100644 --- a/src/Commander-Activators-Shortcut/CmdShortcutSetting.class.st +++ b/src/Commander-Activators-Shortcut/CmdShortcutSetting.class.st @@ -79,8 +79,8 @@ CmdShortcutSetting >> realValue: aShortcutActivation [ CmdShortcutSetting >> setToDefault [ shortcutActivation := shortcutActivation revertRedefinedInstanceIfAbsent: [ - self inform: 'Annotation not exists anymore'. - ^self]. + InformativeNotification signal: 'Annotation does not exist anymore'. + ^ self ]. self updated ] diff --git a/src/Debugger-Model/DebugContext.class.st b/src/Debugger-Model/DebugContext.class.st index e036912f805..1096dab2ed3 100644 --- a/src/Debugger-Model/DebugContext.class.st +++ b/src/Debugger-Model/DebugContext.class.st @@ -52,7 +52,7 @@ DebugContext >> blockNotFoundDialog: aMethod with: aText [ message := 'Method for block not found on stack, can''t edit and continue'. "shouldn't edit doits" - aMethod selector isDoIt ifTrue: [ ^ self inform: message ]. + aMethod selector isDoIt ifTrue: [ ^ InformativeNotification signal: message ]. result := self confirm: message @@ -78,7 +78,7 @@ DebugContext >> checkSelectorUnchanged: aSelector [ unchanged := aSelector == self selectedMessageName or: [ self selectedMessageName isDoIt and: [ aSelector numArgs = self selectedMessageName numArgs ] ]. unchanged - ifFalse: [ self inform: 'can''t change selector' ]. + ifFalse: [ InformativeNotification signal: 'can''t change selector' ]. ^ unchanged ] diff --git a/src/Debugger-Model/DebugSession.class.st b/src/Debugger-Model/DebugSession.class.st index e5e9d453a83..b433b8dab90 100644 --- a/src/Debugger-Model/DebugSession.class.st +++ b/src/Debugger-Model/DebugSession.class.st @@ -438,7 +438,7 @@ DebugSession >> rewindContextToMethod: aMethod fromContext: aContext [ ctxt == aContext ifFalse: [ - self inform: 'Method saved, but current context unchanged\because of unwind error. Click OK to see error' withCRs ] + InformativeNotification signal: 'Method saved, but current context unchanged\because of unwind error. Click OK to see error' withCRs ] ifTrue: [ interruptedProcess restartTopWith: aMethod. self stepToFirstInterestingBytecodeIn: interruptedProcess ]. diff --git a/src/Debugger-Model/DebuggerEmmergencyLogger.class.st b/src/Debugger-Model/DebuggerEmmergencyLogger.class.st index c82da32118c..acaf13bb400 100644 --- a/src/Debugger-Model/DebuggerEmmergencyLogger.class.st +++ b/src/Debugger-Model/DebuggerEmmergencyLogger.class.st @@ -34,7 +34,7 @@ DebuggerEmmergencyLogger >> logError: anError forSession: aDebugSession [ inContext: aDebugSession interruptedContext ] on: Error do: [ :err | - self inform: (String streamContents: [ :str | + InformativeNotification signal: (String streamContents: [ :str | str << 'Cannot log error:'. str space. str << anError description. diff --git a/src/Monticello/MCNoChangesException.class.st b/src/Monticello/MCNoChangesException.class.st index 311d9eaa16c..8b31a919a9d 100644 --- a/src/Monticello/MCNoChangesException.class.st +++ b/src/Monticello/MCNoChangesException.class.st @@ -11,5 +11,5 @@ Class { { #category : 'accessing' } MCNoChangesException >> defaultAction [ - self inform: 'No changes' + InformativeNotification signal: 'No changes' ] diff --git a/src/Refactoring-Core/RBInlineAllSendersRefactoring.class.st b/src/Refactoring-Core/RBInlineAllSendersRefactoring.class.st index d4a1baac7c1..c24467bd337 100644 --- a/src/Refactoring-Core/RBInlineAllSendersRefactoring.class.st +++ b/src/Refactoring-Core/RBInlineAllSendersRefactoring.class.st @@ -66,7 +66,7 @@ RBInlineAllSendersRefactoring >> applicabilityPreconditions [ { #category : 'transforming' } RBInlineAllSendersRefactoring >> checkInlinedMethods [ numberReplaced = 0 - ifTrue: [self inform: 'Could not find any senders to inline into'] + ifTrue: [ InformativeNotification signal: 'Could not find any senders to inline into'] ] { #category : 'transforming' } diff --git a/src/SUnit-Basic-CLI/ClapTestRunner.class.st b/src/SUnit-Basic-CLI/ClapTestRunner.class.st index 2ee408632c7..f1d21752261 100644 --- a/src/SUnit-Basic-CLI/ClapTestRunner.class.st +++ b/src/SUnit-Basic-CLI/ClapTestRunner.class.st @@ -88,7 +88,7 @@ ClapTestRunner >> runPackages [ | packages results | packages := self testPackages. - self inform: 'Running tests in ', packages size asString, ' Packages'. + InformativeNotification signal: 'Running tests in ', packages size asString, ' Packages'. results := (self testRunner runPackages: packages) select: #isNotNil. self informResults: results. diff --git a/src/System-Hashing/DigitalSignatureAlgorithm.class.st b/src/System-Hashing/DigitalSignatureAlgorithm.class.st index 0ac18e75320..032f320d12e 100644 --- a/src/System-Hashing/DigitalSignatureAlgorithm.class.st +++ b/src/System-Hashing/DigitalSignatureAlgorithm.class.st @@ -51,10 +51,8 @@ DigitalSignatureAlgorithm class >> example [ msg := 'This is a test...'. keys := self testKeySet. sig := self sign: msg privateKey: keys first. - self inform: 'Signature created'. - (self verify: sig isSignatureOf: msg publicKey: keys last) - ifTrue: [self inform: 'Signature verified.'] - ifFalse: [self error: 'ERROR! Signature verification failed'] + self verify: sig isSignatureOf: msg publicKey: keys last + ] { #category : 'public' } diff --git a/src/Text-Edition/TextPrintIt.extension.st b/src/Text-Edition/TextPrintIt.extension.st index d85b4e6b91b..b50e9504e9a 100644 --- a/src/Text-Edition/TextPrintIt.extension.st +++ b/src/Text-Edition/TextPrintIt.extension.st @@ -5,6 +5,6 @@ TextPrintIt >> actOnClick: anEvent for: anObject in: paragraph editor: editor [ | result | result := Smalltalk compiler receiver: anObject; evaluate: evalString. - self inform: result printString. + InformativeNotification signal: result printString. ^ true ] diff --git a/src/Tool-Base/ToolShortcutsCategory.class.st b/src/Tool-Base/ToolShortcutsCategory.class.st index d38917a3b05..59f117ca1ee 100644 --- a/src/Tool-Base/ToolShortcutsCategory.class.st +++ b/src/Tool-Base/ToolShortcutsCategory.class.st @@ -64,5 +64,5 @@ ToolShortcutsCategory >> saveImage [ shortcut: PharoShortcuts current saveImageShortcut action: [ (Smalltalk snapshot: true andQuit: false) hasSavedSuccessfully - ifTrue: [ self inform: 'Image saved' ] ] + ifTrue: [ InformativeNotification signal: 'Image saved' ] ] ] diff --git a/src/Tools/InformDebugger.class.st b/src/Tools/InformDebugger.class.st index d08572416d3..4030a741411 100644 --- a/src/Tools/InformDebugger.class.st +++ b/src/Tools/InformDebugger.class.st @@ -11,5 +11,6 @@ Class { { #category : 'opening api' } InformDebugger class >> openOn: aDebugSession withFullView: aBool andNotification: aString [ - self inform: (self messageToPrintFrom: aDebugSession) + + InformativeNotification signal: (self messageToPrintFrom: aDebugSession) ] From 75bd7965f875b5a7d1e13dec6d2240d4cacdb102 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?St=C3=A9phaneDucasse?= Date: Tue, 18 Nov 2025 21:41:37 +0100 Subject: [PATCH 2/2] Update ClapTestRunner.class.st Revert SUnit-Basic-Clap because superclass defines an inform: method --- src/SUnit-Basic-CLI/ClapTestRunner.class.st | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/SUnit-Basic-CLI/ClapTestRunner.class.st b/src/SUnit-Basic-CLI/ClapTestRunner.class.st index f1d21752261..2ee408632c7 100644 --- a/src/SUnit-Basic-CLI/ClapTestRunner.class.st +++ b/src/SUnit-Basic-CLI/ClapTestRunner.class.st @@ -88,7 +88,7 @@ ClapTestRunner >> runPackages [ | packages results | packages := self testPackages. - InformativeNotification signal: 'Running tests in ', packages size asString, ' Packages'. + self inform: 'Running tests in ', packages size asString, ' Packages'. results := (self testRunner runPackages: packages) select: #isNotNil. self informResults: results.