Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
improve the browse of versions by allowing selection of repository if…
… method to query is present in more than one.
  • Loading branch information
estebanlm committed Feb 25, 2021
1 parent 3882ea7 commit 9332802
Showing 1 changed file with 20 additions and 8 deletions.
Expand Up @@ -12,8 +12,7 @@ Class {
#name : #ClyIcebergShowMethodVersionCommand,
#superclass : #CmdCommand,
#instVars : [
'method',
'repository'
'method'
],
#category : #'Calypso-SystemPlugins-Monticello-Browser'
}
Expand Down Expand Up @@ -52,7 +51,23 @@ ClyIcebergShowMethodVersionCommand >> defaultMenuItemName [

{ #category : #execution }
ClyIcebergShowMethodVersionCommand >> execute [
| browserClass |
| browserClass packageName repositoriesWithPackage repository |

packageName := method package name.
repositoriesWithPackage := IceRepository registry
select: [ :each | each includesPackageNamed: packageName ].
repositoriesWithPackage ifEmpty: [
UIManager default inform: 'No repositories include package ', packageName.
^ self ].
repository := repositoriesWithPackage size > 1
ifTrue: [
UIManager default
chooseFrom: (repositoriesWithPackage collect: [ :each | each name ])
values: repositoriesWithPackage
title: 'Repository' ]
ifFalse: [ repositoriesWithPackage anyOne ].
repository ifNil: [ ^ self ].

self flag: #pharoTodo.
"This is a way to hide a dependency to Iceberg-IceTip package."
browserClass := #IceTipVersionHistoryBrowser
Expand All @@ -63,10 +78,7 @@ ClyIcebergShowMethodVersionCommand >> execute [

{ #category : #execution }
ClyIcebergShowMethodVersionCommand >> prepareFullExecutionInContext: aToolContext [
| packageName |
super prepareFullExecutionInContext: aToolContext.

method := aToolContext lastSelectedMethod.
packageName := method package name.
repository := IceRepository registry detect: [ :each | each includesPackageNamed: packageName ]
super prepareFullExecutionInContext: aToolContext.
method := aToolContext lastSelectedMethod
]

0 comments on commit 9332802

Please sign in to comment.