From 249ac337d53550ea75ec23e2bce7e35e29e9dc14 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?St=C3=A9phaneDucasse?= Date: Mon, 4 Sep 2023 19:12:18 +0200 Subject: [PATCH 1/4] - confirm:label: done --- .../IceGitHubTipPullRequestBrowser.class.st | 4 ++-- Iceberg-Tests/IceParameterizedTestCase.class.st | 9 ++++++--- Iceberg-TipUI/IceTipFetchAllProjectCommand.class.st | 10 ++++++---- 3 files changed, 14 insertions(+), 9 deletions(-) diff --git a/Iceberg-Plugin-GitHub/IceGitHubTipPullRequestBrowser.class.st b/Iceberg-Plugin-GitHub/IceGitHubTipPullRequestBrowser.class.st index bd01a9c54d..6b69f7f713 100644 --- a/Iceberg-Plugin-GitHub/IceGitHubTipPullRequestBrowser.class.st +++ b/Iceberg-Plugin-GitHub/IceGitHubTipPullRequestBrowser.class.st @@ -217,8 +217,8 @@ IceGitHubTipPullRequestBrowser >> mergeButton [ { #category : #actions } IceGitHubTipPullRequestBrowser >> mergePullRequestIntoImage [ - (UIManager default confirm: - ('I will create a new local branch named {1}. Should I continue?' + (self confirm: + ('I will create a new local branch named {1}. Should I continue?' format: { self pullRequest branchName })) ifFalse: [ ^ self ]. IceGitHubAPI ensureCredentials. diff --git a/Iceberg-Tests/IceParameterizedTestCase.class.st b/Iceberg-Tests/IceParameterizedTestCase.class.st index ac693316a4..e2bc3be42a 100644 --- a/Iceberg-Tests/IceParameterizedTestCase.class.st +++ b/Iceberg-Tests/IceParameterizedTestCase.class.st @@ -135,12 +135,15 @@ IceParameterizedTestCase >> printOn: aStream [ { #category : #running } IceParameterizedTestCase >> setUp [ + super setUp. - oldShareRepositoriesBetweenImages := IceLibgitRepository shareRepositoriesBetweenImages. + oldShareRepositoriesBetweenImages := IceLibgitRepository + shareRepositoriesBetweenImages. IceLibgitRepository shareRepositoriesBetweenImages: false. provider := IceCredentialsProvider providerType. - IceCredentialsProvider providerType: IceNonInteractiveCredentialsProvider. - self parameters do: #activate. + IceCredentialsProvider providerType: + IceNonInteractiveCredentialsProvider. + self parameters do: [ :each | each activate ] ] { #category : #running } diff --git a/Iceberg-TipUI/IceTipFetchAllProjectCommand.class.st b/Iceberg-TipUI/IceTipFetchAllProjectCommand.class.st index bebf124f75..738ba20fd4 100644 --- a/Iceberg-TipUI/IceTipFetchAllProjectCommand.class.st +++ b/Iceberg-TipUI/IceTipFetchAllProjectCommand.class.st @@ -56,8 +56,10 @@ IceTipFetchAllProjectCommand >> iconName [ { #category : #executing } IceTipFetchAllProjectCommand >> isConfirmed [ - ^ UIManager default - confirm: - 'This operation can take some times depending on the size and number of your repositories. Are you sure you want to fetch all repositories?' - label: 'Proceed?' + ^ self application newConfirm + title: 'Proceed?'; + label: + 'This operation can take some times depending on the size and number of your repositories. Are you sure you want to fetch all repositories?'; + openModal + ] From 2cc94d472bdef838863ae70a7e8378122ad63a70 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?St=C3=A9phaneDucasse?= Date: Mon, 4 Sep 2023 19:30:55 +0200 Subject: [PATCH 2/4] Addressing confirm:label:trueChoice:falseChoice:c..... --- .../IceTipInteractiveErrorVisitor.class.st | 101 +++++++++--------- .../IceMetacelloRepositoryAdapter.class.st | 19 ++-- 2 files changed, 60 insertions(+), 60 deletions(-) diff --git a/Iceberg-TipUI/IceTipInteractiveErrorVisitor.class.st b/Iceberg-TipUI/IceTipInteractiveErrorVisitor.class.st index 1068785bc8..5bfe5e25f7 100644 --- a/Iceberg-TipUI/IceTipInteractiveErrorVisitor.class.st +++ b/Iceberg-TipUI/IceTipInteractiveErrorVisitor.class.st @@ -100,18 +100,16 @@ IceTipInteractiveErrorVisitor >> visitCloneRemoteNotFound: anError [ { #category : #visiting } IceTipInteractiveErrorVisitor >> visitExperimentalFeature: aWarning [ + | proceed | - - proceed := UIManager default - confirm: aWarning messageText - label: 'Warning!' - trueChoice: 'Continue' - falseChoice: 'Cancel' - cancelChoice: nil - default: false. - - proceed ifNil: [ ^ self ]. - proceed ifTrue: [ aWarning resume ] + proceed := context application newConfirm + label: aWarning messageText; + title: 'Warning!'; + acceptLabel: 'Continue'; + cancelLabel: 'Cancel'; + openModal. + proceed ifFalse: [ ^ self ]. + aWarning resume ] { #category : #visiting } @@ -151,18 +149,17 @@ IceTipInteractiveErrorVisitor >> visitMissingCredentialsError: anError [ { #category : #visiting } IceTipInteractiveErrorVisitor >> visitNoCommitMessage: aWarning [ + | proceed | - - proceed := UIManager default - confirm: aWarning messageText - label: 'Warning!' - trueChoice: 'Commit' - falseChoice: 'Cancel' - cancelChoice: nil - default: false. - - proceed ifNil: [ ^ self ]. - proceed ifTrue: [ aWarning resume ] + proceed := context application newConfirm + label: aWarning messageText; + title: 'Warning!'; + acceptLabel: 'Commit'; + cancelLabel: 'Cancel'; + openModal. + + proceed ifFalse: [ ^ self ]. + aWarning resume ] { #category : #visiting } @@ -194,32 +191,32 @@ IceTipInteractiveErrorVisitor >> visitRemoteAlreadyExistError: anError [ { #category : #visiting } IceTipInteractiveErrorVisitor >> visitRemoteDesynchronizedError: anError [ + | continue command | - - continue := UIManager default - confirm: ('Your repository is out of sync with remote {1}. -You need to pull remote changes before continue and push your changes.' format: { anError remote }) - label: 'Remote repository out of sync!' - trueChoice: 'Pull' - falseChoice: 'Cancel' - cancelChoice: nil - default: false. - (continue isNil or: [continue not]) - ifTrue: [ ^ self ]. + continue := context application newConfirm + label: + ('Your repository is out of sync with remote {1}. +You need to pull remote changes before continue and push your changes.' + format: { anError remote }); + title: 'Remote repository out of sync!'; + acceptLabel: 'Pull'; + cancelLabel: 'Cancel'; + openModal. + (continue isNil or: [ continue not ]) ifTrue: [ ^ self ]. command := IcePullRemoteCommand new - repository: self repository; - remote: anError remote; - yourself. + repository: self repository; + remote: anError remote; + yourself. [ command executeWithContext: context ] - on: IceMergeAborted, IceShouldCommitBeforePull - do: [ :e | - self flag: #pharoTodo. "Refactor this" - (e isKindOf: IceShouldCommitBeforePull) - ifTrue: [ e resume ] - ifFalse: [ e acceptError: self ] ]. - + on: IceMergeAborted , IceShouldCommitBeforePull + do: [ :e | + self flag: #pharoTodo. "Refactor this" + (e isKindOf: IceShouldCommitBeforePull) + ifTrue: [ e resume ] + ifFalse: [ e acceptError: self ] ]. + command isSuccess ifFalse: [ ^ self ]. anError isResumable ifTrue: [ ^ anError resume ]. anError retry @@ -227,17 +224,17 @@ You need to pull remote changes before continue and push your changes.' format: { #category : #visiting } IceTipInteractiveErrorVisitor >> visitShouldCommitBeforePullError: anError [ + | continue | - continue := UIManager default - confirm: - 'Your repository has uncommited changes. Merging incoming commits will change + continue := context application newConfirm + label: + 'Your repository has uncommited changes. Merging incoming commits will change your current working copy and your current state will not be recoverable. -We recommend that you commit first and then pull incoming changes again.' - label: 'You might loose your current changes!' - trueChoice: 'Proceed anyway' - falseChoice: 'Cancel' - cancelChoice: nil - default: false. +We recommend that you commit first and then pull incoming changes again.'; + title: 'You might loose your current changes!'; + acceptLabel: 'Proceed anyway'; + cancelLabel: 'Cancel'; + openModal. continue ifFalse: [ ^ self ]. anError resume ] diff --git a/Iceberg/IceMetacelloRepositoryAdapter.class.st b/Iceberg/IceMetacelloRepositoryAdapter.class.st index 519e2bf060..0d48f7aa09 100644 --- a/Iceberg/IceMetacelloRepositoryAdapter.class.st +++ b/Iceberg/IceMetacelloRepositoryAdapter.class.st @@ -120,15 +120,18 @@ IceMetacelloRepositoryAdapter >> isValid [ { #category : #MonticelloGUI } IceMetacelloRepositoryAdapter >> morphicOpen: workingCopy [ + | shouldOpenIceberg | - shouldOpenIceberg := UIManager default - confirm: ('{1} belongs to {2} and cannot be browsed here. -Do you want to open the Iceberg Browser instead?' format: { workingCopy packageName. self repository name }) - label: 'Browsing an iceberg repository' - trueChoice: 'Open' - falseChoice: 'Cancel' - cancelChoice: nil - default: true. + shouldOpenIceberg := + SpApplication defaultApplication newConfirm + title: 'Browsing an iceberg repository'; + label: ('{1} belongs to {2} and cannot be browsed here. +Do you want to open the Iceberg Browser instead?' format: { + workingCopy packageName. + self repository name }); + acceptLabel: 'Open'; + cancelLabel: 'Cancel'; + openModal. shouldOpenIceberg ifFalse: [ ^ self ]. IceTipRepositoriesBrowser new open ] From fa2592b02ea98d0cf009a14f4f1c8f3303ae85c5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?St=C3=A9phaneDucasse?= Date: Mon, 4 Sep 2023 20:40:09 +0200 Subject: [PATCH 3/4] addressing inform:actionOnClick: --- .../IceGitHubAction.class.st | 16 +++++--- .../IceGitHubNewBranchFromIssuePanel.class.st | 4 +- .../IceGitHubNewPullRequestAction.class.st | 27 ++++++------- .../IceGitHubOpenOnGithubAction.class.st | 37 ++++++++++-------- .../IceGitHubRemoveBranchesAction.class.st | 15 ++++--- ...tHubViewPullRequestOnGithubAction.class.st | 39 ++++++++++--------- 6 files changed, 75 insertions(+), 63 deletions(-) diff --git a/Iceberg-Plugin-GitHub/IceGitHubAction.class.st b/Iceberg-Plugin-GitHub/IceGitHubAction.class.st index 64281a5176..3aaad09ba9 100644 --- a/Iceberg-Plugin-GitHub/IceGitHubAction.class.st +++ b/Iceberg-Plugin-GitHub/IceGitHubAction.class.st @@ -23,6 +23,12 @@ IceGitHubAction >> credentials [ ^ credentials ifNil: [ credentials := self obtainCredentials ] ] +{ #category : #private } +IceGitHubAction >> defaultApplication [ + + ^ SpApplication defaultApplication +] + { #category : #executing } IceGitHubAction >> execute [ self withErrorHandlingDo: [ @@ -63,13 +69,13 @@ IceGitHubAction >> remote: anObject [ { #category : #private } IceGitHubAction >> reportError: error [ - + | message | message := error messageBody. - message = 'Invalid field: head' - ifTrue: [ message := 'Branch does not exist on github. Please commit and push your changes.' ]. - SpApplication defaultApplication newInform + message = 'Invalid field: head' ifTrue: [ + message := 'Branch does not exist on github. Please commit and push your changes.' ]. + self defaultApplication newInform label: message; - title: 'Error creating pull request: ', error messageText; + title: 'Error creating pull request: ' , error messageText; openModal ] diff --git a/Iceberg-Plugin-GitHub/IceGitHubNewBranchFromIssuePanel.class.st b/Iceberg-Plugin-GitHub/IceGitHubNewBranchFromIssuePanel.class.st index e057608849..5e1ddfeea4 100644 --- a/Iceberg-Plugin-GitHub/IceGitHubNewBranchFromIssuePanel.class.st +++ b/Iceberg-Plugin-GitHub/IceGitHubNewBranchFromIssuePanel.class.st @@ -204,12 +204,12 @@ IceGitHubNewBranchFromIssuePanel >> validateIssue: aString [ getIssue: remote owner project: remote projectName number: number. - self defaultApplication defer: [ + self defer: [ self updateText: (self sanitizeTitle: (issue at: 'title')) ] ] on: IceGitHubError do: [ :e | e messageText = 'Not Found' ifFalse: [ e pass ]. - self defaultApplication defer: [ + self defer: [ self updateText: self unknownTitle ] ] ] ] diff --git a/Iceberg-Plugin-GitHub/IceGitHubNewPullRequestAction.class.st b/Iceberg-Plugin-GitHub/IceGitHubNewPullRequestAction.class.st index 76458583ea..2a73c8c00a 100644 --- a/Iceberg-Plugin-GitHub/IceGitHubNewPullRequestAction.class.st +++ b/Iceberg-Plugin-GitHub/IceGitHubNewPullRequestAction.class.st @@ -44,9 +44,10 @@ IceGitHubNewPullRequestAction >> informPullRequestDone: pullRequest [ pullRequestDatas := pullRequest send. url := pullRequestDatas at: 'html_url'. - UIManager default - inform: 'Pull request created. Click to view on Github.' - actionOnClick: [ WebBrowser openOn: url ] + self defaultApplication newInform + title: 'Pull request created. Click to view on Github.'; + onAccept: [ WebBrowser openOn: url ]; + openModal. ] on: IceGitHubError do: [ :e | self reportError: e ] @@ -54,18 +55,18 @@ IceGitHubNewPullRequestAction >> informPullRequestDone: pullRequest [ { #category : #private } IceGitHubNewPullRequestAction >> validateMakePullRequestOn: aRepository [ + | status | - status := OrderedCollection new: 2. - aRepository isModified - ifTrue: [ status add: 'Uncommited changes' ]. - (aRepository outgoingCommitsTo: remote) - ifNotEmpty: [ :commits | '{1} not published' format: { commits size } ]. + aRepository isModified ifTrue: [ status add: 'Uncommited changes' ]. + (aRepository outgoingCommitsTo: remote) ifNotEmpty: [ :commits | + '{1} not published' format: { commits size } ]. status ifEmpty: [ ^ true ]. - - ^ SpApplication defaultApplication newConfirm - title: ('{1} has ongoing modifications.' format: { aRepository name.}); - label: ('{2} + + ^ self defaultApplication newConfirm + title: + ('{1} has ongoing modifications.' format: { aRepository name }); + label: ('{2} Do you want to continue anyway?' format: { status asCommaString }); - openModal + openModal ] diff --git a/Iceberg-Plugin-GitHub/IceGitHubOpenOnGithubAction.class.st b/Iceberg-Plugin-GitHub/IceGitHubOpenOnGithubAction.class.st index e7cb99e58f..46eff77942 100644 --- a/Iceberg-Plugin-GitHub/IceGitHubOpenOnGithubAction.class.st +++ b/Iceberg-Plugin-GitHub/IceGitHubOpenOnGithubAction.class.st @@ -32,27 +32,30 @@ IceGitHubOpenOnGithubAction class >> organisation: aString projectName: anotherS { #category : #executing } IceGitHubOpenOnGithubAction >> basicExecute [ - [ - + + [ | url | - url := (self github getRepository: self organisation project: self projectName) at: 'html_url'. - - self class environment - at: #WebBrowser - ifPresent: [ :webBrowser | webBrowser openOn: url ] - ifAbsent: [ - SpApplication defaultApplication + url := (self github + getRepository: self organisation + project: self projectName) at: 'html_url'. + + self class environment + at: #WebBrowser + ifPresent: [ :webBrowser | webBrowser openOn: url ] + ifAbsent: [ + self defaultApplication title: ('Cannot open "{1}"' format: { url }); - label: 'Because the project WebBrowser is not present by default in Pharo 6.'; - openModal ] - - ] + label: + 'Because the project WebBrowser is not present by default in Pharo 6.'; + openModal ] ] on: IceGitHubError - do: [ - SpApplication defaultApplication + do: [ + self defaultApplication title: 'Invalid Github repository.'; - label: ('No project named "{1}" found for the owner "{2}"' - format: { self projectName . self organisation}); + label: + ('No project named "{1}" found for the owner "{2}"' format: { + self projectName. + self organisation }); openModal ] ] diff --git a/Iceberg-Plugin-GitHub/IceGitHubRemoveBranchesAction.class.st b/Iceberg-Plugin-GitHub/IceGitHubRemoveBranchesAction.class.st index e6ccef85f5..9ba9896429 100644 --- a/Iceberg-Plugin-GitHub/IceGitHubRemoveBranchesAction.class.st +++ b/Iceberg-Plugin-GitHub/IceGitHubRemoveBranchesAction.class.st @@ -54,18 +54,17 @@ IceGitHubRemoveBranchesAction >> remoteBranches [ { #category : #actions } IceGitHubRemoveBranchesAction >> removeBranch: json [ + | branchName | - branchName := json at: 'name'. - IceGitHubAPI new + IceGitHubAPI new credentials: self credentials; - deleteBranch: self remote owner - project: self remote projectBasename - name: branchName. - SpApplication defaultApplication + deleteBranch: self remote owner + project: self remote projectBasename + name: branchName. + self defaultApplication title: ('Branch {1} removed.' format: { branchName }); - openModal - + openModal ] { #category : #actions } diff --git a/Iceberg-Plugin-GitHub/IceGitHubViewPullRequestOnGithubAction.class.st b/Iceberg-Plugin-GitHub/IceGitHubViewPullRequestOnGithubAction.class.st index 6073e339ba..b3e2fa4f79 100644 --- a/Iceberg-Plugin-GitHub/IceGitHubViewPullRequestOnGithubAction.class.st +++ b/Iceberg-Plugin-GitHub/IceGitHubViewPullRequestOnGithubAction.class.st @@ -18,27 +18,30 @@ IceGitHubViewPullRequestOnGithubAction class >> organisation: aString projectNam { #category : #executing } IceGitHubViewPullRequestOnGithubAction >> basicExecute [ - [ - + + [ | url | - url := (self github getRepository: self organisation project: self projectName) at: 'html_url'. - - self class environment - at: #WebBrowser - ifPresent: [ :webBrowser | webBrowser openOn: url ] - ifAbsent: [ - SpApplication defaultApplication newInform - title: ('Cannot open "{1}"' format: { url }); - label: 'Because the project WebBrowser is not present by default in Pharo 6.'; - openModal ] - - ] + url := (self github + getRepository: self organisation + project: self projectName) at: 'html_url'. + + self class environment + at: #WebBrowser + ifPresent: [ :webBrowser | webBrowser openOn: url ] + ifAbsent: [ + self defaultApplication newInform + title: ('Cannot open "{1}"' format: { url }); + label: + 'Because the project WebBrowser is not present by default in Pharo 6.'; + openModal ] ] on: IceGitHubError - do: [ - SpApplication defaultApplication newInform + do: [ + SpApplication defaultApplication newInform title: 'Invalid Github repository.'; - label: ('No project named "{1}" found for the owner "{2}"' - format: { self projectName . self organisation}); + label: + ('No project named "{1}" found for the owner "{2}"' format: { + self projectName. + self organisation }); openModal ] ] From 8dcfe0847df756d015bf4ffa16d6a7d278c06ee3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?St=C3=A9phaneDucasse?= Date: Mon, 4 Sep 2023 21:03:50 +0200 Subject: [PATCH 4/4] QuestionWithoutCancel + request migrated :) --- ...acelloInstallBaselineGroupCommand.class.st | 21 ++++++++++--------- .../IceTipEditProjectDialog.class.st | 19 +++++++---------- 2 files changed, 19 insertions(+), 21 deletions(-) diff --git a/Iceberg-Plugin-Metacello/IceTipMetacelloInstallBaselineGroupCommand.class.st b/Iceberg-Plugin-Metacello/IceTipMetacelloInstallBaselineGroupCommand.class.st index 1b027e3d19..3a02c189ba 100644 --- a/Iceberg-Plugin-Metacello/IceTipMetacelloInstallBaselineGroupCommand.class.st +++ b/Iceberg-Plugin-Metacello/IceTipMetacelloInstallBaselineGroupCommand.class.st @@ -17,15 +17,16 @@ IceTipMetacelloInstallBaselineGroupCommand class >> defaultName [ IceTipMetacelloInstallBaselineGroupCommand >> execute [ | result | - result := UIManager default - request: 'Groups to install (a comma separated string)' - initialAnswer: '' - title: 'Enter groups to install'. - result ifNil: [ ^ self ]. - - self + result := self application newRequest + title: 'Enter groups to install'; + label: 'Groups to install (a comma separated string)'; + text: 'All'; openModal. + result ifNil: [ ^ self ]. + + self installBaseline: self package - groups: ((result substrings: ',') - collect: #trimmed - as: Array) + groups: + ((result substrings: ',') + collect: [ :each | each trimmed ] + as: Array) ] diff --git a/Iceberg-TipUI/IceTipEditProjectDialog.class.st b/Iceberg-TipUI/IceTipEditProjectDialog.class.st index 9b80d21e12..ba770f8344 100644 --- a/Iceberg-TipUI/IceTipEditProjectDialog.class.st +++ b/Iceberg-TipUI/IceTipEditProjectDialog.class.st @@ -332,21 +332,18 @@ IceTipEditProjectDialog >> onAccept: aBlockClosure [ IceTipEditProjectDialog >> removeDirectory [ | toRemove newSelection | - newSelection := selectedDirectoryPath parent. toRemove := selectedDirectoryPath asResolvedBy: self model fileSystem. - toRemove exists - ifTrue: [ - (UIManager default - questionWithoutCancel: ('Are you sure to delete ''{1}''?' format: {toRemove basename}) - title: 'Remove directory') - ifFalse: [ ^ self]. - toRemove ensureDelete ]. - - sourceDirectoryTree roots: { self model fileSystem }. - self expandAndSelect: newSelection. + toRemove exists ifTrue: [ + (self application newConfirm + title: 'Remove directory'; + label: ('Are you sure to delete ''{1}''?' format: { toRemove basename }); + openModal) ifFalse: [ ^ self ]. + toRemove ensureDelete ]. + sourceDirectoryTree roots: { self model fileSystem }. + self expandAndSelect: newSelection ] { #category : #accessing }