diff --git a/src/BaselineOfCommander2/BaselineOfCommander2.class.st b/src/BaselineOfCommander2/BaselineOfCommander2.class.st index 42038f4ca72..5922c47d4c9 100644 --- a/src/BaselineOfCommander2/BaselineOfCommander2.class.st +++ b/src/BaselineOfCommander2/BaselineOfCommander2.class.st @@ -7,10 +7,19 @@ Class { { #category : #baselines } BaselineOfCommander2 >> baseline: spec [ - spec - for: #common - do: [ spec - package: 'Commander2'; - package: 'Commander2-Deprecations' with: [ spec requires: #('Commander2') ]; - package: 'Commander2-Tests' with: [ spec requires: #('Commander2') ] ] + + spec for: #common do: [ + spec + package: 'Commander2'; + package: 'Commander2-Deprecations' with: [ spec requires: #('Commander2') ]; + package: 'Commander2-UI' with: [ spec requires: #('Commander2') ]; + package: 'Commander2-Tests' with: [ spec requires: #('Commander2') ]; + package: 'Commander2-UI-Tests' with: [ spec requires: #('Commander2-UI') ]; + package: 'Commander2-V2ReleaseMigrator'. + spec + group: 'core' with: #('Commander2' 'Commander2-Deprecations'); + group: 'ui' with: #('Commander2-UI'); + group: 'tests' with: #('core' 'ui' 'Commander2-Tests' 'Commander2-UI-Tests'); + group: 'migration' with: #('Commander2-V2ReleaseMigrator'); + group: 'default' with: #('core' 'ui' 'tests'). ] ] diff --git a/src/BaselineOfSpec2/BaselineOfSpec2.class.st b/src/BaselineOfSpec2/BaselineOfSpec2.class.st index 4b2e7cd9bdd..25a8290c400 100644 --- a/src/BaselineOfSpec2/BaselineOfSpec2.class.st +++ b/src/BaselineOfSpec2/BaselineOfSpec2.class.st @@ -7,43 +7,70 @@ Class { { #category : #baseline } BaselineOfSpec2 >> baseline: spec [ - | repository | - repository := self packageRepositoryURL. spec for: #common - do: [ "Dependencies" - spec baseline: 'ParametrizedTests' with: [ spec repository: repository ]. - spec baseline: 'Commander2' with: [ spec repository: repository ]. + do: [ self commander2: spec. "Packages" spec package: 'Spec2-Core' with: [ spec requires: #('Spec2-Layout' 'Spec2-Transmission' 'Spec2-Commands') ]; package: 'Spec2-CommandLine' with: [ spec requires: #('Spec2-Core') ]; + "package: 'Spec2-Help';" package: 'Spec2-Commands' with: [ spec requires: #('Commander2') ]; - package: 'Spec2-Inspector' with: [ spec requires: #('Spec2-Core') ]; + package: 'Spec2-Deprecated' with: [ spec requires: #('Spec2-Tests' 'Spec2-Adapters-Morphic' 'Spec2-Commander2') ]; package: 'Spec2-ObservableSlot'; package: 'Spec2-Layout' with: [ spec requires: #('Spec2-ObservableSlot') ]; package: 'Spec2-Transmission'; package: 'Spec2-Adapters-Morphic' with: [ spec requires: #('Spec2-Core') ]; package: 'Spec2-Adapters-Stub' with: [ spec requires: #('Spec2-Core') ]; - package: 'Spec2-Examples' with: [ spec requires: #('Spec2-Inspector') ]; + package: 'Spec2-Examples'; package: 'Spec2-Interactions' with: [ spec requires: #('Spec2-Core') ]; - package: 'Spec2-Commander2' with: [ spec requires: #('Commander2' 'Spec2-Core' 'Spec2-Interactions') ]; + package: 'Spec2-Commander2' with: [ spec requires: #('Spec2-Core' 'Spec2-Interactions' 'Commander2') ]; package: 'Spec2-Commander2-Tests' with: [ spec requires: #('Spec2-Commander2') ]; package: 'Spec2-Commander2-ContactBook' with: [ spec requires: #('Spec2-Commander2') ]; package: 'Spec2-Commander2-ContactBook-Extensions' with: [ spec requires: #('Spec2-Commander2-ContactBook') ]; package: 'Spec2-Tests' with: [ spec requires: #('Spec2-Examples') ]; - package: 'Spec2-Morphic-Backend-Tests' with: [ spec requires: #('Spec2-Backend-Tests') ]; - package: 'Spec2-Backend-Tests' with: [ spec requires: #('Spec2-Adapters-Morphic' 'ParametrizedTests') ]; - package: 'Spec2-Adapters-Morphic-Tests' with: [ spec requires: #('Spec2-Tests' 'Spec2-Adapters-Morphic') ]; + package: 'Spec2-Morphic-Backend-Tests' with: [ spec requires: #('Spec2-Adapters-Morphic') ]; + package: 'Spec2-Backend-Tests' with: [ spec requires: #('Spec2-Adapters-Morphic') ]; + package: 'Spec2-Adapters-Morphic-Tests' with: [ spec requires: #('Spec2-Tests' 'Spec2-Backend-Tests') ]]. + + spec + for: #'pharo7.x' + do: [ "Dependencies for Pharo7" + self parametrizedTests: spec. + + spec + baseline: 'Commander' + with: [ spec + repository: 'github://pharo-ide/Commander:v0.8.1/src'; + loads: #('Commander-Spec2-Compatibility') ]. + + spec + package: 'Spec2-Pharo7To8Compatibility'; + package: 'Spec2-Backend-Tests' with: [ spec requires: #('ParametrizedTests' 'Spec2-Adapters-Morphic') ]; + package: 'Spec2-Morphic-Backend-Tests' with: [ spec requires: #('ParametrizedTests' 'Spec2-Adapters-Morphic') ]; + package: 'Spec2-Tests' with: [ spec requires: #('Spec2-Examples' 'ParametrizedTests') ] ]. + spec + for: #'pharo8.x' + do: [ spec package: 'Spec2-Tools' with: [ spec requires: #('Spec2-Core') ]; package: 'Spec2-Tools-Tests' with: [ spec requires: #('Spec2-Tests' 'Spec2-Tools') ]; package: 'Spec2-Examples' with: [ spec requires: #('Spec2-Tools') ]; - - package: 'Spec2-Deprecated' with: [ spec requires: #('Spec2-Tests' 'Spec2-Adapters-Morphic' 'Spec2-Commander2') ]; package: 'Spec2-Deprecated-Tools' with: [ spec requires: #('Spec2-Deprecated' 'Spec2-Tools') ] ] ] +{ #category : #dependencies } +BaselineOfSpec2 >> commander2: spec [ + spec + baseline: 'Commander2' + with: [ spec repository: 'github://pharo-spec/Commander2:v2.1.x/src' ] +] + +{ #category : #dependencies } +BaselineOfSpec2 >> parametrizedTests: spec [ + spec baseline: 'ParametrizedTests' with: [ spec repository: 'github://tesonep/ParametrizedTests/src' ] +] + { #category : #accessing } BaselineOfSpec2 >> project [ "Atomic loading is needed for Spec because we are moving classes of package and it breaks their subclasses. diff --git a/src/BaselineOfUI/BaselineOfUI.class.st b/src/BaselineOfUI/BaselineOfUI.class.st index b732caaa7cf..a1c78f07cb9 100644 --- a/src/BaselineOfUI/BaselineOfUI.class.st +++ b/src/BaselineOfUI/BaselineOfUI.class.st @@ -36,11 +36,12 @@ BaselineOfUI >> baseline: spec [ spec postLoadDoIt: #'postload:package:'. "Load morphic before Spec" - spec baseline: 'Morphic' with: [spec repository: repository]. - spec baseline: 'Spec2' with: [spec repository: repository]. - spec baseline: 'Spec' with: [spec repository: repository]. + spec baseline: 'Morphic' with: [ spec repository: repository ]. + spec baseline: 'ParametrizedTests' with: [ spec repository: repository ]. + spec baseline: 'Spec2' with: [ spec repository: repository ]. + spec baseline: 'Spec' with: [ spec repository: repository ]. - spec baseline: 'DrTests' with: [spec repository: repository]. + spec baseline: 'DrTests' with: [ spec repository: repository ]. spec package: 'StartupPreferences'. @@ -65,6 +66,8 @@ BaselineOfUI >> baseline: spec [ spec package: 'WebBrowser-Core'. spec package: 'HelpSystem-Core'. + + spec package: 'Spec2-Inspector'. ]. ] diff --git a/src/Commander2/CmAbstractCommand.class.st b/src/Commander2/CmAbstractCommand.class.st index df74853fdb3..c3df99c65c2 100644 --- a/src/Commander2/CmAbstractCommand.class.st +++ b/src/Commander2/CmAbstractCommand.class.st @@ -9,6 +9,14 @@ Class { #category : #'Commander2-Commands' } +{ #category : #'instance creation' } +CmAbstractCommand class >> forContext: anObject [ + "Creates a new command with anObject as context." + ^ self new + context: anObject; + yourself +] + { #category : #visiting } CmAbstractCommand >> acceptVisitor: aCmCommandOrGroup [ ^ aCmCommandOrGroup visitCommand: self diff --git a/src/GT-Debugger/GTSpecPreDebugActionsPresenter.class.st b/src/GT-Debugger/GTSpecPreDebugActionsPresenter.class.st index 00cfc45dc08..f6db3a610e7 100644 --- a/src/GT-Debugger/GTSpecPreDebugActionsPresenter.class.st +++ b/src/GT-Debugger/GTSpecPreDebugActionsPresenter.class.st @@ -6,8 +6,6 @@ I'll collect the actions via pragmas and create button presenters for them. Class { #name : #GTSpecPreDebugActionsPresenter, #superclass : #SpPresenter, - #traits : 'TSpDynamicPresenter', - #classTraits : 'TSpDynamicPresenter classTrait', #category : #'GT-Debugger-UI' } diff --git a/src/Metacello-PharoExtensions/BaselineOf.extension.st b/src/Metacello-PharoExtensions/BaselineOf.extension.st index 279bf753f1b..52721a3a453 100644 --- a/src/Metacello-PharoExtensions/BaselineOf.extension.st +++ b/src/Metacello-PharoExtensions/BaselineOf.extension.st @@ -6,6 +6,22 @@ BaselineOf class >> allPackageNames [ ^ self version packages collect: #name ] +{ #category : #'*Metacello-PharoExtensions' } +BaselineOf class >> deepPackagesOfGroupNamed: aName [ + "Traverses the group tree to collect packages" + | allGroups group | + + allGroups := self version groups. + group := allGroups detect: [ :eachGroup | eachGroup name = aName ]. + + ^ (group includes + collect: [ :each | + (allGroups anySatisfy: [ :eachGroup | eachGroup name = each ]) + ifTrue: [ self deepPackagesOfGroupNamed: each ] + ifFalse: [ { each } ] ]) + flattened +] + { #category : #'*Metacello-PharoExtensions' } BaselineOf >> packageRepository [ diff --git a/src/Spec2-Adapters-Morphic/FTTableMorph.extension.st b/src/Spec2-Adapters-Morphic/FTTableMorph.extension.st new file mode 100644 index 00000000000..350de6d65fc --- /dev/null +++ b/src/Spec2-Adapters-Morphic/FTTableMorph.extension.st @@ -0,0 +1,8 @@ +Extension { #name : #FTTableMorph } + +{ #category : #'*Spec2-Adapters-Morphic' } +FTTableMorph >> hasFilter [ + + function ifNil: [ ^ false ]. + ^ function isKindOf: FTFilterFunction +] diff --git a/src/Spec2-Adapters-Morphic/SpAbstractMorphicAdapter.class.st b/src/Spec2-Adapters-Morphic/SpAbstractMorphicAdapter.class.st index 19746db6a61..8ed1e8e4026 100644 --- a/src/Spec2-Adapters-Morphic/SpAbstractMorphicAdapter.class.st +++ b/src/Spec2-Adapters-Morphic/SpAbstractMorphicAdapter.class.st @@ -423,6 +423,18 @@ SpAbstractMorphicAdapter >> transferFor: passenger from: source [ ^ (self transferBlock cull: passenger cull: self model) buildWithSpec ] +{ #category : #emulating } +SpAbstractMorphicAdapter >> type: aString [ + + aString do: [ :each | + self + keyPressed: each asciiValue + shift: each isUppercase + meta: false + control: false + option: false ] +] + { #category : #protocol } SpAbstractMorphicAdapter >> useProportionalLayout [ diff --git a/src/Spec2-Adapters-Morphic/SpAbstractMorphicListAdapter.class.st b/src/Spec2-Adapters-Morphic/SpAbstractMorphicListAdapter.class.st index 1231ad46e32..f17d64674d9 100644 --- a/src/Spec2-Adapters-Morphic/SpAbstractMorphicListAdapter.class.st +++ b/src/Spec2-Adapters-Morphic/SpAbstractMorphicListAdapter.class.st @@ -44,5 +44,13 @@ SpAbstractMorphicListAdapter >> updateItemFilterBlockWith: block [ enableFilter: (SpFTSpecFilter block: block); explicitFunction ] ifNil: [ - widget disableFunction ] + self updateSearch ] +] + +{ #category : #factory } +SpAbstractMorphicListAdapter >> updateSearch [ + + self presenter isSearchEnabled + ifTrue: [ widget enableSearch ] + ifFalse: [ widget disableFunction ] ] diff --git a/src/Spec2-Adapters-Morphic/SpComponentListFastTableDataSource.class.st b/src/Spec2-Adapters-Morphic/SpComponentListDataSource.class.st similarity index 72% rename from src/Spec2-Adapters-Morphic/SpComponentListFastTableDataSource.class.st rename to src/Spec2-Adapters-Morphic/SpComponentListDataSource.class.st index 4e9ecfb8696..87028325683 100644 --- a/src/Spec2-Adapters-Morphic/SpComponentListFastTableDataSource.class.st +++ b/src/Spec2-Adapters-Morphic/SpComponentListDataSource.class.st @@ -1,5 +1,5 @@ Class { - #name : #SpComponentListFastTableDataSource, + #name : #SpComponentListDataSource, #superclass : #FTDataSource, #instVars : [ 'model' @@ -8,7 +8,7 @@ Class { } { #category : #accessing } -SpComponentListFastTableDataSource >> cellColumn: column row: rowIndex [ +SpComponentListDataSource >> cellColumn: column row: rowIndex [ | cell item | item := self elementAt: rowIndex. @@ -21,19 +21,19 @@ SpComponentListFastTableDataSource >> cellColumn: column row: rowIndex [ ] { #category : #accessing } -SpComponentListFastTableDataSource >> elementAt: rowIndex [ +SpComponentListDataSource >> elementAt: rowIndex [ ^ self presenters at: rowIndex ] { #category : #accessing } -SpComponentListFastTableDataSource >> elements [ +SpComponentListDataSource >> elements [ ^ self presenters ] { #category : #accessing } -SpComponentListFastTableDataSource >> headerColumn: column [ +SpComponentListDataSource >> headerColumn: column [ column id ifNil: [ ^ nil ]. ^ FTCellMorph new @@ -43,7 +43,7 @@ SpComponentListFastTableDataSource >> headerColumn: column [ ] { #category : #accessing } -SpComponentListFastTableDataSource >> menuColumn: column row: rowIndex [ +SpComponentListDataSource >> menuColumn: column row: rowIndex [ | menuPresenter | menuPresenter := self model contextMenu. @@ -59,17 +59,17 @@ SpComponentListFastTableDataSource >> menuColumn: column row: rowIndex [ ] { #category : #accessing } -SpComponentListFastTableDataSource >> model [ +SpComponentListDataSource >> model [ ^ model ] { #category : #accessing } -SpComponentListFastTableDataSource >> model: anObject [ +SpComponentListDataSource >> model: anObject [ model := anObject ] { #category : #accessing } -SpComponentListFastTableDataSource >> newDataSourceMatching: aFTFilter [ +SpComponentListDataSource >> newDataSourceMatching: aFTFilter [ | newElements wrappedItem text newDataSource modelCopy | newElements := self elements select: [ :each | @@ -87,7 +87,7 @@ SpComponentListFastTableDataSource >> newDataSourceMatching: aFTFilter [ ] { #category : #accessing } -SpComponentListFastTableDataSource >> numberOfRows [ +SpComponentListDataSource >> numberOfRows [ ^ model ifNil: [ 0 ] @@ -95,20 +95,20 @@ SpComponentListFastTableDataSource >> numberOfRows [ ] { #category : #accessing } -SpComponentListFastTableDataSource >> presenters [ +SpComponentListDataSource >> presenters [ ^ self model presenters ] { #category : #accessing } -SpComponentListFastTableDataSource >> rowHeight: rowIndex [ +SpComponentListDataSource >> rowHeight: rowIndex [ rowIndex = 0 ifTrue: [ ^ super rowHeight: rowIndex ]. ^ (self widgetFor: (self elementAt: rowIndex)) height ] { #category : #accessing } -SpComponentListFastTableDataSource >> searchText: aString [ +SpComponentListDataSource >> searchText: aString [ | search text result | aString isEmptyOrNil ifTrue: [ ^ #() ]. result := OrderedCollection new. @@ -121,12 +121,12 @@ SpComponentListFastTableDataSource >> searchText: aString [ ] { #category : #'drag and drop' } -SpComponentListFastTableDataSource >> transferFor: passenger from: aMorph [ +SpComponentListDataSource >> transferFor: passenger from: aMorph [ ^(self model transferFor: passenger from: self table) buildWithSpec ] { #category : #private } -SpComponentListFastTableDataSource >> widgetFor: aPresenter [ +SpComponentListDataSource >> widgetFor: aPresenter [ aPresenter adapter ifNotNil: [ :adapter | ^ adapter widget ]. ^ aPresenter buildWithSpec diff --git a/src/Spec2-Adapters-Morphic/SpDropListMorph.class.st b/src/Spec2-Adapters-Morphic/SpDropListMorph.class.st index 69de2d8d0cd..33c79da725e 100644 --- a/src/Spec2-Adapters-Morphic/SpDropListMorph.class.st +++ b/src/Spec2-Adapters-Morphic/SpDropListMorph.class.st @@ -10,6 +10,11 @@ Class { #category : #'Spec2-Adapters-Morphic-Support' } +{ #category : #configuring } +SpDropListMorph >> configureWith: displayModel item: itemPresenter [ + displayModel configureDropList: self item: itemPresenter +] + { #category : #private } SpDropListMorph >> currentIcon [ diff --git a/src/Spec2-Adapters-Morphic/SpMorphicAllItemsStrategy.class.st b/src/Spec2-Adapters-Morphic/SpMorphicAllItemsStrategy.class.st new file mode 100644 index 00000000000..5d9711fd672 --- /dev/null +++ b/src/Spec2-Adapters-Morphic/SpMorphicAllItemsStrategy.class.st @@ -0,0 +1,13 @@ +Class { + #name : #SpMorphicAllItemsStrategy, + #superclass : #FTAllItemsStrategy, + #category : #'Spec2-Adapters-Morphic-Table' +} + +{ #category : #accessing } +SpMorphicAllItemsStrategy >> isMatching: anItem [ + + ^ dataSource model + performSearch: anItem data + matching: pattern +] diff --git a/src/Spec2-Adapters-Morphic/SpMorphicBackend.class.st b/src/Spec2-Adapters-Morphic/SpMorphicBackend.class.st index bd6d09dfff5..bf371103c78 100644 --- a/src/Spec2-Adapters-Morphic/SpMorphicBackend.class.st +++ b/src/Spec2-Adapters-Morphic/SpMorphicBackend.class.st @@ -16,9 +16,10 @@ SpMorphicBackend >> adapterBindingsClass [ ^ SpMorphicAdapterBindings ] -{ #category : #'as yet unclassified' } -SpMorphicBackend >> defer: aBlockClosure [ - UIManager default defer: aBlockClosure. +{ #category : #accessing } +SpMorphicBackend >> defer: aBlock [ + + UIManager default defer: aBlock ] { #category : #'private notifying' } diff --git a/src/Spec2-Adapters-Morphic/SpMorphicComponentListAdapter.class.st b/src/Spec2-Adapters-Morphic/SpMorphicComponentListAdapter.class.st index 0f79f576ab2..ee3fc150a6d 100644 --- a/src/Spec2-Adapters-Morphic/SpMorphicComponentListAdapter.class.st +++ b/src/Spec2-Adapters-Morphic/SpMorphicComponentListAdapter.class.st @@ -44,7 +44,7 @@ SpMorphicComponentListAdapter >> isNonEditableRow: aRow column: aColumn [ { #category : #factory } SpMorphicComponentListAdapter >> newDataSource [ - ^ SpComponentListFastTableDataSource new + ^ SpComponentListDataSource new model: self presenter; yourself ] diff --git a/src/Spec2-Adapters-Morphic/SpMorphicListAdapter.class.st b/src/Spec2-Adapters-Morphic/SpMorphicListAdapter.class.st index b58e42829bc..8ba01057e50 100644 --- a/src/Spec2-Adapters-Morphic/SpMorphicListAdapter.class.st +++ b/src/Spec2-Adapters-Morphic/SpMorphicListAdapter.class.st @@ -38,11 +38,12 @@ SpMorphicListAdapter >> backgroundColorFor: anItem at: index [ SpMorphicListAdapter >> buildWidget [ | datasource | - datasource := SpListFastTableDataSource new. + datasource := SpMorphicListDataSource new. datasource model: self model. widget := FTTableMorph new dataSource: datasource; hideColumnHeaders; + enableSearch; beResizable; columns: { self newListColumn }; setMultipleSelection: self model isMultipleSelection; @@ -58,6 +59,7 @@ SpMorphicListAdapter >> buildWidget [ self presenter whenModelChangedDo: [ widget refresh ]. self presenter whenSelectionChangedDo: [ self refreshWidgetSelection ]. self presenter selection whenChangedDo: [ self refreshWidgetSelection ]. + self presenter whenSearchChangedDo: [ self updateSearch ]. self refreshWidgetHeaderTitle. self refreshWidgetSelection. self presenter whenItemFilterBlockChangedDo: [ :block | self updateItemFilterBlockWith: block ]. @@ -73,7 +75,8 @@ SpMorphicListAdapter >> buildWidget [ { #category : #emulating } SpMorphicListAdapter >> hasFilter [ - ^ self widget submorphs anySatisfy: [ :each | each isKindOf: RubTextFieldMorph "This morph is the explicit filter of the list" ] + + ^ self widget hasFilter ] { #category : #testing } diff --git a/src/Spec2-Adapters-Morphic/SpListFastTableDataSource.class.st b/src/Spec2-Adapters-Morphic/SpMorphicListDataSource.class.st similarity index 68% rename from src/Spec2-Adapters-Morphic/SpListFastTableDataSource.class.st rename to src/Spec2-Adapters-Morphic/SpMorphicListDataSource.class.st index b19285bea0e..02a70debd11 100644 --- a/src/Spec2-Adapters-Morphic/SpListFastTableDataSource.class.st +++ b/src/Spec2-Adapters-Morphic/SpMorphicListDataSource.class.st @@ -1,5 +1,5 @@ Class { - #name : #SpListFastTableDataSource, + #name : #SpMorphicListDataSource, #superclass : #FTDataSource, #instVars : [ 'model' @@ -8,7 +8,7 @@ Class { } { #category : #accessing } -SpListFastTableDataSource >> cellColumn: column row: rowIndex [ +SpMorphicListDataSource >> cellColumn: column row: rowIndex [ | displayValue cell item | item := self model itemAt: rowIndex. displayValue := column readObject: item. @@ -22,19 +22,19 @@ SpListFastTableDataSource >> cellColumn: column row: rowIndex [ ] { #category : #accessing } -SpListFastTableDataSource >> elementAt: rowIndex [ +SpMorphicListDataSource >> elementAt: rowIndex [ ^ self listModel at: rowIndex ] { #category : #accessing } -SpListFastTableDataSource >> elements [ +SpMorphicListDataSource >> elements [ ^ self model items ] { #category : #accessing } -SpListFastTableDataSource >> headerColumn: column [ +SpMorphicListDataSource >> headerColumn: column [ column id ifNil: [ ^ nil ]. ^ FTCellMorph new @@ -44,12 +44,12 @@ SpListFastTableDataSource >> headerColumn: column [ ] { #category : #accessing } -SpListFastTableDataSource >> listModel [ +SpMorphicListDataSource >> listModel [ ^ model model ] { #category : #accessing } -SpListFastTableDataSource >> menuColumn: column row: rowIndex [ +SpMorphicListDataSource >> menuColumn: column row: rowIndex [ | menuPresenter | menuPresenter := self model contextMenu. @@ -65,17 +65,17 @@ SpListFastTableDataSource >> menuColumn: column row: rowIndex [ ] { #category : #accessing } -SpListFastTableDataSource >> model [ +SpMorphicListDataSource >> model [ ^ model ] { #category : #accessing } -SpListFastTableDataSource >> model: anObject [ +SpMorphicListDataSource >> model: anObject [ model := anObject ] { #category : #accessing } -SpListFastTableDataSource >> newDataSourceMatching: aFTFilter [ +SpMorphicListDataSource >> newDataSourceMatching: aFTFilter [ | newElements wrappedItem text newDataSource modelCopy | newElements := self elements select: [ :each | @@ -93,26 +93,25 @@ SpListFastTableDataSource >> newDataSourceMatching: aFTFilter [ ] { #category : #accessing } -SpListFastTableDataSource >> numberOfRows [ +SpMorphicListDataSource >> numberOfRows [ ^ model ifNil: [ 0 ] ifNotNil: [ self listModel size ] ] { #category : #accessing } -SpListFastTableDataSource >> searchText: aString [ - | search text result | +SpMorphicListDataSource >> searchText: aString [ + | search | + aString isEmptyOrNil ifTrue: [ ^ #() ]. - result := OrderedCollection new. search := aString trimBoth asLowercase. - 1 to: self numberOfRows do: [ :rowIndex | - text := (self model displayValueAt: rowIndex) contents trimBoth asLowercase. - (text beginsWith: search) - ifTrue: [ result add: rowIndex ] ]. - ^ result asArray + ^ Array streamContents: [ :stream | + self elements withIndexDo: [ :each :rowIndex | + (self model performSearch: each matching: search) + ifTrue: [ stream nextPut: rowIndex ] ] ] ] { #category : #'drag and drop' } -SpListFastTableDataSource >> transferFor: passenger from: aMorph [ +SpMorphicListDataSource >> transferFor: passenger from: aMorph [ ^(self model transferFor: passenger from: self table) buildWithSpec ] diff --git a/src/Spec2-Adapters-Morphic/SpMorphicRadioButtonAdapter.class.st b/src/Spec2-Adapters-Morphic/SpMorphicRadioButtonAdapter.class.st index fd35fdb2aae..a3389294e89 100644 --- a/src/Spec2-Adapters-Morphic/SpMorphicRadioButtonAdapter.class.st +++ b/src/Spec2-Adapters-Morphic/SpMorphicRadioButtonAdapter.class.st @@ -9,11 +9,18 @@ Class { { #category : #factory } SpMorphicRadioButtonAdapter >> buildWidget [ - | radioButton | + self presenter isInitialStateSet ifFalse: [ + "initial state is false, set all associated buttons to false too" + self presenter property: #state rawValue: false. + self presenter associatedRadioButtons do: [ :each | + each property: #state rawValue: false ] ]. + radioButton := CheckboxMorph new - on: self selected: #state changeSelected: #state:; + on: self + selected: #state + changeSelected: #state:; getEnabledSelector: #enabled; label: self label; labelClickable: self labelClickable; @@ -27,6 +34,7 @@ SpMorphicRadioButtonAdapter >> buildWidget [ self presenter whenLabelChangedDo: [ :newLabel | radioButton label: newLabel ]. self presenter whenChangedDo: [ radioButton updateSelection ]. + ^ radioButton ] @@ -39,23 +47,23 @@ SpMorphicRadioButtonAdapter >> clicked [ { #category : #'widget API' } SpMorphicRadioButtonAdapter >> label [ - ^ self model label + ^ self presenter label ] { #category : #'widget API' } SpMorphicRadioButtonAdapter >> labelClickable [ - ^ self model labelClickable + ^ self presenter labelClickable ] { #category : #'widget API' } SpMorphicRadioButtonAdapter >> state [ - ^ self model state + ^ self presenter state ] { #category : #'widget API' } SpMorphicRadioButtonAdapter >> state: aBoolean [ - ^ self model state: aBoolean + ^ self presenter state: aBoolean ] diff --git a/src/Spec2-Adapters-Morphic/SpMorphicRootItemsStrategy.class.st b/src/Spec2-Adapters-Morphic/SpMorphicRootItemsStrategy.class.st new file mode 100644 index 00000000000..9b447db4bae --- /dev/null +++ b/src/Spec2-Adapters-Morphic/SpMorphicRootItemsStrategy.class.st @@ -0,0 +1,13 @@ +Class { + #name : #SpMorphicRootItemsStrategy, + #superclass : #FTRootItemsStrategy, + #category : #'Spec2-Adapters-Morphic-Table' +} + +{ #category : #accessing } +SpMorphicRootItemsStrategy >> isMatching: anItem [ + + ^ dataSource model + performSearch: anItem data + matching: pattern +] diff --git a/src/Spec2-Adapters-Morphic/SpMorphicTableAdapter.class.st b/src/Spec2-Adapters-Morphic/SpMorphicTableAdapter.class.st index 7b6329c4603..87c17e66824 100644 --- a/src/Spec2-Adapters-Morphic/SpMorphicTableAdapter.class.st +++ b/src/Spec2-Adapters-Morphic/SpMorphicTableAdapter.class.st @@ -52,8 +52,10 @@ SpMorphicTableAdapter >> addModelTo: tableMorph [ tableMorph dataSource: self newDataSource. - self presenter whenItemFilterBlockChangedDo: [ :block | self - updateItemFilterBlockWith: block ]. + self presenter whenItemFilterBlockChangedDo: [ :block | + self updateItemFilterBlockWith: block ]. + self presenter whenSearchChangedDo: [ + self updateSearch ]. self updateItemFilterBlockWith: self itemFilter ] diff --git a/src/Spec2-Adapters-Morphic/SpMorphicTableDataSource.class.st b/src/Spec2-Adapters-Morphic/SpMorphicTableDataSource.class.st index 5ae3d3c338b..191420a5a70 100644 --- a/src/Spec2-Adapters-Morphic/SpMorphicTableDataSource.class.st +++ b/src/Spec2-Adapters-Morphic/SpMorphicTableDataSource.class.st @@ -32,3 +32,21 @@ SpMorphicTableDataSource >> elements [ ifNotNil: #items ifNil: [ #() ] ] + +{ #category : #testing } +SpMorphicTableDataSource >> isMatch: anObject pattern: aString [ + | text | + + text := (self toString: anObject) trimBoth asLowercase. + ^ text beginsWith: aString +] + +{ #category : #accessing } +SpMorphicTableDataSource >> searchText: aString [ + + aString isEmptyOrNil ifTrue: [ ^ #() ]. + ^ Array streamContents: [ :stream | + self elements withIndexDo: [ :each :index | + (self model performSearch: each matching: aString) + ifTrue: [ stream nextPut: index ] ] ] +] diff --git a/src/Spec2-Adapters-Morphic/SpMorphicToggleButtonAdapter.class.st b/src/Spec2-Adapters-Morphic/SpMorphicToggleButtonAdapter.class.st index bb1a5995ddb..d061fc69030 100644 --- a/src/Spec2-Adapters-Morphic/SpMorphicToggleButtonAdapter.class.st +++ b/src/Spec2-Adapters-Morphic/SpMorphicToggleButtonAdapter.class.st @@ -6,26 +6,29 @@ Class { { #category : #factory } SpMorphicToggleButtonAdapter >> buildWidget [ - | checkButton | + checkButton := PluggableToggleButtonMorph - on: self - getState: #state - action: #toggleAction: - label: #label - menu: nil. + on: self + getState: #state + action: #toggleAction: + label: #label + menu: nil. checkButton - label: self label; - hResizing: #spaceFill; - vResizing: #shrinkWrap; - setBalloonText: self help; - getEnabledSelector: #enabled; - dragEnabled: self dragEnabled; - dropEnabled: self dropEnabled. + icon: self icon; + label: self label; + hResizing: #spaceFill; + vResizing: #shrinkWrap; + setBalloonText: self help; + getEnabledSelector: #enabled; + dragEnabled: self dragEnabled; + dropEnabled: self dropEnabled. self presenter whenLabelChangedDo: [ :newLabel | checkButton label: newLabel ]. + self presenter whenIconChangedDo: [ checkButton icon: self icon ]. self presenter whenChangedDo: [ checkButton pressed: self model state ]. + ^ checkButton ] @@ -42,10 +45,16 @@ SpMorphicToggleButtonAdapter >> helpText [ ^ widget balloonText ] +{ #category : #'widget API' } +SpMorphicToggleButtonAdapter >> icon [ + + ^ self presenter icon +] + { #category : #'widget API' } SpMorphicToggleButtonAdapter >> label [ - ^ self model label + ^ self presenter label ] { #category : #'widget API' } diff --git a/src/Spec2-Adapters-Morphic/SpMorphicToolBarAdapter.class.st b/src/Spec2-Adapters-Morphic/SpMorphicToolBarAdapter.class.st index 081c996935c..920f377d524 100644 --- a/src/Spec2-Adapters-Morphic/SpMorphicToolBarAdapter.class.st +++ b/src/Spec2-Adapters-Morphic/SpMorphicToolBarAdapter.class.st @@ -38,7 +38,7 @@ SpMorphicToolBarAdapter >> configureItem: itemModel morph: itemMorph toolBar: to width: toolBarMorph toolbarItemSize. toolBarMorph displayMode - configureButton: itemMorph + configureMorph: itemMorph item: itemModel. ^ itemMorph diff --git a/src/Spec2-Adapters-Morphic/SpMorphicTreeTableAdapter.class.st b/src/Spec2-Adapters-Morphic/SpMorphicTreeTableAdapter.class.st index 78ed2b50d3f..eb53ba36c88 100644 --- a/src/Spec2-Adapters-Morphic/SpMorphicTreeTableAdapter.class.st +++ b/src/Spec2-Adapters-Morphic/SpMorphicTreeTableAdapter.class.st @@ -39,6 +39,10 @@ SpMorphicTreeTableAdapter >> addModelTo: tableMorph [ self isResizable ifTrue: [ tableMorph beResizable ] ifFalse: [ tableMorph beNotResizable ]. + + self isSearchEnabled + ifTrue: [ tableMorph enableSearch ] + ifFalse: [ tableMorph disableFunction ]. tableMorph setBalloonText: self model help. @@ -129,12 +133,20 @@ SpMorphicTreeTableAdapter >> isNonEditableRow: aRow column: aColumn [ { #category : #testing } SpMorphicTreeTableAdapter >> isResizable [ - ^ self model isResizable + + ^ self presenter isResizable +] + +{ #category : #testing } +SpMorphicTreeTableAdapter >> isSearchEnabled [ + + ^ self presenter isSearchEnabled ] { #category : #testing } SpMorphicTreeTableAdapter >> isShowingColumnHeaders [ - ^ self model isShowingColumnHeaders + + ^ self presenter isShowingColumnHeaders ] { #category : #'private factory' } diff --git a/src/Spec2-Adapters-Morphic/SpMorphicTreeTableDataSource.class.st b/src/Spec2-Adapters-Morphic/SpMorphicTreeTableDataSource.class.st index 9d03a93672f..41095c8d9c5 100644 --- a/src/Spec2-Adapters-Morphic/SpMorphicTreeTableDataSource.class.st +++ b/src/Spec2-Adapters-Morphic/SpMorphicTreeTableDataSource.class.st @@ -11,6 +11,24 @@ Class { #category : #'Spec2-Adapters-Morphic-Table' } +{ #category : #'search strategies' } +SpMorphicTreeTableDataSource class >> allItemsStrategy [ + + ^ SpMorphicAllItemsStrategy +] + +{ #category : #'search strategies' } +SpMorphicTreeTableDataSource class >> defaultStrategy [ + + ^ SpMorphicVisibleItemsStrategy +] + +{ #category : #'search strategies' } +SpMorphicTreeTableDataSource class >> rootsOnlyStrategy [ + + ^ SpMorphicRootItemsStrategy +] + { #category : #accessing } SpMorphicTreeTableDataSource >> allShownItems [ @@ -113,9 +131,24 @@ SpMorphicTreeTableDataSource >> rootItem: anItem [ self addSourceToRootItem ] +{ #category : #accessing } +SpMorphicTreeTableDataSource >> searchText: aString [ + + ^ (self class perform: (self searchStrategy, 'Strategy') asSymbol) + searchWith: aString + dataSource: self +] + { #category : #sorting } SpMorphicTreeTableDataSource >> sortElements: aSortFunction [ unsortedElements ifNil: [ unsortedElements := self rootsItems ]. self rootItem data: ((self rootItem children collect: #data) sorted: aSortFunction) ] + +{ #category : #accessing } +SpMorphicTreeTableDataSource >> toString: anItem [ + "Override me if you expect something else." + + ^ super toString: anItem data +] diff --git a/src/Spec2-Adapters-Morphic/SpMorphicVisibleItemsStrategy.class.st b/src/Spec2-Adapters-Morphic/SpMorphicVisibleItemsStrategy.class.st new file mode 100644 index 00000000000..d519cd27687 --- /dev/null +++ b/src/Spec2-Adapters-Morphic/SpMorphicVisibleItemsStrategy.class.st @@ -0,0 +1,13 @@ +Class { + #name : #SpMorphicVisibleItemsStrategy, + #superclass : #FTVisibleItemsStrategy, + #category : #'Spec2-Adapters-Morphic-Table' +} + +{ #category : #accessing } +SpMorphicVisibleItemsStrategy >> isMatching: anItem [ + + ^ dataSource model + performSearch: anItem data + matching: pattern +] diff --git a/src/Spec2-Adapters-Morphic/SpMorphicWindowAdapter.class.st b/src/Spec2-Adapters-Morphic/SpMorphicWindowAdapter.class.st index 582e53078e7..fb8f8ff2f35 100644 --- a/src/Spec2-Adapters-Morphic/SpMorphicWindowAdapter.class.st +++ b/src/Spec2-Adapters-Morphic/SpMorphicWindowAdapter.class.st @@ -112,6 +112,12 @@ SpMorphicWindowAdapter >> askOkToClose [ ^ self model askOkToClose ] +{ #category : #protocol } +SpMorphicWindowAdapter >> beep [ + + widget flash +] + { #category : #factory } SpMorphicWindowAdapter >> buildWidget [ diff --git a/src/Spec2-Adapters-Morphic/SpStyle.class.st b/src/Spec2-Adapters-Morphic/SpStyle.class.st index ac5faa5296f..6e6ae65f194 100644 --- a/src/Spec2-Adapters-Morphic/SpStyle.class.st +++ b/src/Spec2-Adapters-Morphic/SpStyle.class.st @@ -23,6 +23,11 @@ SpStyle class >> createDefaultStyleSheet [ Geometry { #height: 25 }, .label [ Geometry { #hResizing: true }, + .headerError [Draw { #color: Color{ #red: 1, #green: 0, #blue: 0, #alpha: 1}} ], + .headerSuccess [Draw { #color: Color{ #red: 0, #green: 1, #blue: 0, #alpha: 1}} ], + .header [ + Draw { #color: Color{ #rgb: 622413393 }}, + Font { #name: "Lucida Grande", #size: 10, #bold: true } ], .shortcut [ Draw { #color: Color{ #rgb: 622413393 } }, Font { #name: "Lucida Grande", #size: 10 } @@ -35,7 +40,10 @@ SpStyle class >> createDefaultStyleSheet [ Geometry { #hResizing: true } ], .button [ - Geometry { #width: 100 } + Geometry { #width: 100 }, + .small [ + Geometry { #width: 26 } + ] ], .checkBox [ Geometry { #hResizing: true } diff --git a/src/Spec2-Adapters-Morphic/SpStyleFont.class.st b/src/Spec2-Adapters-Morphic/SpStyleFont.class.st index 3bc8ee2a960..b3e68280ba1 100644 --- a/src/Spec2-Adapters-Morphic/SpStyleFont.class.st +++ b/src/Spec2-Adapters-Morphic/SpStyleFont.class.st @@ -4,13 +4,17 @@ I keep properties like - name -> The font name - size -> The font size +- bold -> (boolean) font is bold +- italic -> (boolean) font is italic " Class { #name : #SpStyleFont, #superclass : #SpStyleProperty, #instVars : [ 'name', - 'size' + 'size', + 'italic', + 'bold' ], #category : #'Spec2-Adapters-Morphic-StyleSheet' } @@ -31,12 +35,52 @@ SpStyleFont >> applyTo: aMorph [ aMorph font: self definedFont ] +{ #category : #accessing } +SpStyleFont >> bold [ + ^ bold +] + +{ #category : #accessing } +SpStyleFont >> bold: anObject [ + bold := anObject +] + { #category : #operations } SpStyleFont >> definedFont [ + | definedFont | - ^ LogicalFont + definedFont := LogicalFont familyName: self name - pointSize: self size + pointSize: self size. + + self isItalic ifTrue: [ definedFont forceItalicOrOblique ]. + self isBold ifTrue: [ definedFont forceBold ]. + + ^ definedFont +] + +{ #category : #initialization } +SpStyleFont >> isBold [ + "property may be nil, we verify with strict comparisson" + + ^ bold == true +] + +{ #category : #initialization } +SpStyleFont >> isItalic [ + "property may be nil, we verify with strict comparisson" + + ^ italic == true +] + +{ #category : #accessing } +SpStyleFont >> italic [ + ^ italic +] + +{ #category : #accessing } +SpStyleFont >> italic: anObject [ + italic := anObject ] { #category : #accessing } diff --git a/src/Spec2-Adapters-Stub/SpStubWindowAdapter.class.st b/src/Spec2-Adapters-Stub/SpStubWindowAdapter.class.st index 266736cd4dc..0df18fef024 100644 --- a/src/Spec2-Adapters-Stub/SpStubWindowAdapter.class.st +++ b/src/Spec2-Adapters-Stub/SpStubWindowAdapter.class.st @@ -20,6 +20,10 @@ SpStubWindowAdapter >> addPresenterIn: widgetToBuild withSpecLayout: aSpec [ toWindow: widgetToBuild ] +{ #category : #factory } +SpStubWindowAdapter >> beep [ +] + { #category : #factory } SpStubWindowAdapter >> buildWidget [ diff --git a/src/Spec2-Backend-Tests/SpAbstractAdapterTest.class.st b/src/Spec2-Backend-Tests/SpAbstractAdapterTest.class.st index d65b266bff0..2dc7be46f06 100644 --- a/src/Spec2-Backend-Tests/SpAbstractAdapterTest.class.st +++ b/src/Spec2-Backend-Tests/SpAbstractAdapterTest.class.st @@ -22,7 +22,7 @@ SpAbstractAdapterTest class >> testParameters [ forSelector: #specInitializationStrategy addOptions: { [ SpInitializationStrategy beforeTest ]. [ SpInitializationStrategy afterTest ] }; forSelector: #backendForTest - addOptions: SpAbstractBackendForTest allSubclasses; + addOptions: { SpMorphicBackendForTest }; yourself ] diff --git a/src/Spec2-Backend-Tests/SpAbstractListCommonPropertiestTest.class.st b/src/Spec2-Backend-Tests/SpAbstractListCommonPropertiestTest.class.st index 3f53b88969c..c0655397a1c 100644 --- a/src/Spec2-Backend-Tests/SpAbstractListCommonPropertiestTest.class.st +++ b/src/Spec2-Backend-Tests/SpAbstractListCommonPropertiestTest.class.st @@ -66,3 +66,13 @@ SpAbstractListCommonPropertiestTest >> testSingleClickActivatesRowInSingleClickA self assert: activated. ] + +{ #category : #tests } +SpAbstractListCommonPropertiestTest >> testTypePerformsSearch [ + + self presenter selection selectIndex: 1. "10" + self adapter type: '2'. + self + assert: self presenter selection selectedIndex + equals: 2 "20" +] diff --git a/src/Spec2-Backend-Tests/SpAbstractMorphicAdapter.extension.st b/src/Spec2-Backend-Tests/SpAbstractMorphicAdapter.extension.st new file mode 100644 index 00000000000..d221e53c4ef --- /dev/null +++ b/src/Spec2-Backend-Tests/SpAbstractMorphicAdapter.extension.st @@ -0,0 +1,8 @@ +Extension { #name : #SpAbstractMorphicAdapter } + +{ #category : #'*Spec2-Backend-Tests' } +SpAbstractMorphicAdapter >> typeForSearch: aString [ + "emulate we are typing to perform a search" + + self type: aString +] diff --git a/src/Spec2-Backend-Tests/SpAbstractSearchTest.class.st b/src/Spec2-Backend-Tests/SpAbstractSearchTest.class.st new file mode 100644 index 00000000000..6f78a447be4 --- /dev/null +++ b/src/Spec2-Backend-Tests/SpAbstractSearchTest.class.st @@ -0,0 +1,49 @@ +Class { + #name : #SpAbstractSearchTest, + #superclass : #SpAbstractWidgetAdapterTest, + #category : #'Spec2-Backend-Tests' +} + +{ #category : #testing } +SpAbstractSearchTest class >> isAbstract [ + + ^ self = SpAbstractSearchTest +] + +{ #category : #running } +SpAbstractSearchTest >> initializeTestedInstance [ + + presenter items: #(10 20 30). +] + +{ #category : #accessing } +SpAbstractSearchTest >> selectIndex: index [ + + self presenter selection selectIndex: index +] + +{ #category : #accessing } +SpAbstractSearchTest >> selectedIndex [ + + ^ self presenter selection selectedIndex +] + +{ #category : #tests } +SpAbstractSearchTest >> testSearchWithFunction [ + + self presenter searchMatching: [ :item :textToSearch | + (item - 1) asString beginsWith: textToSearch ]. + self selectIndex: 1. "10" + self adapter typeForSearch: '2'. + self deny: self selectedIndex equals: 2. + self adapter typeForSearch: '2'. + self assert: self selectedIndex equals: 3 "20" +] + +{ #category : #tests } +SpAbstractSearchTest >> testTypePerformsSearch [ + + self selectIndex: 1. "10" + self adapter typeForSearch: '2'. + self assert: self selectedIndex equals: 2 "20" +] diff --git a/src/Spec2-Backend-Tests/SpListSearchTest.class.st b/src/Spec2-Backend-Tests/SpListSearchTest.class.st new file mode 100644 index 00000000000..df2e102fa61 --- /dev/null +++ b/src/Spec2-Backend-Tests/SpListSearchTest.class.st @@ -0,0 +1,11 @@ +Class { + #name : #SpListSearchTest, + #superclass : #SpAbstractSearchTest, + #category : #'Spec2-Backend-Tests' +} + +{ #category : #accessing } +SpListSearchTest >> classToTest [ + + ^ SpListPresenter +] diff --git a/src/Spec2-Backend-Tests/SpMockMenu.class.st b/src/Spec2-Backend-Tests/SpMockMenu.class.st index 15b1b2e575e..cf250d0f93c 100644 --- a/src/Spec2-Backend-Tests/SpMockMenu.class.st +++ b/src/Spec2-Backend-Tests/SpMockMenu.class.st @@ -1,8 +1,8 @@ Class { #name : #SpMockMenu, #superclass : #Object, - #traits : 'TSpObservable', - #classTraits : 'TSpObservable classTrait', + #traits : 'SpTObservable', + #classTraits : 'SpTObservable classTrait', #instVars : [ '#realMenu', '#shown => SpObservableSlot' diff --git a/src/Spec2-Backend-Tests/SpTableSearchTest.class.st b/src/Spec2-Backend-Tests/SpTableSearchTest.class.st new file mode 100644 index 00000000000..2eb1affa198 --- /dev/null +++ b/src/Spec2-Backend-Tests/SpTableSearchTest.class.st @@ -0,0 +1,11 @@ +Class { + #name : #SpTableSearchTest, + #superclass : #SpAbstractSearchTest, + #category : #'Spec2-Backend-Tests' +} + +{ #category : #accessing } +SpTableSearchTest >> classToTest [ + + ^ SpTablePresenter +] diff --git a/src/Spec2-Backend-Tests/SpTreeTableSearchTest.class.st b/src/Spec2-Backend-Tests/SpTreeTableSearchTest.class.st new file mode 100644 index 00000000000..d45cb7902ee --- /dev/null +++ b/src/Spec2-Backend-Tests/SpTreeTableSearchTest.class.st @@ -0,0 +1,31 @@ +Class { + #name : #SpTreeTableSearchTest, + #superclass : #SpAbstractSearchTest, + #category : #'Spec2-Backend-Tests' +} + +{ #category : #accessing } +SpTreeTableSearchTest >> classToTest [ + + ^ SpTreeTablePresenter +] + +{ #category : #running } +SpTreeTableSearchTest >> initializeTestedInstance [ + + presenter roots: #(10 20 30). +] + +{ #category : #tests } +SpTreeTableSearchTest >> selectIndex: index [ + + self presenter selection selectPath: { index } +] + +{ #category : #tests } +SpTreeTableSearchTest >> selectedIndex [ + + ^ self presenter selection selectedPath + ifNotEmpty: #first + ifEmpty: [ 0 ] +] diff --git a/src/Spec2-Commander2-Tests/SpLeftPositionStrategyTest.class.st b/src/Spec2-Commander2-Tests/CmUILeftPositionStrategyExtensionsTest.class.st similarity index 79% rename from src/Spec2-Commander2-Tests/SpLeftPositionStrategyTest.class.st rename to src/Spec2-Commander2-Tests/CmUILeftPositionStrategyExtensionsTest.class.st index e22e47e80e4..4d8aadb9120 100644 --- a/src/Spec2-Commander2-Tests/SpLeftPositionStrategyTest.class.st +++ b/src/Spec2-Commander2-Tests/CmUILeftPositionStrategyExtensionsTest.class.st @@ -2,20 +2,20 @@ A SpSetButtonLeftStrategyTest is a test class for testing the behavior of SpSetButtonLeftStrategy " Class { - #name : #SpLeftPositionStrategyTest, + #name : #CmUILeftPositionStrategyExtensionsTest, #superclass : #TestCase, #category : #'Spec2-Commander2-Tests' } { #category : #test } -SpLeftPositionStrategyTest >> testAddButtonToActionBar [ +CmUILeftPositionStrategyExtensionsTest >> testAddButtonToActionBar [ | actionBar button | actionBar := SpActionBarPresenter new. button := SpButtonPresenter new. self assertEmpty: actionBar items. - SpLeftPositionStrategy new + CmUILeftPositionStrategy new addButton: button toActionBar: actionBar. self assert: actionBar items size equals: 1. @@ -25,14 +25,14 @@ SpLeftPositionStrategyTest >> testAddButtonToActionBar [ ] { #category : #test } -SpLeftPositionStrategyTest >> testAddButtonToToolbar [ +CmUILeftPositionStrategyExtensionsTest >> testAddButtonToToolbar [ | toolbar button | toolbar := SpToolBarPresenter new. button := SpToolBarButton new. self assertEmpty: toolbar items. - SpLeftPositionStrategy new + CmUILeftPositionStrategy new addButton: button toToolbar: toolbar. self assert: toolbar leftItems size equals: 1. diff --git a/src/Spec2-Commander2-Tests/SpRightPositionStrategyTest.class.st b/src/Spec2-Commander2-Tests/CmUIRightPositionStrategyExtensionsTest.class.st similarity index 78% rename from src/Spec2-Commander2-Tests/SpRightPositionStrategyTest.class.st rename to src/Spec2-Commander2-Tests/CmUIRightPositionStrategyExtensionsTest.class.st index 0087fdaca6b..7c41e3b7ecd 100644 --- a/src/Spec2-Commander2-Tests/SpRightPositionStrategyTest.class.st +++ b/src/Spec2-Commander2-Tests/CmUIRightPositionStrategyExtensionsTest.class.st @@ -2,20 +2,20 @@ A SpSetButtonRightStrategyTest is a test class for testing the behavior of SpSetButtonRightStrategy " Class { - #name : #SpRightPositionStrategyTest, + #name : #CmUIRightPositionStrategyExtensionsTest, #superclass : #TestCase, #category : #'Spec2-Commander2-Tests' } { #category : #test } -SpRightPositionStrategyTest >> testAddButtonToActionBar [ +CmUIRightPositionStrategyExtensionsTest >> testAddButtonToActionBar [ | actionBar button | actionBar := SpActionBarPresenter new. button := SpButtonPresenter new. self assertEmpty: actionBar items. - SpRightPositionStrategy new + CmUIRightPositionStrategy new addButton: button toActionBar: actionBar. self assert: actionBar items size equals: 1. @@ -25,14 +25,14 @@ SpRightPositionStrategyTest >> testAddButtonToActionBar [ ] { #category : #test } -SpRightPositionStrategyTest >> testAddButtonToToolbar [ +CmUIRightPositionStrategyExtensionsTest >> testAddButtonToToolbar [ | toolbar button | toolbar := SpToolBarPresenter new. button := SpToolBarButton new. self assertEmpty: toolbar items. - SpRightPositionStrategy new + CmUIRightPositionStrategy new addButton: button toToolbar: toolbar. self assert: toolbar rightItems size equals: 1. diff --git a/src/Spec2-Commander2/CmUICommandDisplayStrategy.extension.st b/src/Spec2-Commander2/CmUICommandDisplayStrategy.extension.st new file mode 100644 index 00000000000..330184e71c0 --- /dev/null +++ b/src/Spec2-Commander2/CmUICommandDisplayStrategy.extension.st @@ -0,0 +1,10 @@ +Extension { #name : #CmUICommandDisplayStrategy } + +{ #category : #'*Spec2-Commander2' } +CmUICommandDisplayStrategy >> display: aCmSpecCommand in: aMenuOrGroupPresenter do: aBlock [ + aMenuOrGroupPresenter + addItem: [ :item | + aBlock value: item. + item enabled: aCmSpecCommand canBeExecuted. + item ] +] diff --git a/src/Spec2-Commander2/CmUICommandGroupDisplayStrategy.extension.st b/src/Spec2-Commander2/CmUICommandGroupDisplayStrategy.extension.st new file mode 100644 index 00000000000..9965278ac68 --- /dev/null +++ b/src/Spec2-Commander2/CmUICommandGroupDisplayStrategy.extension.st @@ -0,0 +1,6 @@ +Extension { #name : #CmUICommandGroupDisplayStrategy } + +{ #category : #'*Spec2-Commander2' } +CmUICommandGroupDisplayStrategy >> display: aCmSpecCommandGroup in: aMenuPresenter do: aBlock [ + self subclassResponsibility +] diff --git a/src/Spec2-Commander2/CmUIDisableWhenCantBeRun.extension.st b/src/Spec2-Commander2/CmUIDisableWhenCantBeRun.extension.st new file mode 100644 index 00000000000..afd6786c8b6 --- /dev/null +++ b/src/Spec2-Commander2/CmUIDisableWhenCantBeRun.extension.st @@ -0,0 +1,10 @@ +Extension { #name : #CmUIDisableWhenCantBeRun } + +{ #category : #'*Spec2-Commander2' } +CmUIDisableWhenCantBeRun >> display: aCmSpecCommand in: aMenuOrGroupPresenter do: aBlock [ + aMenuOrGroupPresenter + addItem: [ :item | + aBlock value: item. + item enabled: aCmSpecCommand canBeExecuted. + item ] +] diff --git a/src/Spec2-Commander2/CmUIDisplayAsGroup.extension.st b/src/Spec2-Commander2/CmUIDisplayAsGroup.extension.st new file mode 100644 index 00000000000..fbbbcb7ca74 --- /dev/null +++ b/src/Spec2-Commander2/CmUIDisplayAsGroup.extension.st @@ -0,0 +1,8 @@ +Extension { #name : #CmUIDisplayAsGroup } + +{ #category : #'*Spec2-Commander2' } +CmUIDisplayAsGroup >> display: aCmSpecCommandGroup in: aMenuPresenter do: aBlock [ + + aMenuPresenter addGroup: [ :menuGroup | + aBlock value: menuGroup ] +] diff --git a/src/Spec2-Commander2/CmUIDisplayAsSubMenu.extension.st b/src/Spec2-Commander2/CmUIDisplayAsSubMenu.extension.st new file mode 100644 index 00000000000..87489189cfa --- /dev/null +++ b/src/Spec2-Commander2/CmUIDisplayAsSubMenu.extension.st @@ -0,0 +1,24 @@ +Extension { #name : #CmUIDisplayAsSubMenu } + +{ #category : #'*Spec2-Commander2' } +CmUIDisplayAsSubMenu >> display: aCmSpecCommandGroup in: aMenuPresenter do: aBlock [ + + aMenuPresenter addItem: [ :menuItem | + menuItem subMenu: (self + fillSubMenuIn: menuItem + with: aCmSpecCommandGroup + do: aBlock) ] +] + +{ #category : #'*Spec2-Commander2' } +CmUIDisplayAsSubMenu >> fillSubMenuIn: menuItem with: aCmSpecCommandGroup do: aBlock [ + | subMenu | + + menuItem + name: aCmSpecCommandGroup name; + description: aCmSpecCommandGroup description; + icon: aCmSpecCommandGroup icon. + subMenu := SpMenuPresenter new. + aBlock value: subMenu. + ^ subMenu +] diff --git a/src/Spec2-Commander2/CmUIHideWhenCantBeRun.extension.st b/src/Spec2-Commander2/CmUIHideWhenCantBeRun.extension.st new file mode 100644 index 00000000000..f56b9206a68 --- /dev/null +++ b/src/Spec2-Commander2/CmUIHideWhenCantBeRun.extension.st @@ -0,0 +1,11 @@ +Extension { #name : #CmUIHideWhenCantBeRun } + +{ #category : #'*Spec2-Commander2' } +CmUIHideWhenCantBeRun >> display: aCmSpecCommand in: aMenuOrGroupPresenter do: aBlock [ + aCmSpecCommand canBeExecuted "If can not be run, stop because we want to hide the command." + ifFalse: [ ^ self ]. + aMenuOrGroupPresenter + addItem: [ :item | + aBlock value: item. + item ] +] diff --git a/src/Spec2-Commander2/CmUILeftPositionStrategy.extension.st b/src/Spec2-Commander2/CmUILeftPositionStrategy.extension.st new file mode 100644 index 00000000000..7f635e85af5 --- /dev/null +++ b/src/Spec2-Commander2/CmUILeftPositionStrategy.extension.st @@ -0,0 +1,11 @@ +Extension { #name : #CmUILeftPositionStrategy } + +{ #category : #'*Spec2-Commander2' } +CmUILeftPositionStrategy >> addButton: aButtonPresenter toActionBar: anActionBarPresenter [ + anActionBarPresenter add: aButtonPresenter +] + +{ #category : #'*Spec2-Commander2' } +CmUILeftPositionStrategy >> addButton: aButtonPresenter toToolbar: aToolbarPresenter [ + aToolbarPresenter addItemLeft: aButtonPresenter +] diff --git a/src/Spec2-Commander2/CmUIPositionStrategy.extension.st b/src/Spec2-Commander2/CmUIPositionStrategy.extension.st new file mode 100644 index 00000000000..fd7176ed258 --- /dev/null +++ b/src/Spec2-Commander2/CmUIPositionStrategy.extension.st @@ -0,0 +1,11 @@ +Extension { #name : #CmUIPositionStrategy } + +{ #category : #'*Spec2-Commander2' } +CmUIPositionStrategy >> addButton: aButtonPresenter toActionBar: anActionBarPresenter [ + self subclassResponsibility +] + +{ #category : #'*Spec2-Commander2' } +CmUIPositionStrategy >> addButton: aButtonPresenter toToolbar: aToolbarPresenter [ + self subclassResponsibility +] diff --git a/src/Spec2-Commander2/CmUIRightPositionStrategy.extension.st b/src/Spec2-Commander2/CmUIRightPositionStrategy.extension.st new file mode 100644 index 00000000000..32508038530 --- /dev/null +++ b/src/Spec2-Commander2/CmUIRightPositionStrategy.extension.st @@ -0,0 +1,11 @@ +Extension { #name : #CmUIRightPositionStrategy } + +{ #category : #'*Spec2-Commander2' } +CmUIRightPositionStrategy >> addButton: aButtonPresenter toActionBar: anActionBarPresenter [ + anActionBarPresenter addLast: aButtonPresenter +] + +{ #category : #'*Spec2-Commander2' } +CmUIRightPositionStrategy >> addButton: aButtonPresenter toToolbar: aToolbarPresenter [ + aToolbarPresenter addItemRight: aButtonPresenter +] diff --git a/src/Spec2-Commander2/SpCommand.class.st b/src/Spec2-Commander2/SpCommand.class.st index 6e5f52c05d7..f4f112125aa 100644 --- a/src/Spec2-Commander2/SpCommand.class.st +++ b/src/Spec2-Commander2/SpCommand.class.st @@ -10,14 +10,7 @@ Basically, I add: " Class { #name : #SpCommand, - #superclass : #CmCommandDecorator, - #instVars : [ - 'iconProvider', - 'iconName', - 'shortcutKey', - 'displayStrategy', - 'positionStrategy' - ], + #superclass : #CmUICommand, #category : #'Spec2-Commander2-Core' } @@ -35,124 +28,11 @@ SpCommand >> asButtonPresenter [ ] -{ #category : #configuring } -SpCommand >> beDisabledWhenCantBeRun [ - self displayStrategy: SpDisableWhenCantBeRun new -] - -{ #category : #configuring } -SpCommand >> beDisplayedOnLeftSide [ - positionStrategy := SpLeftPositionStrategy new -] - -{ #category : #configuring } -SpCommand >> beDisplayedOnRightSide [ - positionStrategy := SpRightPositionStrategy new -] - -{ #category : #configuring } -SpCommand >> beHiddenWhenCantBeRun [ - self displayStrategy: SpHideWhenCantBeRun new -] - { #category : #displaying } SpCommand >> displayIn: aMenuGroupOrPresenter do: aBlock [ - self displayStrategy display: self in: aMenuGroupOrPresenter do: aBlock -] - -{ #category : #accessing } -SpCommand >> displayStrategy [ - ^ displayStrategy -] - -{ #category : #accessing } -SpCommand >> displayStrategy: anObject [ - displayStrategy := anObject -] - -{ #category : #hooks } -SpCommand >> execute [ - [ super execute ] - on: SpInteractionError - do: [ :notificationOrError | notificationOrError actForSpec ] -] - -{ #category : #testing } -SpCommand >> hasIcon [ - - ^ self iconName isNotNil -] - -{ #category : #testing } -SpCommand >> hasShortcutKey [ - - ^ shortcutKey isNotNil -] - -{ #category : #accessing } -SpCommand >> icon [ - self iconName ifNil: [ ^ nil ]. - - ^ self iconNamed: self iconName -] - -{ #category : #accessing } -SpCommand >> iconName [ - ^ iconName -] - -{ #category : #accessing } -SpCommand >> iconName: aSymbol [ - iconName := aSymbol -] - -{ #category : #configuring } -SpCommand >> iconName: aString from: anIconProvider [ - self iconProvider: anIconProvider. - self iconName: aString. -] - -{ #category : #accessing } -SpCommand >> iconNamed: aSymbol [ - ^ self iconProvider iconNamed: aSymbol -] - -{ #category : #accessing } -SpCommand >> iconProvider [ - ^ iconProvider ifNil: [ iconProvider := Smalltalk ui icons ] -] - -{ #category : #accessing } -SpCommand >> iconProvider: anObject [ - iconProvider := anObject -] - -{ #category : #initialization } -SpCommand >> initialize [ - - super initialize. - self beDisabledWhenCantBeRun. - self beDisplayedOnLeftSide -] - -{ #category : #accessing } -SpCommand >> positionStrategy [ - ^ positionStrategy -] - -{ #category : #printing } -SpCommand >> printOn: stream [ - - super printOn: stream. - stream << '(' << self name << ')' -] - -{ #category : #accessing } -SpCommand >> shortcutKey [ - ^ shortcutKey ifNil: [ CmNoShortcutIsDefined signalCommand: self ] -] -{ #category : #accessing } -SpCommand >> shortcutKey: aString [ - shortcutKey := aString + self displayStrategy + display: self + in: aMenuGroupOrPresenter + do: aBlock ] diff --git a/src/Spec2-Commander2/SpCommandDisplayStrategy.class.st b/src/Spec2-Commander2/SpCommandDisplayStrategy.class.st deleted file mode 100644 index e40e4753130..00000000000 --- a/src/Spec2-Commander2/SpCommandDisplayStrategy.class.st +++ /dev/null @@ -1,13 +0,0 @@ -" -I allow to configure how a spec group display itself when shown in UI. -" -Class { - #name : #SpCommandDisplayStrategy, - #superclass : #Object, - #category : #'Spec2-Commander2-Strategies' -} - -{ #category : #displaying } -SpCommandDisplayStrategy >> display: aCmSpecCommand in: aMenuPresenter do: aBlock [ - self subclassResponsibility -] diff --git a/src/Spec2-Commander2/SpCommandGroup.class.st b/src/Spec2-Commander2/SpCommandGroup.class.st index 8a2e033c6d7..bcd0f605100 100644 --- a/src/Spec2-Commander2/SpCommandGroup.class.st +++ b/src/Spec2-Commander2/SpCommandGroup.class.st @@ -7,26 +7,10 @@ Basically, I add: " Class { #name : #SpCommandGroup, - #superclass : #CmCommandGroupDecorator, - #instVars : [ - 'displayStrategy', - 'isRoot', - 'icon' - ], + #superclass : #CmUICommandGroup, #category : #'Spec2-Commander2-Core' } -{ #category : #default } -SpCommandGroup class >> defaultDisplayStrategy [ - - ^ SpDisplayAsSubMenu new -] - -{ #category : #default } -SpCommandGroup class >> defaultIconName [ - ^ #blank -] - { #category : #converting } SpCommandGroup >> asKMCategory [ @@ -89,21 +73,6 @@ SpCommandGroup >> asToolbarPresenterWith: aBlock [ toolbarPresenter ] -{ #category : #configuring } -SpCommandGroup >> beDisplayedAsGroup [ - self displayStrategy: SpDisplayAsGroup new -] - -{ #category : #configuring } -SpCommandGroup >> beDisplayedAsSubMenu [ - self displayStrategy: SpDisplayAsSubMenu new -] - -{ #category : #configuring } -SpCommandGroup >> beRoot [ - self isRoot: true. -] - { #category : #displaying } SpCommandGroup >> displayIn: aMenuPresenter do: aBlock [ @@ -113,56 +82,9 @@ SpCommandGroup >> displayIn: aMenuPresenter do: aBlock [ do: aBlock ] -{ #category : #accessing } -SpCommandGroup >> displayStrategy [ - ^ displayStrategy -] - -{ #category : #accessing } -SpCommandGroup >> displayStrategy: anObject [ - displayStrategy := anObject -] - -{ #category : #accessing } -SpCommandGroup >> icon [ - - ^ icon -] - -{ #category : #accessing } -SpCommandGroup >> icon: anIcon [ - - icon := anIcon -] - -{ #category : #accessing } -SpCommandGroup >> iconName: aSymbol [ - - - self icon: (self iconNamed: aSymbol) -] - -{ #category : #initialization } -SpCommandGroup >> initialize [ - - super initialize. - self displayStrategy: self class defaultDisplayStrategy. - self isRoot: false -] - { #category : #'shortcuts installation' } SpCommandGroup >> installShortcutsIn: aPresenter [ SpShortcutInstaller new presenter: aPresenter; visit: self ] - -{ #category : #accessing } -SpCommandGroup >> isRoot [ - ^ isRoot -] - -{ #category : #accessing } -SpCommandGroup >> isRoot: anObject [ - isRoot := anObject -] diff --git a/src/Spec2-Commander2/SpCommandGroupDisplayStrategy.class.st b/src/Spec2-Commander2/SpCommandGroupDisplayStrategy.class.st deleted file mode 100644 index 5d0816649bb..00000000000 --- a/src/Spec2-Commander2/SpCommandGroupDisplayStrategy.class.st +++ /dev/null @@ -1,13 +0,0 @@ -" -I allow to configure how a spec command group display when shown in UI. -" -Class { - #name : #SpCommandGroupDisplayStrategy, - #superclass : #Object, - #category : #'Spec2-Commander2-Strategies' -} - -{ #category : #displaying } -SpCommandGroupDisplayStrategy >> display: aCmSpecCommandGroup in: aMenuPresenter do: aBlock [ - self subclassResponsibility -] diff --git a/src/Spec2-Commander2/SpDisableWhenCantBeRun.class.st b/src/Spec2-Commander2/SpDisableWhenCantBeRun.class.st deleted file mode 100644 index 1eec2dd8b75..00000000000 --- a/src/Spec2-Commander2/SpDisableWhenCantBeRun.class.st +++ /dev/null @@ -1,17 +0,0 @@ -" -I implement the fact that the button corresponding to a command is disabled when it can not be run. -" -Class { - #name : #SpDisableWhenCantBeRun, - #superclass : #SpCommandDisplayStrategy, - #category : #'Spec2-Commander2-Strategies' -} - -{ #category : #displaying } -SpDisableWhenCantBeRun >> display: aCmSpecCommand in: aMenuOrGroupPresenter do: aBlock [ - aMenuOrGroupPresenter - addItem: [ :item | - aBlock value: item. - item enabled: aCmSpecCommand canBeExecuted. - item ] -] diff --git a/src/Spec2-Commander2/SpDisplayAsGroup.class.st b/src/Spec2-Commander2/SpDisplayAsGroup.class.st deleted file mode 100644 index 1bba0684b7a..00000000000 --- a/src/Spec2-Commander2/SpDisplayAsGroup.class.st +++ /dev/null @@ -1,15 +0,0 @@ -" -I display a command group as a group in the MenuPresenter. -" -Class { - #name : #SpDisplayAsGroup, - #superclass : #SpCommandGroupDisplayStrategy, - #category : #'Spec2-Commander2-Strategies' -} - -{ #category : #displaying } -SpDisplayAsGroup >> display: aCmSpecCommandGroup in: aMenuPresenter do: aBlock [ - - aMenuPresenter addGroup: [ :menuGroup | - aBlock value: menuGroup ] -] diff --git a/src/Spec2-Commander2/SpDisplayAsSubMenu.class.st b/src/Spec2-Commander2/SpDisplayAsSubMenu.class.st deleted file mode 100644 index 6ba95178916..00000000000 --- a/src/Spec2-Commander2/SpDisplayAsSubMenu.class.st +++ /dev/null @@ -1,31 +0,0 @@ -" -I display a command group as a submenu in the MenuPresenter. -" -Class { - #name : #SpDisplayAsSubMenu, - #superclass : #SpCommandGroupDisplayStrategy, - #category : #'Spec2-Commander2-Strategies' -} - -{ #category : #displaying } -SpDisplayAsSubMenu >> display: aCmSpecCommandGroup in: aMenuPresenter do: aBlock [ - - aMenuPresenter addItem: [ :menuItem | - menuItem subMenu: (self - fillSubMenuIn: menuItem - with: aCmSpecCommandGroup - do: aBlock) ] -] - -{ #category : #private } -SpDisplayAsSubMenu >> fillSubMenuIn: menuItem with: aCmSpecCommandGroup do: aBlock [ - | subMenu | - - menuItem - name: aCmSpecCommandGroup name; - description: aCmSpecCommandGroup description; - icon: aCmSpecCommandGroup icon. - subMenu := SpMenuPresenter new. - aBlock value: subMenu. - ^ subMenu -] diff --git a/src/Spec2-Commander2/SpHideWhenCantBeRun.class.st b/src/Spec2-Commander2/SpHideWhenCantBeRun.class.st deleted file mode 100644 index cb916cc27c9..00000000000 --- a/src/Spec2-Commander2/SpHideWhenCantBeRun.class.st +++ /dev/null @@ -1,18 +0,0 @@ -" -I implement the fact that the button corresponding to a command is hidden when it can not be run. -" -Class { - #name : #SpHideWhenCantBeRun, - #superclass : #SpCommandDisplayStrategy, - #category : #'Spec2-Commander2-Strategies' -} - -{ #category : #displaying } -SpHideWhenCantBeRun >> display: aCmSpecCommand in: aMenuOrGroupPresenter do: aBlock [ - aCmSpecCommand canBeExecuted "If can not be run, stop because we want to hide the command." - ifFalse: [ ^ self ]. - aMenuOrGroupPresenter - addItem: [ :item | - aBlock value: item. - item ] -] diff --git a/src/Spec2-Commander2/SpKMCategoryBuilder.class.st b/src/Spec2-Commander2/SpKMCategoryBuilder.class.st index faa0cd80d7b..bfd5daf785b 100644 --- a/src/Spec2-Commander2/SpKMCategoryBuilder.class.st +++ b/src/Spec2-Commander2/SpKMCategoryBuilder.class.st @@ -32,5 +32,7 @@ SpKMCategoryBuilder >> visitCommand: aCmCommand [ kmCategory addKeymapEntry: (KMKeymap shortcut: aCmCommand shortcutKey - action: [ aCmCommand execute ]) + action: [ + aCmCommand canBeExecuted + ifTrue: [ aCmCommand execute ] ]) ] diff --git a/src/Spec2-Commander2/SpLeftPositionStrategy.class.st b/src/Spec2-Commander2/SpLeftPositionStrategy.class.st deleted file mode 100644 index 8afacb99efa..00000000000 --- a/src/Spec2-Commander2/SpLeftPositionStrategy.class.st +++ /dev/null @@ -1,18 +0,0 @@ -" -I set the button generated from a command on the left side a presenter. -" -Class { - #name : #SpLeftPositionStrategy, - #superclass : #SpPositionStrategy, - #category : #'Spec2-Commander2-Strategies' -} - -{ #category : #adding } -SpLeftPositionStrategy >> addButton: aButtonPresenter toActionBar: anActionBarPresenter [ - anActionBarPresenter add: aButtonPresenter -] - -{ #category : #adding } -SpLeftPositionStrategy >> addButton: aButtonPresenter toToolbar: aToolbarPresenter [ - aToolbarPresenter addItemLeft: aButtonPresenter -] diff --git a/src/Spec2-Commander2/SpPositionStrategy.class.st b/src/Spec2-Commander2/SpPositionStrategy.class.st deleted file mode 100644 index 01bf134a7c4..00000000000 --- a/src/Spec2-Commander2/SpPositionStrategy.class.st +++ /dev/null @@ -1,18 +0,0 @@ -" -I model a strategy to add a command in a presenter for which it can be either left or right. -" -Class { - #name : #SpPositionStrategy, - #superclass : #Object, - #category : #'Spec2-Commander2-Strategies' -} - -{ #category : #adding } -SpPositionStrategy >> addButton: aButtonPresenter toActionBar: anActionBarPresenter [ - self subclassResponsibility -] - -{ #category : #adding } -SpPositionStrategy >> addButton: aButtonPresenter toToolbar: aToolbarPresenter [ - self subclassResponsibility -] diff --git a/src/Spec2-Commander2/SpRightPositionStrategy.class.st b/src/Spec2-Commander2/SpRightPositionStrategy.class.st deleted file mode 100644 index a5149c69af4..00000000000 --- a/src/Spec2-Commander2/SpRightPositionStrategy.class.st +++ /dev/null @@ -1,18 +0,0 @@ -" -I set the button generated from a command on the left side a presenter. -" -Class { - #name : #SpRightPositionStrategy, - #superclass : #SpPositionStrategy, - #category : #'Spec2-Commander2-Strategies' -} - -{ #category : #adding } -SpRightPositionStrategy >> addButton: aButtonPresenter toActionBar: anActionBarPresenter [ - anActionBarPresenter addLast: aButtonPresenter -] - -{ #category : #adding } -SpRightPositionStrategy >> addButton: aButtonPresenter toToolbar: aToolbarPresenter [ - aToolbarPresenter addItemRight: aButtonPresenter -] diff --git a/src/Spec2-Commander2/SpToolBarPresenter.extension.st b/src/Spec2-Commander2/SpToolBarPresenter.extension.st new file mode 100644 index 00000000000..18b1b5cc24f --- /dev/null +++ b/src/Spec2-Commander2/SpToolBarPresenter.extension.st @@ -0,0 +1,10 @@ +Extension { #name : #SpToolBarPresenter } + +{ #category : #'*Spec2-Commander2' } +SpToolBarPresenter >> fillWith: aCommandGroup [ + + self removeAllItems. + SpToolBarPresenterBuilder new + toolbarPresenter: self; + visit: aCommandGroup +] diff --git a/src/Spec2-Commands/SpAcceptChangesCommand.class.st b/src/Spec2-Commands/SpAcceptChangesCommand.class.st new file mode 100644 index 00000000000..30b908c4150 --- /dev/null +++ b/src/Spec2-Commands/SpAcceptChangesCommand.class.st @@ -0,0 +1,22 @@ +Class { + #name : #SpAcceptChangesCommand, + #superclass : #SpCodeCommand, + #category : #'Spec2-Commands-Code' +} + +{ #category : #defaults } +SpAcceptChangesCommand class >> defaultIconName [ + ^#smallOk +] + +{ #category : #default } +SpAcceptChangesCommand class >> defaultName [ + + ^ 'Accept' +] + +{ #category : #execution } +SpAcceptChangesCommand >> execute [ + + self context accept +] diff --git a/src/Spec2-Commands/SpCancelChangesCommand.class.st b/src/Spec2-Commands/SpCancelChangesCommand.class.st new file mode 100644 index 00000000000..6a087f6865e --- /dev/null +++ b/src/Spec2-Commands/SpCancelChangesCommand.class.st @@ -0,0 +1,22 @@ +Class { + #name : #SpCancelChangesCommand, + #superclass : #SpCodeCommand, + #category : #'Spec2-Commands-Code' +} + +{ #category : #defaults } +SpCancelChangesCommand class >> defaultIconName [ + ^#smallCancel +] + +{ #category : #default } +SpCancelChangesCommand class >> defaultName [ + + ^ 'Cancel' +] + +{ #category : #execution } +SpCancelChangesCommand >> execute [ + self flag: 'Suspicious: is there not an more obvious/clean way of doing that?'. + self context adapter widget cancel +] diff --git a/src/Spec2-Commands/SpCodeBrowseImplementorsCommand.class.st b/src/Spec2-Commands/SpCodeBrowseImplementorsCommand.class.st new file mode 100644 index 00000000000..75a4e71b28e --- /dev/null +++ b/src/Spec2-Commands/SpCodeBrowseImplementorsCommand.class.st @@ -0,0 +1,29 @@ +Class { + #name : #SpCodeBrowseImplementorsCommand, + #superclass : #SpCodeBrowsingCommand, + #category : #'Spec2-Commands-Code' +} + +{ #category : #defaults } +SpCodeBrowseImplementorsCommand class >> defaultIconName [ + ^#smallSystemBrowser +] + +{ #category : #default } +SpCodeBrowseImplementorsCommand class >> defaultName [ + + ^ 'Browse implementors' +] + +{ #category : #default } +SpCodeBrowseImplementorsCommand class >> defaultShortcutKey [ + + ^ $m command mac + | $m control win + | $m control unix +] + +{ #category : #executing } +SpCodeBrowseImplementorsCommand >> execute [ + self browserClientProvider browseAllImplementorsOf: self selector +] diff --git a/src/Spec2-Commands/SpCodeBrowseItCommand.class.st b/src/Spec2-Commands/SpCodeBrowseItCommand.class.st index d2f789ec77d..8f11cbf9243 100644 --- a/src/Spec2-Commands/SpCodeBrowseItCommand.class.st +++ b/src/Spec2-Commands/SpCodeBrowseItCommand.class.st @@ -1,13 +1,18 @@ Class { #name : #SpCodeBrowseItCommand, - #superclass : #SpCodeSelectionCommand, + #superclass : #SpCodeBrowsingCommand, #category : #'Spec2-Commands-Code' } +{ #category : #default } +SpCodeBrowseItCommand class >> defaultIconName [ + ^#smallSystemBrowser +] + { #category : #default } SpCodeBrowseItCommand class >> defaultName [ - ^ 'Browse Full Class' + ^ 'Browse it' ] { #category : #default } diff --git a/src/Spec2-Commands/SpCodeBrowseMethodsContainingStringCommand.class.st b/src/Spec2-Commands/SpCodeBrowseMethodsContainingStringCommand.class.st new file mode 100644 index 00000000000..832124cbb49 --- /dev/null +++ b/src/Spec2-Commands/SpCodeBrowseMethodsContainingStringCommand.class.st @@ -0,0 +1,21 @@ +Class { + #name : #SpCodeBrowseMethodsContainingStringCommand, + #superclass : #SpCodeBrowsingCommand, + #category : #'Spec2-Commands-Code' +} + +{ #category : #defaults } +SpCodeBrowseMethodsContainingStringCommand class >> defaultIconName [ + ^#smallSystemBrowser +] + +{ #category : #default } +SpCodeBrowseMethodsContainingStringCommand class >> defaultName [ + + ^ 'Browse methods containing string' +] + +{ #category : #executing } +SpCodeBrowseMethodsContainingStringCommand >> execute [ + self browserClientProvider browseMethodsWithSourceString: self selection matchCase: false +] diff --git a/src/Spec2-Commands/SpCodeBrowseReferencesCommand.class.st b/src/Spec2-Commands/SpCodeBrowseReferencesCommand.class.st new file mode 100644 index 00000000000..6ff88c0e0be --- /dev/null +++ b/src/Spec2-Commands/SpCodeBrowseReferencesCommand.class.st @@ -0,0 +1,21 @@ +Class { + #name : #SpCodeBrowseReferencesCommand, + #superclass : #SpCodeBrowsingCommand, + #category : #'Spec2-Commands-Code' +} + +{ #category : #defaults } +SpCodeBrowseReferencesCommand class >> defaultIconName [ + ^#smallSystemBrowser +] + +{ #category : #default } +SpCodeBrowseReferencesCommand class >> defaultName [ + + ^ 'Browse references' +] + +{ #category : #executing } +SpCodeBrowseReferencesCommand >> execute [ + self browserClientProvider browseAllReferencesTo: self selector +] diff --git a/src/Spec2-Commands/SpCodeBrowseSendersCommand.class.st b/src/Spec2-Commands/SpCodeBrowseSendersCommand.class.st new file mode 100644 index 00000000000..803ed97aa2f --- /dev/null +++ b/src/Spec2-Commands/SpCodeBrowseSendersCommand.class.st @@ -0,0 +1,29 @@ +Class { + #name : #SpCodeBrowseSendersCommand, + #superclass : #SpCodeBrowsingCommand, + #category : #'Spec2-Commands-Code' +} + +{ #category : #defaults } +SpCodeBrowseSendersCommand class >> defaultIconName [ + ^#smallSystemBrowser +] + +{ #category : #default } +SpCodeBrowseSendersCommand class >> defaultName [ + + ^ 'Browse senders' +] + +{ #category : #default } +SpCodeBrowseSendersCommand class >> defaultShortcutKey [ + + ^ $n command mac + | $n control win + | $n control unix +] + +{ #category : #executing } +SpCodeBrowseSendersCommand >> execute [ + self browserClientProvider browseAllSendersOf: self selector +] diff --git a/src/Spec2-Commands/SpCodeBrowsingCommand.class.st b/src/Spec2-Commands/SpCodeBrowsingCommand.class.st new file mode 100644 index 00000000000..fc718cb7018 --- /dev/null +++ b/src/Spec2-Commands/SpCodeBrowsingCommand.class.st @@ -0,0 +1,15 @@ +Class { + #name : #SpCodeBrowsingCommand, + #superclass : #SpCodeSelectionCommand, + #category : #'Spec2-Commands-Code' +} + +{ #category : #accessing } +SpCodeBrowsingCommand >> browserClientProvider [ + ^ SystemNavigation default +] + +{ #category : #accessing } +SpCodeBrowsingCommand >> selector [ + ^self selection asSymbol +] diff --git a/src/Spec2-Commands/SpCodeCommand.class.st b/src/Spec2-Commands/SpCodeCommand.class.st index 98e1e0fa50e..f151ceba035 100644 --- a/src/Spec2-Commands/SpCodeCommand.class.st +++ b/src/Spec2-Commands/SpCodeCommand.class.st @@ -9,6 +9,11 @@ Class { #category : #'Spec2-Commands-Code' } +{ #category : #defaults } +SpCodeCommand class >> defaultIconName [ + ^nil +] + { #category : #defaults } SpCodeCommand class >> defaultShortcutKey [ @@ -18,14 +23,18 @@ SpCodeCommand class >> defaultShortcutKey [ { #category : #converting } SpCodeCommand >> asSpecCommand [ | command | - command := super asSpecCommand. - self shortcutKey - ifNotNil: [ :key | command shortcutKey: key ]. - + self shortcutKey ifNotNil: [ :key | command shortcutKey: key ]. + self defaultIconName + ifNotNil: [ :iconName | command iconName: iconName ]. ^ command ] +{ #category : #accessing } +SpCodeCommand >> defaultIconName [ + ^self class defaultIconName +] + { #category : #accessing } SpCodeCommand >> shortcutKey [ diff --git a/src/Spec2-Commands/SpCodeCopyCommand.class.st b/src/Spec2-Commands/SpCodeCopyCommand.class.st new file mode 100644 index 00000000000..7ac3beb116e --- /dev/null +++ b/src/Spec2-Commands/SpCodeCopyCommand.class.st @@ -0,0 +1,29 @@ +Class { + #name : #SpCodeCopyCommand, + #superclass : #SpCodeEditionCommand, + #category : #'Spec2-Commands-Code' +} + +{ #category : #defaults } +SpCodeCopyCommand class >> defaultIconName [ + ^#smallCopy +] + +{ #category : #default } +SpCodeCopyCommand class >> defaultName [ + + ^ 'Copy' +] + +{ #category : #default } +SpCodeCopyCommand class >> defaultShortcutKey [ + + ^ $c command mac + | $c control win + | $c control unix +] + +{ #category : #execution } +SpCodeCopyCommand >> execute [ + self editor copySelection +] diff --git a/src/Spec2-Commands/SpCodeCutCommand.class.st b/src/Spec2-Commands/SpCodeCutCommand.class.st new file mode 100644 index 00000000000..8b3aca421e5 --- /dev/null +++ b/src/Spec2-Commands/SpCodeCutCommand.class.st @@ -0,0 +1,29 @@ +Class { + #name : #SpCodeCutCommand, + #superclass : #SpCodeEditionCommand, + #category : #'Spec2-Commands-Code' +} + +{ #category : #defaults } +SpCodeCutCommand class >> defaultIconName [ + ^#smallCut +] + +{ #category : #default } +SpCodeCutCommand class >> defaultName [ + + ^ 'Cut' +] + +{ #category : #default } +SpCodeCutCommand class >> defaultShortcutKey [ + + ^ $x command mac + | $x control win + | $x control unix +] + +{ #category : #execution } +SpCodeCutCommand >> execute [ + self editor cut +] diff --git a/src/Spec2-Commands/SpCodeDebugItCommand.class.st b/src/Spec2-Commands/SpCodeDebugItCommand.class.st index e401c99a96d..23fe5433486 100644 --- a/src/Spec2-Commands/SpCodeDebugItCommand.class.st +++ b/src/Spec2-Commands/SpCodeDebugItCommand.class.st @@ -4,6 +4,11 @@ Class { #category : #'Spec2-Commands-Code' } +{ #category : #defaults } +SpCodeDebugItCommand class >> defaultIconName [ + ^#smallDebug +] + { #category : #default } SpCodeDebugItCommand class >> defaultName [ diff --git a/src/Spec2-Commands/SpCodeDoItCommand.class.st b/src/Spec2-Commands/SpCodeDoItCommand.class.st index c721f43d681..af85a85d7d2 100644 --- a/src/Spec2-Commands/SpCodeDoItCommand.class.st +++ b/src/Spec2-Commands/SpCodeDoItCommand.class.st @@ -4,6 +4,11 @@ Class { #category : #'Spec2-Commands-Code' } +{ #category : #defaults } +SpCodeDoItCommand class >> defaultIconName [ + ^#smallDoIt +] + { #category : #default } SpCodeDoItCommand class >> defaultName [ diff --git a/src/Spec2-Commands/SpCodeEditionCommand.class.st b/src/Spec2-Commands/SpCodeEditionCommand.class.st new file mode 100644 index 00000000000..e55d3eb7ed0 --- /dev/null +++ b/src/Spec2-Commands/SpCodeEditionCommand.class.st @@ -0,0 +1,12 @@ +Class { + #name : #SpCodeEditionCommand, + #superclass : #SpCodeSelectionCommand, + #category : #'Spec2-Commands-Code' +} + +{ #category : #accessing } +SpCodeEditionCommand >> editor [ + self flag: 'This is wrong! How can we edit text/code from text/code presenters?'. + self flag: 'Class name is wrong: it also applies to text and not only to code!'. + ^ context adapter widget textArea editor +] diff --git a/src/Spec2-Commands/SpCodeInspectItCommand.class.st b/src/Spec2-Commands/SpCodeInspectItCommand.class.st index 9df404da2e9..da8a513e6ca 100644 --- a/src/Spec2-Commands/SpCodeInspectItCommand.class.st +++ b/src/Spec2-Commands/SpCodeInspectItCommand.class.st @@ -4,6 +4,11 @@ Class { #category : #'Spec2-Commands-Code' } +{ #category : #defaults } +SpCodeInspectItCommand class >> defaultIconName [ + ^#smallInspectIt +] + { #category : #default } SpCodeInspectItCommand class >> defaultName [ diff --git a/src/Spec2-Commands/SpCodePasteCommand.class.st b/src/Spec2-Commands/SpCodePasteCommand.class.st new file mode 100644 index 00000000000..4271903e1a9 --- /dev/null +++ b/src/Spec2-Commands/SpCodePasteCommand.class.st @@ -0,0 +1,29 @@ +Class { + #name : #SpCodePasteCommand, + #superclass : #SpCodeEditionCommand, + #category : #'Spec2-Commands-Code' +} + +{ #category : #defaults } +SpCodePasteCommand class >> defaultIconName [ + ^#smallPaste +] + +{ #category : #default } +SpCodePasteCommand class >> defaultName [ + + ^ 'Paste' +] + +{ #category : #default } +SpCodePasteCommand class >> defaultShortcutKey [ + + ^ $v command mac + | $v control win + | $v control unix +] + +{ #category : #execution } +SpCodePasteCommand >> execute [ + self editor paste +] diff --git a/src/Spec2-Commands/SpCodePrintItCommand.class.st b/src/Spec2-Commands/SpCodePrintItCommand.class.st index 652afede630..4e8303a6ca4 100644 --- a/src/Spec2-Commands/SpCodePrintItCommand.class.st +++ b/src/Spec2-Commands/SpCodePrintItCommand.class.st @@ -4,6 +4,11 @@ Class { #category : #'Spec2-Commands-Code' } +{ #category : #defaults } +SpCodePrintItCommand class >> defaultIconName [ + ^#smallPrintIt +] + { #category : #default } SpCodePrintItCommand class >> defaultName [ diff --git a/src/Spec2-Commands/SpCodeProfileItCommand.class.st b/src/Spec2-Commands/SpCodeProfileItCommand.class.st index 08cfe10f56c..caafdef6153 100644 --- a/src/Spec2-Commands/SpCodeProfileItCommand.class.st +++ b/src/Spec2-Commands/SpCodeProfileItCommand.class.st @@ -4,6 +4,11 @@ Class { #category : #'Spec2-Commands-Code' } +{ #category : #defaults } +SpCodeProfileItCommand class >> defaultIconName [ + ^#smallProfile +] + { #category : #default } SpCodeProfileItCommand class >> defaultName [ diff --git a/src/Spec2-Commands/SpCodeSelectAndPasteCommand.class.st b/src/Spec2-Commands/SpCodeSelectAndPasteCommand.class.st new file mode 100644 index 00000000000..b8c23e31176 --- /dev/null +++ b/src/Spec2-Commands/SpCodeSelectAndPasteCommand.class.st @@ -0,0 +1,21 @@ +Class { + #name : #SpCodeSelectAndPasteCommand, + #superclass : #SpCodeEditionCommand, + #category : #'Spec2-Commands-Code' +} + +{ #category : #defaults } +SpCodeSelectAndPasteCommand class >> defaultIconName [ + ^#smallCopy +] + +{ #category : #default } +SpCodeSelectAndPasteCommand class >> defaultName [ + + ^ 'Paste...' +] + +{ #category : #execution } +SpCodeSelectAndPasteCommand >> execute [ + self editor pasteRecent +] diff --git a/src/Spec2-Commands/SpCodeSelectionCommand.class.st b/src/Spec2-Commands/SpCodeSelectionCommand.class.st index 3b23201a601..6e22aa9fa7e 100644 --- a/src/Spec2-Commands/SpCodeSelectionCommand.class.st +++ b/src/Spec2-Commands/SpCodeSelectionCommand.class.st @@ -64,10 +64,11 @@ SpCodeSelectionCommand >> selectLine [ { #category : #accessing } SpCodeSelectionCommand >> selection [ | selection | - + self flag: 'I wonder about the naming of the classes: should actions based on selection not be available also on text presenters?'. selection := context selection. selection ifEmpty: [ ^ '' ]. - context accept. + self flag: 'The following code has been commented: it seems wrong and provokes the current context to be restarted in the debugger'. + "context accept." ^ context text copyFrom: selection first to: selection last ] diff --git a/src/Spec2-Core/SpAbstractListPresenter.class.st b/src/Spec2-Core/SpAbstractListPresenter.class.st index e106f83edbd..c75d5facf7a 100644 --- a/src/Spec2-Core/SpAbstractListPresenter.class.st +++ b/src/Spec2-Core/SpAbstractListPresenter.class.st @@ -1,8 +1,8 @@ Class { #name : #SpAbstractListPresenter, #superclass : #SpAbstractWidgetPresenter, - #traits : 'TSpHaveWrappingScrollBars + SpTContextMenu', - #classTraits : 'TSpHaveWrappingScrollBars classTrait + SpTContextMenu classTrait', + #traits : 'SpTHaveWrappingScrollBars + SpTContextMenu', + #classTraits : 'SpTHaveWrappingScrollBars classTrait + SpTContextMenu classTrait', #instVars : [ '#selectionMode', '#activationBlock', @@ -105,7 +105,7 @@ SpAbstractListPresenter >> initialize [ activationBlock := [ ]. verticalAlignment := SpVerticalAlignment new. - + self withScrollBars. self model: self newEmptyModel. @@ -317,6 +317,7 @@ SpAbstractListPresenter >> whenActivatedDo: aBlock [ { #category : #'api-events' } SpAbstractListPresenter >> whenItemFilterBlockChangedDo: aBlock [ + self property: #itemFilter whenChangedDo: aBlock ] @@ -326,6 +327,12 @@ SpAbstractListPresenter >> whenModelChangedDo: aBlock [ model whenChangedDo: aBlock ] +{ #category : #'api-events' } +SpAbstractListPresenter >> whenSearchChangedDo: aBlock [ + + self property: #searchEnabled whenChangedDo: aBlock +] + { #category : #'api-events' } SpAbstractListPresenter >> whenSelectionChangedDo: aBlock [ "Subscribe to changes in selection. diff --git a/src/Spec2-Core/SpAbstractPresenter.class.st b/src/Spec2-Core/SpAbstractPresenter.class.st index 4df9c3cf644..8402689dbec 100644 --- a/src/Spec2-Core/SpAbstractPresenter.class.st +++ b/src/Spec2-Core/SpAbstractPresenter.class.st @@ -5,8 +5,8 @@ I define common behaviours for widget presenters and also for composable present Class { #name : #SpAbstractPresenter, #superclass : #Model, - #traits : 'TSpObservable', - #classTraits : 'TSpObservable classTrait', + #traits : 'SpTObservable', + #classTraits : 'SpTObservable classTrait', #instVars : [ '#owner', '#adapter', diff --git a/src/Spec2-Core/SpAbstractSelectionMode.class.st b/src/Spec2-Core/SpAbstractSelectionMode.class.st index 84eaee232d8..9e3e0a48077 100644 --- a/src/Spec2-Core/SpAbstractSelectionMode.class.st +++ b/src/Spec2-Core/SpAbstractSelectionMode.class.st @@ -1,8 +1,24 @@ +" +I am a base selection mode. +My children will define selection styles (single, multiple) and realise the different selecting logic. + +I can : + +- selectItem/selectItems +- selectIndex/selectIndexes +- selectAll + +Also, I can retrieve + +- selectedItems +- selectedIndexes + +" Class { #name : #SpAbstractSelectionMode, #superclass : #Object, - #traits : 'TSpObservable', - #classTraits : 'TSpObservable classTrait', + #traits : 'SpTObservable', + #classTraits : 'SpTObservable classTrait', #instVars : [ 'widget' ], diff --git a/src/Spec2-Core/SpAbstractTextPresenter.class.st b/src/Spec2-Core/SpAbstractTextPresenter.class.st index 56d9747c4eb..62c4114aff0 100644 --- a/src/Spec2-Core/SpAbstractTextPresenter.class.st +++ b/src/Spec2-Core/SpAbstractTextPresenter.class.st @@ -97,7 +97,7 @@ SpAbstractTextPresenter >> clearContent [ SpAbstractTextPresenter >> clearSelection [ "Remove selection from the text model" - self selection: (0 to: 0) + self selectionInterval: (0 to: 0) ] { #category : #'undo-redo' } @@ -286,10 +286,8 @@ SpAbstractTextPresenter >> selectAll [ { #category : #api } SpAbstractTextPresenter >> selectLine [ - - self withAdapterDo: [ :anAdapter | - anAdapter selectLine ]. - ^ self selection + self withAdapterDo: [ :anAdapter | anAdapter selectLine ]. + ^ self selectionInterval ] { #category : #NOCompletion } @@ -300,16 +298,35 @@ SpAbstractTextPresenter >> selectedClassOrMetaClass [ { #category : #api } SpAbstractTextPresenter >> selection [ - "Get the text selection. + self + deprecated: + '#selection was used to return an interval, and did not convey the correct meaning. Use #selectionInterval instead.' + transformWith: '`@receiver selection' -> '`@receiver selectionInterval'. + ^ self selectionInterval +] + +{ #category : #api } +SpAbstractTextPresenter >> selection: anInterval [ + self + deprecated: + '#selection: was used to set an interval, and did not convey the correct meaning. Use #selectionInterval: instead.' + transformWith: '`@receiver selection: `@arg' -> '`@receiver selectionInterval: `@arg'. + self selectionInterval: anInterval +] + +{ #category : #api } +SpAbstractTextPresenter >> selectionInterval [ + "Get the text selection interval. I will update the selection from adapter first" + self withAdapterDo: [ :anAdapter | self rawSelection: anAdapter selection ]. ^ selection ifNil: [ ^ 1 to: 0 ] ] { #category : #api } -SpAbstractTextPresenter >> selection: anInterval [ - "Set the text selection without changing the readSelectionBlock" +SpAbstractTextPresenter >> selectionInterval: anInterval [ + "Set the text selection interval without changing the readSelectionBlock" selection := anInterval ] diff --git a/src/Spec2-Core/SpAbstractTreeSelectionMode.class.st b/src/Spec2-Core/SpAbstractTreeSelectionMode.class.st new file mode 100644 index 00000000000..127f3609f48 --- /dev/null +++ b/src/Spec2-Core/SpAbstractTreeSelectionMode.class.st @@ -0,0 +1,160 @@ +Class { + #name : #SpAbstractTreeSelectionMode, + #superclass : #Object, + #traits : 'SpTObservable', + #classTraits : 'SpTObservable classTrait', + #instVars : [ + '#selection => SpObservableSlot', + '#presenter' + ], + #category : #'Spec2-Core-Widgets-Tree' +} + +{ #category : #'accessing method dictionary' } +SpAbstractTreeSelectionMode class >> on: aPresenter [ + + ^ self new + presenter: aPresenter; + yourself +] + +{ #category : #selecting } +SpAbstractTreeSelectionMode >> clearSelection [ + + selection := #() +] + +{ #category : #initialization } +SpAbstractTreeSelectionMode >> initialize [ + self class initializeSlots: self. + selection := #(). + super initialize. + +] + +{ #category : #testing } +SpAbstractTreeSelectionMode >> isEmpty [ + + ^ selection isEmpty +] + +{ #category : #accessing } +SpAbstractTreeSelectionMode >> isMultipleSelection [ + ^ false +] + +{ #category : #selecting } +SpAbstractTreeSelectionMode >> itemNotFoundAction [ + "ignore. we do not change the selection" +] + +{ #category : #selecting } +SpAbstractTreeSelectionMode >> pathOf: anItem [ + ^ (self pathOf: anItem from: presenter roots) + ifNil: [ NotFound signalFor: anItem in: presenter roots ] +] + +{ #category : #selecting } +SpAbstractTreeSelectionMode >> pathOf: anItem from: aCollection [ + | index | + + index := aCollection indexOf: anItem. + index > 0 ifTrue: [ ^ { index } ]. + + aCollection withIndexDo: [ :each :i | + (self pathOf: anItem from: (presenter childrenFor: each)) + ifNotNil: [ :path | ^ { i }, path ] ]. + + ^ nil +] + +{ #category : #accessing } +SpAbstractTreeSelectionMode >> presenter: aPresenter [ + presenter := aPresenter +] + +{ #category : #selecting } +SpAbstractTreeSelectionMode >> selectItem: anItem [ + [ self selectPath: (self pathOf: anItem) ] + on: NotFound + do: [ self itemNotFoundAction ] +] + +{ #category : #selecting } +SpAbstractTreeSelectionMode >> selectItems: aListOfItems [ + aListOfItems do: + [ :each | + [ self selectPath: (self pathOf: each) ] + on: NotFound + do: [ "ignore. we do not change the selection" ] ] +] + +{ #category : #selecting } +SpAbstractTreeSelectionMode >> selectPath: aPath [ + "Select a node in the tree by providing a list of indexes. + Example: + A + B + C + E + D + G + T + selectPath( #(1 2) ) will select the node C + selectPath( #(2 1) ) will select the node G + selectPath( #(2) ) will select the node D + " + + self subclassResponsibility +] + +{ #category : #selecting } +SpAbstractTreeSelectionMode >> selectPaths: pathArray [ + self subclassResponsibility +] + +{ #category : #accessing } +SpAbstractTreeSelectionMode >> selectedItem [ + ^ self subclassResponsibility +] + +{ #category : #accessing } +SpAbstractTreeSelectionMode >> selectedPaths [ + ^ self subclassResponsibility +] + +{ #category : #accessing } +SpAbstractTreeSelectionMode >> selectionHolder [ + + ^ self observablePropertyNamed: #selection +] + +{ #category : #transfering } +SpAbstractTreeSelectionMode >> transferSubscriptionsTo: anotherSelectionMode [ + + self selectionHolder transferSubscriptionsTo: anotherSelectionMode selectionHolder +] + +{ #category : #selecting } +SpAbstractTreeSelectionMode >> unselectAll [ + + self clearSelection +] + +{ #category : #selecting } +SpAbstractTreeSelectionMode >> unselectItem: anItem [ + [ self unselectPath: (self pathOf: anItem) ] + on: NotFound + do: [ "ignore. nothing to unselect" ] +] + +{ #category : #selecting } +SpAbstractTreeSelectionMode >> unselectPath: aPath [ + self subclassResponsibility +] + +{ #category : #'api - events' } +SpAbstractTreeSelectionMode >> whenChangedDo: aBlock [ + + self property: #selection whenChangedDo: aBlock +] diff --git a/src/Spec2-Core/SpAbstractTreeSingleSelectionMode.class.st b/src/Spec2-Core/SpAbstractTreeSingleSelectionMode.class.st deleted file mode 100644 index c1a64fd5a15..00000000000 --- a/src/Spec2-Core/SpAbstractTreeSingleSelectionMode.class.st +++ /dev/null @@ -1,100 +0,0 @@ -Class { - #name : #SpAbstractTreeSingleSelectionMode, - #superclass : #Object, - #traits : 'TSpObservable', - #classTraits : 'TSpObservable classTrait', - #instVars : [ - '#selection => SpObservableSlot', - '#presenter' - ], - #category : #'Spec2-Core-Widgets-Tree' -} - -{ #category : #'accessing method dictionary' } -SpAbstractTreeSingleSelectionMode class >> on: aPresenter [ - - ^ self new - presenter: aPresenter; - yourself -] - -{ #category : #selection } -SpAbstractTreeSingleSelectionMode >> clearSelection [ - - selection := #() -] - -{ #category : #initialization } -SpAbstractTreeSingleSelectionMode >> initialize [ - self class initializeSlots: self. - selection := #(). - super initialize. - -] - -{ #category : #testing } -SpAbstractTreeSingleSelectionMode >> isEmpty [ - - ^ selection isEmpty -] - -{ #category : #accessing } -SpAbstractTreeSingleSelectionMode >> isMultipleSelection [ - ^ false -] - -{ #category : #accesing } -SpAbstractTreeSingleSelectionMode >> presenter: aPresenter [ - presenter := aPresenter -] - -{ #category : #selection } -SpAbstractTreeSingleSelectionMode >> selectPath: aPath [ - - self subclassResponsibility -] - -{ #category : #selection } -SpAbstractTreeSingleSelectionMode >> selectPaths: pathArray [ - self subclassResponsibility -] - -{ #category : #accessing } -SpAbstractTreeSingleSelectionMode >> selectedItem [ - ^ self subclassResponsibility -] - -{ #category : #accessing } -SpAbstractTreeSingleSelectionMode >> selectedPaths [ - ^ self subclassResponsibility -] - -{ #category : #accessing } -SpAbstractTreeSingleSelectionMode >> selectionHolder [ - - ^ self observablePropertyNamed: #selection -] - -{ #category : #transfert } -SpAbstractTreeSingleSelectionMode >> transferSubscriptionsTo: anotherSelectionMode [ - - self selectionHolder transferSubscriptionsTo: anotherSelectionMode selectionHolder -] - -{ #category : #selecting } -SpAbstractTreeSingleSelectionMode >> unselectAll [ - - self clearSelection -] - -{ #category : #selection } -SpAbstractTreeSingleSelectionMode >> unselectPath: aPath [ - - self subclassResponsibility -] - -{ #category : #'api - events' } -SpAbstractTreeSingleSelectionMode >> whenChangedDo: aBlock [ - - self property: #selection whenChangedDo: aBlock -] diff --git a/src/Spec2-Core/SpApplication.class.st b/src/Spec2-Core/SpApplication.class.st index fb6c4425eab..e22c0634ef7 100644 --- a/src/Spec2-Core/SpApplication.class.st +++ b/src/Spec2-Core/SpApplication.class.st @@ -56,9 +56,10 @@ SpApplication >> configuration [ ^ configuration ] -{ #category : #'as yet unclassified' } -SpApplication >> defer: aBlockClosure [ - self backend defer: aBlockClosure. +{ #category : #accessing } +SpApplication >> defer: aBlock [ + + self backend defer: aBlock ] { #category : #windows } diff --git a/src/Spec2-Core/SpCodePresenter.class.st b/src/Spec2-Core/SpCodePresenter.class.st index 743817156e6..cb98b04f061 100644 --- a/src/Spec2-Core/SpCodePresenter.class.st +++ b/src/Spec2-Core/SpCodePresenter.class.st @@ -115,6 +115,23 @@ SpCodePresenter >> doItReceiver: anObject [ doItReceiver := anObject ] +{ #category : #navigation } +SpCodePresenter >> findClassFrom: aString [ + | ast | + ast := RBParser parseExpression: aString onError: [ ^ nil ]. + ast + nodesDo: [ :node | + (node isVariable and: [ node name first isUppercase ]) + ifTrue: [ (self class environment classNamed: node name) + ifNotNil: [ :aClass | ^ aClass ] ] ]. + ^ nil +] + +{ #category : #navigation } +SpCodePresenter >> findClassFromSelection [ + ^ self findClassFrom: self selectionOrLine trimmed +] + { #category : #testing } SpCodePresenter >> hasSyntaxHighlight [ @@ -149,6 +166,14 @@ SpCodePresenter >> selectedBehavior [ ^ self behavior ] +{ #category : #navigation } +SpCodePresenter >> selectionOrLine [ + ^ self selection + ifEmpty: [ self + selectLine; + selection ] +] + { #category : #accessing } SpCodePresenter >> syntaxHighlight: aBoolean [ syntaxHighlight := aBoolean diff --git a/src/Spec2-Core/SpCollectionListModel.class.st b/src/Spec2-Core/SpCollectionListModel.class.st index 40c272ac4e5..2bfa7ee8b49 100644 --- a/src/Spec2-Core/SpCollectionListModel.class.st +++ b/src/Spec2-Core/SpCollectionListModel.class.st @@ -1,8 +1,8 @@ Class { #name : #SpCollectionListModel, #superclass : #Object, - #traits : 'TSpObservable', - #classTraits : 'TSpObservable classTrait', + #traits : 'SpTObservable', + #classTraits : 'SpTObservable classTrait', #instVars : [ '#announcer', '#collection', diff --git a/src/Spec2-Core/SpComponentListPresenter.class.st b/src/Spec2-Core/SpComponentListPresenter.class.st index 2772d612489..01c06721103 100644 --- a/src/Spec2-Core/SpComponentListPresenter.class.st +++ b/src/Spec2-Core/SpComponentListPresenter.class.st @@ -19,6 +19,17 @@ SpComponentListPresenter >> addPresenter: aPresenter [ self model add: aPresenter ] +{ #category : #private } +SpComponentListPresenter >> doActivateAtIndex: index [ + + "Activate only if there is an item at that position" + self presenters at: index ifAbsent: [ ^ self ]. + + activationBlock cull: ((SpSingleSelectionMode on: self) + basicSelectIndex: index; + yourself) +] + { #category : #testing } SpComponentListPresenter >> includes: aPresenter [ diff --git a/src/Spec2-Core/SpDialogWindowPresenter.class.st b/src/Spec2-Core/SpDialogWindowPresenter.class.st index e49bc4d8066..1187336bd01 100644 --- a/src/Spec2-Core/SpDialogWindowPresenter.class.st +++ b/src/Spec2-Core/SpDialogWindowPresenter.class.st @@ -8,7 +8,8 @@ Class { 'buttons', 'okAction', 'cancelAction', - 'cancelled' + 'cancelled', + 'defaultButton' ], #category : #'Spec2-Core-Support' } @@ -19,17 +20,42 @@ SpDialogWindowPresenter class >> adapterName [ ^ #DialogWindowAdapter ] +{ #category : #private } +SpDialogWindowPresenter >> addButton: aButtonPresenter [ + + buttons add: aButtonPresenter. + ^ aButtonPresenter +] + { #category : #accessing } SpDialogWindowPresenter >> addButton: aString do: aBlock [ "Adds button logic to dialog." - ^ buttons add: (SpButtonPresenter new + ^ self addButton: (SpButtonPresenter new owner: self; label: aString; action: [ aBlock cull: self ]; yourself) ] +{ #category : #private } +SpDialogWindowPresenter >> addDefaultButton: aButtonPresenter [ + "Adds button logic to dialog." + + defaultButton := self addButton: aButtonPresenter. + defaultButton addStyle: 'default'. + ^ defaultButton +] + +{ #category : #accessing } +SpDialogWindowPresenter >> addDefaultButton: aString do: aBlock [ + "Adds button logic to dialog." + + defaultButton := self addButton: aString do: aBlock. + defaultButton addStyle: 'default'. + ^ defaultButton +] + { #category : #accessing } SpDialogWindowPresenter >> beCancel [ @@ -68,6 +94,13 @@ SpDialogWindowPresenter >> cancelled [ ^ cancelled ] +{ #category : #private } +SpDialogWindowPresenter >> executeDefaultAction [ + + defaultButton ifNil: [ ^ self ]. + defaultButton action cull: self +] + { #category : #initialization } SpDialogWindowPresenter >> initialize [ diff --git a/src/Spec2-Core/SpDynamicPresenter.class.st b/src/Spec2-Core/SpDynamicPresenter.class.st index d793e7fa850..f949f8d40b6 100644 --- a/src/Spec2-Core/SpDynamicPresenter.class.st +++ b/src/Spec2-Core/SpDynamicPresenter.class.st @@ -24,8 +24,8 @@ todo Class { #name : #SpDynamicPresenter, #superclass : #SpPresenter, - #traits : 'TSpDynamicPresenter', - #classTraits : 'TSpDynamicPresenter classTrait', + #traits : 'SpTDynamicPresenter', + #classTraits : 'SpTDynamicPresenter classTrait', #category : #'Spec2-Core-Base' } diff --git a/src/Spec2-Core/SpEditableList.class.st b/src/Spec2-Core/SpEditableList.class.st deleted file mode 100644 index 2616fb41c1e..00000000000 --- a/src/Spec2-Core/SpEditableList.class.st +++ /dev/null @@ -1,213 +0,0 @@ -" -This widget allows you to edit a list of items : -- add / remove an item to/from the list -- order the list by moving elements up/down/top/bottom. - -The default behavior is to do a copy of the list. The widget works with its internal copy. It allows the user to accept / reject changes (for example by opening the widget in a DialogWindow) before affecting the original list. It is your responsability to copy EditableList items back to the original list. - -The addItemBlock is used to provide a way to give the item to add (e.g. a UIManager default chooseFrom: values:). - -Example: -self example -" -Class { - #name : #SpEditableList, - #superclass : #SpPresenter, - #instVars : [ - 'title', - 'list', - 'addButton', - 'removeButton', - 'upButton', - 'downButton', - 'topButton', - 'bottomButton', - 'addItemBlock', - 'okBlock' - ], - #category : #'Spec2-Core-Widgets' -} - -{ #category : #spec } -SpEditableList class >> defaultSpec [ - ^ SpBoxLayout newVertical - add: - (SpBoxLayout newHorizontal - add: #addButton; - add: #removeButton; - yourself) - expand: false - fill: false - padding: 0; - add: - (SpBoxLayout newHorizontal - add: #list; - add: - (SpBoxLayout newVertical - add: #topButton; - add: #upButton; - add: #downButton; - add: #bottomButton; - yourself) - expand: false - fill: false - padding: 0; - yourself); - yourself -] - -{ #category : #'instance creation' } -SpEditableList class >> new: aCollection [ - ^ self new list: aCollection copy. - -] - -{ #category : #accessing } -SpEditableList >> addButton [ - ^ addButton -] - -{ #category : #api } -SpEditableList >> addItemBlock: aBlock [ - addItemBlock := aBlock. -] - -{ #category : #accessing } -SpEditableList >> bottomButton [ - ^ bottomButton -] - -{ #category : #initialization } -SpEditableList >> connectPresenters [ - super connectPresenters - - addButton action: [ | requirement | - requirement := addItemBlock value. - requirement ifNotNil: [ - self list: (self list listItems copyWith: requirement) ] ]. - - removeButton - action: [ self list: (list listItems copyWithoutIndex: list selectedIndex) ]. - - topButton - action: [ self moveElementAt: list selectedIndex to: 1 ]. - bottomButton - action: [ self moveElementAt: list selectedIndex to: list listItems size ]. - upButton - action: [ self moveElementAt: list selectedIndex to: list selectedIndex - 1]. - downButton - action: [ self moveElementAt: list selectedIndex to: list selectedIndex + 1]. - -] - -{ #category : #accessing } -SpEditableList >> downButton [ - ^ downButton -] - -{ #category : #initialization } -SpEditableList >> initialize [ - super initialize. - title := 'Title'. - okBlock := [ ] -] - -{ #category : #initialization } -SpEditableList >> initializeDialogWindow: aWindow [ - - aWindow - addButton: 'Ok' - do: [ :presenter | - self performOkAction. - presenter close ] -] - -{ #category : #initialization } -SpEditableList >> initializePresenters [ - list := self newList. - addButton := self newButton. - removeButton := self newButton. - upButton := self newButton. - downButton := self newButton. - topButton := self newButton. - bottomButton := self newButton. - addButton - icon: (self iconNamed: #addIcon); - help: 'Add a new item to the list'. - removeButton - icon: (self iconNamed: #deleteIcon); - help: 'Remove a item from the list'. - upButton - icon: (self iconNamed: #upIcon); - help: 'Move this item up from one element'. - downButton - icon: (self iconNamed: #downIcon); - help: 'Move this item down from one element'. - topButton - icon: (self iconNamed: #topIcon); - help: 'Move this item on the first position of the list'. - bottomButton - icon: (self iconNamed: #bottomIcon); - help: 'Move this item on the last position of the list' -] - -{ #category : #accessing } -SpEditableList >> list [ - ^ list -] - -{ #category : #private } -SpEditableList >> list: aList [ - list items: aList. -] - -{ #category : #private } -SpEditableList >> moveElementAt: index to: newIndex [ - | elementToMove orderedList | - (newIndex < 1 or: [ newIndex > list items size ]) - ifTrue: [ ^ self ]. - elementToMove := list itemAt: index. - orderedList := list items copy asOrderedCollection - removeAt: index; - add: elementToMove beforeIndex: newIndex; - yourself. - self list: orderedList. - self list selectIndex: newIndex -] - -{ #category : #api } -SpEditableList >> okAction: aBlock [ - - okBlock := aBlock -] - -{ #category : #private } -SpEditableList >> performOkAction [ - - okBlock value -] - -{ #category : #accessing } -SpEditableList >> removeButton [ - ^ removeButton -] - -{ #category : #accessing } -SpEditableList >> title [ - ^ title -] - -{ #category : #accessing } -SpEditableList >> title: aTitle [ - title := aTitle -] - -{ #category : #accessing } -SpEditableList >> topButton [ - ^ topButton -] - -{ #category : #accessing } -SpEditableList >> upButton [ - ^ upButton -] diff --git a/src/Spec2-Core/SpEditableListPresenter.class.st b/src/Spec2-Core/SpEditableListPresenter.class.st new file mode 100644 index 00000000000..f098297c97e --- /dev/null +++ b/src/Spec2-Core/SpEditableListPresenter.class.st @@ -0,0 +1,292 @@ +" +This widget allows you to edit a list of items : +- add / remove an item to/from the list +- order the list by moving elements up/down/top/bottom. + +The default behavior is to work directly on the model collection. It means the collection has to support #add:, #remove: methods (e.g. OrderedCollection). +If you prefer, you can do a copy of the list and give the copy to the EditableList. It will allow the user to accept / reject changes (for example by opening the widget in a DialogWindow) before affecting the original list. If you use a copy of your collection, then it is your responsability to copy EditableList items back to the original list. + +The addItemBlock is used to provide a way to give the item to add (e.g. a UIManager default chooseFrom: values:). + +Example: +self example +" +Class { + #name : #SpEditableListPresenter, + #superclass : #SpPresenter, + #instVars : [ + 'title', + 'list', + 'addButton', + 'removeButton', + 'upButton', + 'downButton', + 'topButton', + 'bottomButton', + 'addItemBlock', + 'okBlock', + 'label', + 'removeItemBlock' + ], + #category : #'Spec2-Core-Widgets' +} + +{ #category : #spec } +SpEditableListPresenter class >> defaultSpec [ + ^ SpBoxLayout newVertical + add: + (SpBoxLayout newHorizontal + addLast: #addButton expand: false; + addLast: #removeButton expand: false; + yourself) + expand: false; + add: + (SpBoxLayout newHorizontal + add: #list; + add: + (SpBoxLayout newVertical + add: #topButton expand: false fill: false padding: 0; + add: #upButton expand: false fill: false padding: 0; + add: #downButton expand: false fill: false padding: 0; + add: #bottomButton expand: false fill: false padding: 0; + yourself) + expand: false; + yourself); + yourself +] + +{ #category : #'instance creation' } +SpEditableListPresenter class >> new: aCollection [ + ^ self new items: aCollection. + +] + +{ #category : #spec } +SpEditableListPresenter class >> withoutOrderingBar [ + ^ SpBoxLayout newVertical + add: + (SpBoxLayout newHorizontal + addLast: #addButton expand: false; + addLast: #removeButton expand: false; + yourself) + expand: false; + add: #list; + yourself +] + +{ #category : #accessing } +SpEditableListPresenter >> addButton [ + ^ addButton +] + +{ #category : #api } +SpEditableListPresenter >> addItemBlock: aBlock [ + addItemBlock := aBlock. +] + +{ #category : #accessing } +SpEditableListPresenter >> bottomButton [ + ^ bottomButton +] + +{ #category : #initialization } +SpEditableListPresenter >> connectPresenters [ + super connectPresenters. + addButton action: [ + | newItem | + newItem := addItemBlock value. + newItem ifNotNil: [ + self items add: newItem. + self refresh. ] ]. + removeButton + action: [ removeItemBlock cull: self selectedItem ]. + topButton action: [ self moveElementAt: self selectedIndex to: 1 ]. + bottomButton action: [ + self moveElementAt: self selectedIndex to: self items size ]. + upButton action: [ + self moveElementAt: self selectedIndex to: self selectedIndex - 1 ]. + downButton action: [ + self moveElementAt: self selectedIndex to: self selectedIndex + 1 ] +] + +{ #category : #api } +SpEditableListPresenter >> display: aBlock [ + + list display: aBlock +] + +{ #category : #accessing } +SpEditableListPresenter >> downButton [ + ^ downButton +] + +{ #category : #initialization } +SpEditableListPresenter >> initialize [ + super initialize. + title := 'Title'. + okBlock := [ ]. + removeItemBlock := [ :item | + self items remove: item. + self refresh. ] +] + +{ #category : #initialization } +SpEditableListPresenter >> initializeDialogWindow: aWindow [ + + aWindow + addButton: 'Ok' + do: [ :presenter | + self performOkAction. + presenter close ] +] + +{ #category : #initialization } +SpEditableListPresenter >> initializePresenters [ + label := self newLabel. + list := self newList. + addButton := self newButton. + removeButton := self newButton. + upButton := self newButton. + downButton := self newButton. + topButton := self newButton. + bottomButton := self newButton. + addButton + addStyle: 'small'; + icon: (self iconNamed: #addIcon); + help: 'Add a new item to the list'. + removeButton + addStyle: 'small'; + icon: (self iconNamed: #removeIcon); + help: 'Remove a item from the list'. + upButton + addStyle: 'small'; + icon: (self iconNamed: #upIcon); + help: 'Move this item up from one element'. + downButton + addStyle: 'small'; + icon: (self iconNamed: #downIcon); + help: 'Move this item down from one element'. + topButton + addStyle: 'small'; + icon: (self iconNamed: #topIcon); + help: 'Move this item on the first position of the list'. + bottomButton + addStyle: 'small'; + icon: (self iconNamed: #bottomIcon); + help: 'Move this item on the last position of the list' +] + +{ #category : #initialization } +SpEditableListPresenter >> initializeWindow: aWindowPresenter [ + aWindowPresenter title: self title +] + +{ #category : #accessing } +SpEditableListPresenter >> items [ + ^ list model items +] + +{ #category : #private } +SpEditableListPresenter >> items: anItemList [ + list items: anItemList. +] + +{ #category : #accessing } +SpEditableListPresenter >> label: aString [ + label label: aString +] + +{ #category : #accessing } +SpEditableListPresenter >> list [ + ^ list +] + +{ #category : #private } +SpEditableListPresenter >> moveElementAt: index to: newIndex [ + "WARNING: this method can only be used if the model is an OrderedCollection" + | elementToMove | + + (newIndex between: 1 and: self items size) + ifFalse: [ ^ self ]. + + elementToMove := list itemAt: index. + self items + remove: elementToMove; + add: elementToMove beforeIndex: newIndex. + + self refresh. + self list selectIndex: newIndex +] + +{ #category : #api } +SpEditableListPresenter >> okAction: aBlock [ + + okBlock := aBlock +] + +{ #category : #private } +SpEditableListPresenter >> performOkAction [ + + okBlock value +] + +{ #category : #api } +SpEditableListPresenter >> refresh [ + self items: self items +] + +{ #category : #accessing } +SpEditableListPresenter >> removeButton [ + ^ removeButton +] + +{ #category : #api } +SpEditableListPresenter >> removeItem: anObject [ + self items remove: anObject. + list selection unselectAll +] + +{ #category : #api } +SpEditableListPresenter >> removeItemBlock: aBlock [ + removeItemBlock := aBlock. +] + +{ #category : #api } +SpEditableListPresenter >> selectItem: anIndex [ + list selectItem: anIndex +] + +{ #category : #api } +SpEditableListPresenter >> selectedIndex [ + ^ list selection selectedIndex +] + +{ #category : #api } +SpEditableListPresenter >> selectedItem [ + ^ list selection selectedItem +] + +{ #category : #accessing } +SpEditableListPresenter >> title [ + ^ title +] + +{ #category : #accessing } +SpEditableListPresenter >> title: aTitle [ + title := aTitle +] + +{ #category : #accessing } +SpEditableListPresenter >> topButton [ + ^ topButton +] + +{ #category : #accessing } +SpEditableListPresenter >> upButton [ + ^ upButton +] + +{ #category : #api } +SpEditableListPresenter >> whenSelectionChangedDo: aBlockClosure [ + list whenSelectionChangedDo: aBlockClosure +] diff --git a/src/Spec2-Core/SpListPresenter.class.st b/src/Spec2-Core/SpListPresenter.class.st index 13e0aae6551..317f9552204 100644 --- a/src/Spec2-Core/SpListPresenter.class.st +++ b/src/Spec2-Core/SpListPresenter.class.st @@ -41,6 +41,8 @@ todo Class { #name : #SpListPresenter, #superclass : #SpAbstractListPresenter, + #traits : 'SpTSearchable', + #classTraits : 'SpTSearchable classTrait', #instVars : [ '#allowToSelect => SpObservableSlot', '#autoDeselect => SpObservableSlot', @@ -168,7 +170,9 @@ SpListPresenter >> icons: aBlock [ { #category : #initialization } SpListPresenter >> initialize [ + super initialize. + self initializeTSearchable. autoDeselect := true. allowToSelect := true. display := [ :object | object asStringOrText ] diff --git a/src/Spec2-Core/SpMultipleSelectionMode.class.st b/src/Spec2-Core/SpMultipleSelectionMode.class.st index ef76249f921..c85874735e7 100644 --- a/src/Spec2-Core/SpMultipleSelectionMode.class.st +++ b/src/Spec2-Core/SpMultipleSelectionMode.class.st @@ -1,3 +1,6 @@ +" +I implement multiple selection mode (my users can select multiple element of list or table) +" Class { #name : #SpMultipleSelectionMode, #superclass : #SpAbstractSelectionMode, diff --git a/src/Spec2-Core/SpNotebookPage.class.st b/src/Spec2-Core/SpNotebookPage.class.st index 35d91d30381..94d338fde3a 100644 --- a/src/Spec2-Core/SpNotebookPage.class.st +++ b/src/Spec2-Core/SpNotebookPage.class.st @@ -7,8 +7,8 @@ In particular, I contain a presenterProvider, a block who's responsibility is to Class { #name : #SpNotebookPage, #superclass : #Object, - #traits : 'TSpObservable', - #classTraits : 'TSpObservable classTrait', + #traits : 'SpTObservable', + #classTraits : 'SpTObservable classTrait', #instVars : [ '#owner', '#title => SpObservableSlot', diff --git a/src/Spec2-Core/SpPresenter.class.st b/src/Spec2-Core/SpPresenter.class.st index 79ec7039ac5..e208b0f0cb6 100644 --- a/src/Spec2-Core/SpPresenter.class.st +++ b/src/Spec2-Core/SpPresenter.class.st @@ -412,9 +412,10 @@ SpPresenter >> defaultWindowPresenterClass [ ^ SpWindowPresenter ] -{ #category : #'as yet unclassified' } -SpPresenter >> defer: aBlockClosure [ - self application defer: aBlockClosure +{ #category : #accessing } +SpPresenter >> defer: aBlock [ + + self application defer: aBlock ] { #category : #private } @@ -846,6 +847,12 @@ SpPresenter >> newTextInput [ ^ self instantiate: SpTextInputFieldPresenter ] +{ #category : #widgets } +SpPresenter >> newToggleButton [ + + ^ self instantiate: SpToggleButtonPresenter +] + { #category : #widgets } SpPresenter >> newToolBar [ diff --git a/src/Spec2-Core/SpProgressBarFixed.class.st b/src/Spec2-Core/SpProgressBarFixed.class.st index c96e8daada7..56ad6a04cca 100644 --- a/src/Spec2-Core/SpProgressBarFixed.class.st +++ b/src/Spec2-Core/SpProgressBarFixed.class.st @@ -19,8 +19,8 @@ Internal Representation and Key Implementation Points. Class { #name : #SpProgressBarFixed, #superclass : #SpProgressBarState, - #traits : 'TSpObservable', - #classTraits : 'TSpObservable classTrait', + #traits : 'SpTObservable', + #classTraits : 'SpTObservable classTrait', #instVars : [ '#value => SpObservableSlot' ], diff --git a/src/Spec2-Core/SpProgressBarProgressing.class.st b/src/Spec2-Core/SpProgressBarProgressing.class.st index c83978c5cda..17a49434307 100644 --- a/src/Spec2-Core/SpProgressBarProgressing.class.st +++ b/src/Spec2-Core/SpProgressBarProgressing.class.st @@ -23,8 +23,8 @@ Internal Representation and Key Implementation Points. Class { #name : #SpProgressBarProgressing, #superclass : #SpProgressBarState, - #traits : 'TSpObservable', - #classTraits : 'TSpObservable classTrait', + #traits : 'SpTObservable', + #classTraits : 'SpTObservable classTrait', #instVars : [ '#refreshDelay', '#progression', diff --git a/src/Spec2-Core/SpRadioButtonPresenter.class.st b/src/Spec2-Core/SpRadioButtonPresenter.class.st index f73b62990c2..b235f09a976 100644 --- a/src/Spec2-Core/SpRadioButtonPresenter.class.st +++ b/src/Spec2-Core/SpRadioButtonPresenter.class.st @@ -22,7 +22,8 @@ Class { #name : #SpRadioButtonPresenter, #superclass : #SpAbstractFormButtonPresenter, #instVars : [ - 'associatedRadioButtons' + 'associatedRadioButtons', + 'initialStateSet' ], #category : #'Spec2-Core-Widgets' } @@ -46,14 +47,15 @@ SpRadioButtonPresenter >> associatedRadioButtons [ { #category : #'associated buttons' } SpRadioButtonPresenter >> associatedRadioButtons: aCollection [ - | allElements | - - allElements := { self } , aCollection. - allElements do: [ :e | e basicAssociatedRadioButtons: allElements ]. - self state: true. - aCollection do: [ :e | e state: false ] + "pass group to all members" + allElements := { self }, aCollection. + allElements do: [ :each | + each basicAssociatedRadioButtons: allElements ]. + + "self state: true." + aCollection do: [ :each | each state: false ] ] { #category : #private } @@ -62,18 +64,35 @@ SpRadioButtonPresenter >> basicAssociatedRadioButtons: aCollection [ associatedRadioButtons := aCollection copyWithout: self ] +{ #category : #accessing } +SpRadioButtonPresenter >> initialStateNotSet [ + "Setting this value to the first radio button will cause the entire group to be unset + on first display. This will be ignored if sent to other than the own containing the + associated buttons" + + initialStateSet := false +] + { #category : #initialization } SpRadioButtonPresenter >> initialize [ super initialize. state := true. + initialStateSet := true. associatedRadioButtons := #() ] +{ #category : #testing } +SpRadioButtonPresenter >> isInitialStateSet [ + + ^ initialStateSet +] + { #category : #accessing } SpRadioButtonPresenter >> state: aValue [ - (associatedRadioButtons noneSatisfy: [ :e | e state ]) + (aValue not + and: [ associatedRadioButtons noneSatisfy: [ :e | e state ] ]) ifTrue: [ "If I am the only one in true, I cannot be unselected" ^ self ]. @@ -82,5 +101,5 @@ SpRadioButtonPresenter >> state: aValue [ aValue ifTrue: [ associatedRadioButtons - do: [ :e | e state: false ]]. + do: [ :e | e state: false ] ]. ] diff --git a/src/Spec2-Core/SpSingleSelectionMode.class.st b/src/Spec2-Core/SpSingleSelectionMode.class.st index b17077d6190..eafce2a9a5c 100644 --- a/src/Spec2-Core/SpSingleSelectionMode.class.st +++ b/src/Spec2-Core/SpSingleSelectionMode.class.st @@ -1,3 +1,6 @@ +" +I implement single selection mode (my users can select just one element of list or table) +" Class { #name : #SpSingleSelectionMode, #superclass : #SpAbstractSelectionMode, diff --git a/src/Spec2-Core/TSpDynamicPresenter.trait.st b/src/Spec2-Core/SpTDynamicPresenter.trait.st similarity index 70% rename from src/Spec2-Core/TSpDynamicPresenter.trait.st rename to src/Spec2-Core/SpTDynamicPresenter.trait.st index e6ee10e324d..1ba075b271d 100644 --- a/src/Spec2-Core/TSpDynamicPresenter.trait.st +++ b/src/Spec2-Core/SpTDynamicPresenter.trait.st @@ -3,7 +3,7 @@ I'm a trait that add ""dynamic"" behavior to presenters. I can be used to create components that may have variable number of children. " Trait { - #name : #TSpDynamicPresenter, + #name : #SpTDynamicPresenter, #instVars : [ 'presenters' ], @@ -11,19 +11,19 @@ Trait { } { #category : #'private accessing' } -TSpDynamicPresenter >> basicPresenters [ +SpTDynamicPresenter >> basicPresenters [ ^ presenters ifNil: [ presenters := OrderedDictionary new ] ] { #category : #accessing } -TSpDynamicPresenter >> presenterAt: aName [ +SpTDynamicPresenter >> presenterAt: aName [ ^ self basicPresenters at: aName ] { #category : #accessing } -TSpDynamicPresenter >> presenterAt: aName ifAbsent: aBlock [ +SpTDynamicPresenter >> presenterAt: aName ifAbsent: aBlock [ ^ self basicPresenters at: aName ifAbsent: [ [ self readSlotNamed: aName ] @@ -32,7 +32,7 @@ TSpDynamicPresenter >> presenterAt: aName ifAbsent: aBlock [ ] { #category : #accessing } -TSpDynamicPresenter >> presenterAt: aName put: aPresenter [ +SpTDynamicPresenter >> presenterAt: aName put: aPresenter [ ^ self basicPresenters at: aName @@ -40,13 +40,13 @@ TSpDynamicPresenter >> presenterAt: aName put: aPresenter [ ] { #category : #accessing } -TSpDynamicPresenter >> presenters [ +SpTDynamicPresenter >> presenters [ ^ self basicPresenters values ] { #category : #enumerating } -TSpDynamicPresenter >> presentersDo: aBlock [ +SpTDynamicPresenter >> presentersDo: aBlock [ self basicPresenters valuesDo: aBlock ] diff --git a/src/Spec2-Core/TSpHaveWrappingScrollBars.trait.st b/src/Spec2-Core/SpTHaveWrappingScrollBars.trait.st similarity index 91% rename from src/Spec2-Core/TSpHaveWrappingScrollBars.trait.st rename to src/Spec2-Core/SpTHaveWrappingScrollBars.trait.st index 015dc77eaaa..e00dba5f253 100644 --- a/src/Spec2-Core/TSpHaveWrappingScrollBars.trait.st +++ b/src/Spec2-Core/SpTHaveWrappingScrollBars.trait.st @@ -9,7 +9,7 @@ if your backend of choice supports it. THIS CANNOT BE CHANGED ONCE THE WIDGET IS CREATED. " Trait { - #name : #TSpHaveWrappingScrollBars, + #name : #SpTHaveWrappingScrollBars, #instVars : [ 'wrapScrollBars' ], @@ -17,7 +17,7 @@ Trait { } { #category : #testing } -TSpHaveWrappingScrollBars >> hasScrollBars [ +SpTHaveWrappingScrollBars >> hasScrollBars [ "Some backends like Morphic forces the scrollbars in their Tables and Lists. But some others like Gtk3 don't. This option allows you to configure the precence of scrollbars for platforms who do not have them automatically. @@ -29,7 +29,7 @@ TSpHaveWrappingScrollBars >> hasScrollBars [ ] { #category : #accessing } -TSpHaveWrappingScrollBars >> withScrollBars [ +SpTHaveWrappingScrollBars >> withScrollBars [ "Some backends like Morphic forces the scrollbars in their Tables and Lists. But some others like Gtk3 don't. This option allows you to configure the precence of scrollbars for platforms who do not have them automatically. @@ -41,7 +41,7 @@ TSpHaveWrappingScrollBars >> withScrollBars [ ] { #category : #accessing } -TSpHaveWrappingScrollBars >> withoutScrollBars [ +SpTHaveWrappingScrollBars >> withoutScrollBars [ "Some backends like Morphic forces the scrollbars in their Tables and Lists. But some others like Gtk3 don't. This option allows you to configure the precence of scrollbars for platforms who do not have them automatically. diff --git a/src/Spec2-Core/SpTSearchable.trait.st b/src/Spec2-Core/SpTSearchable.trait.st new file mode 100644 index 00000000000..8f457e7f537 --- /dev/null +++ b/src/Spec2-Core/SpTSearchable.trait.st @@ -0,0 +1,90 @@ +" +I add search capability to lists/tables and trees. +I implement basic common API but real implementation (as always) needs to be done in the backend adapters. +" +Trait { + #name : #SpTSearchable, + #instVars : [ + '#searchEnabled => SpObservableSlot', + '#searchBlock' + ], + #category : #'Spec2-Core-Widgets-Table' +} + +{ #category : #accessing } +SpTSearchable >> disableSearch [ + + searchEnabled := false +] + +{ #category : #accessing } +SpTSearchable >> enableSearch [ + + searchEnabled := true +] + +{ #category : #testing } +SpTSearchable >> hasCustomSearch [ + + ^ searchBlock notNil +] + +{ #category : #initialization } +SpTSearchable >> initialize [ + + self class initializeSlots: self. + super initialize. + self initializeTSearchable +] + +{ #category : #initialization } +SpTSearchable >> initializeTSearchable [ + + self searchMatching: [ :item :pattern | + self performDefaultSearch: item matching: pattern ]. +] + +{ #category : #testing } +SpTSearchable >> isSearchEnabled [ + + ^ searchEnabled +] + +{ #category : #private } +SpTSearchable >> performDefaultSearch: item matching: pattern [ + | text | + + text := (self searchValueOf: item) trimBoth asLowercase. + ^ text beginsWith: pattern +] + +{ #category : #private } +SpTSearchable >> performSearch: item matching: pattern [ + + ^ searchBlock + value: item + value: pattern +] + +{ #category : #accessing } +SpTSearchable >> searchMatching: aBlock [ + "Defines a block to perform a search on the model objects. + The block receives two parameters: + - item (the model element) + - pattern (the string to match)" + + searchBlock := aBlock. + self enableSearch +] + +{ #category : #private } +SpTSearchable >> searchValueOf: item [ + + ^ self displayValueOf: item +] + +{ #category : #'api-events' } +SpTSearchable >> whenSearchChangedDo: aBlock [ + + self property: #searchEnabled whenChangedDo: aBlock +] diff --git a/src/Spec2-Core/SpTablePresenter.class.st b/src/Spec2-Core/SpTablePresenter.class.st index 848fb97e46e..4d4f3577d5c 100644 --- a/src/Spec2-Core/SpTablePresenter.class.st +++ b/src/Spec2-Core/SpTablePresenter.class.st @@ -8,6 +8,8 @@ self example Class { #name : #SpTablePresenter, #superclass : #SpAbstractListPresenter, + #traits : 'SpTSearchable', + #classTraits : 'SpTSearchable classTrait', #instVars : [ '#columns => SpObservableSlot', '#showColumnHeaders => SpObservableSlot', @@ -66,6 +68,7 @@ SpTablePresenter >> hideColumnHeaders [ SpTablePresenter >> initialize [ super initialize. + self initializeTSearchable. showColumnHeaders := true. columns := #(). isResizable := false @@ -87,6 +90,12 @@ SpTablePresenter >> isShowingColumnHeaders [ ^ showColumnHeaders ] +{ #category : #private } +SpTablePresenter >> searchValueOf: anObject [ + + ^ anObject asString +] + { #category : #api } SpTablePresenter >> showColumnHeaders [ diff --git a/src/Spec2-Core/SpTextPresenter.class.st b/src/Spec2-Core/SpTextPresenter.class.st index a253c27960b..44da1cc4505 100644 --- a/src/Spec2-Core/SpTextPresenter.class.st +++ b/src/Spec2-Core/SpTextPresenter.class.st @@ -20,8 +20,8 @@ I provide the following methods Class { #name : #SpTextPresenter, #superclass : #SpAbstractTextPresenter, - #traits : 'TSpHaveWrappingScrollBars', - #classTraits : 'TSpHaveWrappingScrollBars classTrait', + #traits : 'SpTHaveWrappingScrollBars', + #classTraits : 'SpTHaveWrappingScrollBars classTrait', #instVars : [ '#scrollValue => SpObservableSlot' ], diff --git a/src/Spec2-Core/SpTimeline.class.st b/src/Spec2-Core/SpTimeline.class.st index e240e219571..9c11bd869d9 100644 --- a/src/Spec2-Core/SpTimeline.class.st +++ b/src/Spec2-Core/SpTimeline.class.st @@ -1,8 +1,8 @@ Class { #name : #SpTimeline, #superclass : #Object, - #traits : 'TSpObservable', - #classTraits : 'TSpObservable classTrait', + #traits : 'SpTObservable', + #classTraits : 'SpTObservable classTrait', #instVars : [ '#ticks => SpObservableSlot', '#highestValue', diff --git a/src/Spec2-Core/SpToggleButtonPresenter.class.st b/src/Spec2-Core/SpToggleButtonPresenter.class.st index 0b271c50c5c..3b60ba3282c 100644 --- a/src/Spec2-Core/SpToggleButtonPresenter.class.st +++ b/src/Spec2-Core/SpToggleButtonPresenter.class.st @@ -2,7 +2,8 @@ Class { #name : #SpToggleButtonPresenter, #superclass : #SpAbstractFormButtonPresenter, #instVars : [ - '#action => SpObservableSlot' + '#action => SpObservableSlot', + '#icon => SpObservableSlot' ], #category : #'Spec2-Core-Widgets' } @@ -28,12 +29,30 @@ SpToggleButtonPresenter >> action [ { #category : #initialization } SpToggleButtonPresenter >> action: aBlock [ - ^ action := aBlock + action := aBlock +] + +{ #category : #accessing } +SpToggleButtonPresenter >> icon [ + + ^ icon +] + +{ #category : #accessing } +SpToggleButtonPresenter >> icon: anIcon [ + + icon := anIcon ] { #category : #initialization } SpToggleButtonPresenter >> initialize [ super initialize. - action := [ ] + action := [ ] +] + +{ #category : #'api-events' } +SpToggleButtonPresenter >> whenIconChangedDo: aBlock [ + + self property: #icon whenChangedDo: aBlock ] diff --git a/src/Spec2-Core/SpToolBarButtonMorph.class.st b/src/Spec2-Core/SpToolBarButtonMorph.class.st index 962d7cd0868..c100f05aa2d 100644 --- a/src/Spec2-Core/SpToolBarButtonMorph.class.st +++ b/src/Spec2-Core/SpToolBarButtonMorph.class.st @@ -37,6 +37,11 @@ SpToolBarButtonMorph >> badgeTextColor [ ^ self theme badgeTextColor ] +{ #category : #configuring } +SpToolBarButtonMorph >> configureWith: displayModel item: itemPresenter [ + displayModel configureButton: self item: itemPresenter +] + { #category : #accessing } SpToolBarButtonMorph >> drawBadgeOn: aCanvas [ | badgeString badgeBounds textBounds textWidth textHeight width | diff --git a/src/Spec2-Core/SpToolBarDisplayMode.class.st b/src/Spec2-Core/SpToolBarDisplayMode.class.st index f2ce60a7a93..8630b71a129 100644 --- a/src/Spec2-Core/SpToolBarDisplayMode.class.st +++ b/src/Spec2-Core/SpToolBarDisplayMode.class.st @@ -48,6 +48,16 @@ SpToolBarDisplayMode >> configureButton: aButton item: aToolbarItem [ self subclassResponsibility ] +{ #category : #configuring } +SpToolBarDisplayMode >> configureDropList: aSpDropListMorph item: aSpDropListPresenter [ + self flag: 'TODO: maybe customize the drop list to have a better look''n feel'. +] + +{ #category : #configuring } +SpToolBarDisplayMode >> configureMorph: aMorph item: itemPresenter [ + aMorph configureWith: self item: itemPresenter +] + { #category : #accessing } SpToolBarDisplayMode >> extent [ ^ self subclassResponsibility diff --git a/src/Spec2-Core/SpTreeMultipleSelectionMode.class.st b/src/Spec2-Core/SpTreeMultipleSelectionMode.class.st index 4db5dbcf09d..585fc2fd7a3 100644 --- a/src/Spec2-Core/SpTreeMultipleSelectionMode.class.st +++ b/src/Spec2-Core/SpTreeMultipleSelectionMode.class.st @@ -1,9 +1,29 @@ Class { #name : #SpTreeMultipleSelectionMode, - #superclass : #SpAbstractTreeSingleSelectionMode, + #superclass : #SpAbstractTreeSelectionMode, #category : #'Spec2-Core-Widgets-Tree' } +{ #category : #testing } +SpTreeMultipleSelectionMode >> includesItem: anItem [ + ^ self selectedItems includes: anItem +] + +{ #category : #testing } +SpTreeMultipleSelectionMode >> includesItems: anItemList [ + ^ self selectedItems includesAll: anItemList +] + +{ #category : #testing } +SpTreeMultipleSelectionMode >> includesPath: aPath [ + ^ selection includes: aPath +] + +{ #category : #testing } +SpTreeMultipleSelectionMode >> includesPaths: aListOfPaths [ + ^ selection includesAll: aListOfPaths +] + { #category : #testing } SpTreeMultipleSelectionMode >> isMultipleSelection [ @@ -12,6 +32,7 @@ SpTreeMultipleSelectionMode >> isMultipleSelection [ { #category : #selection } SpTreeMultipleSelectionMode >> selectPath: aPath [ + "Check comment in my superclass to know how to use selectPath:" aPath ifEmpty: [ ^ self unselectAll ]. (selection includes: aPath) ifTrue: [ ^ self ]. @@ -22,25 +43,29 @@ SpTreeMultipleSelectionMode >> selectPath: aPath [ { #category : #selection } SpTreeMultipleSelectionMode >> selectPaths: pathArray [ - (pathArray isEmpty or: [ pathArray size = 1 and: [ pathArray first isEmpty] ]) ifTrue: [ ^ self unselectAll ]. - pathArray do: [ :path | - presenter itemAtPath: path ifAbsent: [ ^ self ] ]. + + pathArray + do: [ :path | presenter itemAtPath: path ifAbsent: [ ^ self ] ]. + selection = pathArray ifTrue: [ ^ self ]. + selection := pathArray ] { #category : #accessing } SpTreeMultipleSelectionMode >> selectedItem [ - self shouldBeImplemented. + ^ self selectedPaths + ifEmpty: [ #() ] + ifNotEmpty: [ :paths | presenter itemAtPath: paths first ] ] { #category : #accessing } SpTreeMultipleSelectionMode >> selectedItems [ - selection ifEmpty: [ ^ nil ]. + selection ifEmpty: [ ^ #() ]. ^ selection collect: [ :path | presenter itemAtPath: path ] ] @@ -48,3 +73,8 @@ SpTreeMultipleSelectionMode >> selectedItems [ SpTreeMultipleSelectionMode >> selectedPaths [ ^ selection ] + +{ #category : #selection } +SpTreeMultipleSelectionMode >> unselectPath: aPath [ + self selectPaths: (self selectedPaths copyWithout: aPath) +] diff --git a/src/Spec2-Core/SpTreeSingleSelectionMode.class.st b/src/Spec2-Core/SpTreeSingleSelectionMode.class.st index 70a171fca31..b9482e8ea02 100644 --- a/src/Spec2-Core/SpTreeSingleSelectionMode.class.st +++ b/src/Spec2-Core/SpTreeSingleSelectionMode.class.st @@ -1,16 +1,30 @@ Class { #name : #SpTreeSingleSelectionMode, - #superclass : #SpAbstractTreeSingleSelectionMode, + #superclass : #SpAbstractTreeSelectionMode, #category : #'Spec2-Core-Widgets-Tree' } +{ #category : #selection } +SpTreeSingleSelectionMode >> clearSelection [ + + selection := #() +] + +{ #category : #selection } +SpTreeSingleSelectionMode >> itemNotFoundAction [ + self clearSelection +] + { #category : #accessing } SpTreeSingleSelectionMode >> selectPath: aPath [ - "If the path is out of range, keep the selection." + "Check comment in my superclass to know how to use selectPath:" + "If the path is out of range, keep the selection." aPath ifEmpty: [ ^ self unselectAll ]. - presenter itemAtPath: aPath ifAbsent: [ ^ self ]. - selection := aPath + presenter + itemAtPath: aPath + ifAbsent: [ ^ self ]. + selection := aPath. ] @@ -41,7 +55,7 @@ SpTreeSingleSelectionMode >> selectedPaths [ ^ { selection } ] -{ #category : #accessing } +{ #category : #selecting } SpTreeSingleSelectionMode >> unselectPath: aPath [ "If the path is out of range, keep the selection." selection = aPath ifFalse: [ ^ self ]. diff --git a/src/Spec2-Core/SpTreeTablePresenter.class.st b/src/Spec2-Core/SpTreeTablePresenter.class.st index 3871c7a269e..b381a50fe63 100644 --- a/src/Spec2-Core/SpTreeTablePresenter.class.st +++ b/src/Spec2-Core/SpTreeTablePresenter.class.st @@ -9,8 +9,8 @@ self example Class { #name : #SpTreeTablePresenter, #superclass : #SpAbstractWidgetPresenter, - #traits : 'TSpHaveWrappingScrollBars + SpTContextMenu', - #classTraits : 'TSpHaveWrappingScrollBars classTrait + SpTContextMenu classTrait', + #traits : 'SpTHaveWrappingScrollBars + SpTContextMenu + SpTSearchable', + #classTraits : 'SpTHaveWrappingScrollBars classTrait + SpTContextMenu classTrait + SpTSearchable classTrait', #instVars : [ '#columns => SpObservableSlot', '#showColumnHeaders => SpObservableSlot', @@ -147,6 +147,7 @@ SpTreeTablePresenter >> hideColumnHeaders [ { #category : #initialization } SpTreeTablePresenter >> initialize [ super initialize. + self initializeTSearchable. self withScrollBars. @@ -231,6 +232,24 @@ SpTreeTablePresenter >> roots: aCollection [ self selection clearSelection ] +{ #category : #private } +SpTreeTablePresenter >> searchValueOf: item [ + + ^ item asString +] + +{ #category : #api } +SpTreeTablePresenter >> selectItem: anItem [ + + self selection selectItem: anItem +] + +{ #category : #api } +SpTreeTablePresenter >> selectItems: aListOfItem [ + + self selection selectItems: aListOfItem +] + { #category : #api } SpTreeTablePresenter >> selectPath: aPath [ @@ -248,6 +267,12 @@ SpTreeTablePresenter >> selectedItem [ ^ self selection selectedItem ] +{ #category : #api } +SpTreeTablePresenter >> selectedItems [ + + ^ self selection selectedItems +] + { #category : #accessing } SpTreeTablePresenter >> selection [ @@ -274,6 +299,12 @@ SpTreeTablePresenter >> unselectAll [ self selection unselectAll ] +{ #category : #api } +SpTreeTablePresenter >> unselectItem: anItem [ + + self selection unselectItem: anItem +] + { #category : #api } SpTreeTablePresenter >> unselectPath: aPath [ diff --git a/src/Spec2-Core/SpVersatileDialogPresenter.class.st b/src/Spec2-Core/SpVersatileDialogPresenter.class.st index 28c6e2dfed8..f1b3867f196 100644 --- a/src/Spec2-Core/SpVersatileDialogPresenter.class.st +++ b/src/Spec2-Core/SpVersatileDialogPresenter.class.st @@ -18,8 +18,8 @@ I have: Class { #name : #SpVersatileDialogPresenter, #superclass : #SpDynamicPresenter, - #traits : 'TSpDynamicPresenter', - #classTraits : 'TSpDynamicPresenter classTrait', + #traits : 'SpTDynamicPresenter', + #classTraits : 'SpTDynamicPresenter classTrait', #instVars : [ 'mainMessage', 'mainIcon', diff --git a/src/Spec2-Core/SpVerticalAlignment.class.st b/src/Spec2-Core/SpVerticalAlignment.class.st index 5b5c04b17eb..42bac0be155 100644 --- a/src/Spec2-Core/SpVerticalAlignment.class.st +++ b/src/Spec2-Core/SpVerticalAlignment.class.st @@ -1,8 +1,8 @@ Class { #name : #SpVerticalAlignment, #superclass : #SpAbstractPresenter, - #traits : 'TSpObservable', - #classTraits : 'TSpObservable classTrait', + #traits : 'SpTObservable', + #classTraits : 'SpTObservable classTrait', #instVars : [ '#firstVisibleRowIndex', '#lastVisibleRowIndex', diff --git a/src/Spec2-Core/SpWindowPresenter.class.st b/src/Spec2-Core/SpWindowPresenter.class.st index 2e0d08bcaa8..ddca97e5b90 100644 --- a/src/Spec2-Core/SpWindowPresenter.class.st +++ b/src/Spec2-Core/SpWindowPresenter.class.st @@ -141,6 +141,12 @@ SpWindowPresenter >> basicBuildWithSpecLayout: presenterSpecLayout [ ^ widget ] +{ #category : #api } +SpWindowPresenter >> beep [ + + self adapter beep +] + { #category : #'private building' } SpWindowPresenter >> buildWindowWithLayout: windowSpecLayout presenterLayout: presenterSpecLayout [ diff --git a/src/Spec2-Deprecated/SpAbstractTwoButtonsTest.class.st b/src/Spec2-Deprecated/SpAbstractTwoButtonsTest.class.st index e99e3d44e96..0ebf371d6b9 100644 --- a/src/Spec2-Deprecated/SpAbstractTwoButtonsTest.class.st +++ b/src/Spec2-Deprecated/SpAbstractTwoButtonsTest.class.st @@ -31,8 +31,8 @@ SpAbstractTwoButtonsTest >> testFirstActionSecondAction [ { #category : #tests } SpAbstractTwoButtonsTest >> testFirstIconSecondIcon [ presenter firstIcon: #thumbsUp secondIcon: #thumbsDown. - self assert: presenter firstButton icon identicalTo: (self iconNamed: #thumbsUp). - self assert: presenter secondButton icon identicalTo: (self iconNamed: #thumbsDown) + self assert: presenter firstButton icon == (self iconNamed: #thumbsUp). + self assert: presenter secondButton icon == (self iconNamed: #thumbsDown) ] { #category : #tests } diff --git a/src/Spec2-Examples/SpBoxLayoutExample.class.st b/src/Spec2-Examples/SpBoxLayoutExample.class.st index 98b5b8ed2cd..20fdae80555 100644 --- a/src/Spec2-Examples/SpBoxLayoutExample.class.st +++ b/src/Spec2-Examples/SpBoxLayoutExample.class.st @@ -1,8 +1,8 @@ Class { #name : #SpBoxLayoutExample, #superclass : #SpPresenter, - #traits : 'TSpDynamicPresenter', - #classTraits : 'TSpDynamicPresenter classTrait', + #traits : 'SpTDynamicPresenter', + #classTraits : 'SpTDynamicPresenter classTrait', #instVars : [ 'element11', 'element21', diff --git a/src/Spec2-Examples/SpDemoActionBarPresenter.class.st b/src/Spec2-Examples/SpDemoActionBarPresenter.class.st index 3e6e9bb278a..8837ae3a505 100644 --- a/src/Spec2-Examples/SpDemoActionBarPresenter.class.st +++ b/src/Spec2-Examples/SpDemoActionBarPresenter.class.st @@ -28,18 +28,18 @@ SpDemoActionBarPresenter >> initializePresenters [ label: 'Add'; icon: (self iconNamed: #smallOk); help: 'Add.'; - action: [ self inform: 'Add' ]; + action: [ World defer: [ self inform: 'Add' ] ]; yourself); add: (self newButton label: 'Remove'; icon: (self iconNamed: #smallCancel); help: 'Remove.'; - action: [ self inform: 'Remove' ]; + action: [ World defer: [ self inform: 'Remove' ] ]; yourself); addLast: (self newButton label: 'Other'; help: 'Other.'; - action: [ self inform: 'Other' ]; + action: [ World defer: [ self inform: 'Other' ] ]; yourself); yourself. diff --git a/src/Spec2-Examples/SpDemoNotebookPresenter.class.st b/src/Spec2-Examples/SpDemoNotebookPresenter.class.st index a67413bafa4..e3f92a83177 100644 --- a/src/Spec2-Examples/SpDemoNotebookPresenter.class.st +++ b/src/Spec2-Examples/SpDemoNotebookPresenter.class.st @@ -78,10 +78,15 @@ SpDemoNotebookPresenter >> objectClassPage [ { #category : #pages } SpDemoNotebookPresenter >> objectInspectorPage [ + ^ SpNotebookPage title: 'Object inspector' icon: (self iconNamed: #nautilusIcon) - provider: [ EyeInspector new + provider: [ + self flag: #TODO. "Since EyeInspector was moved out Spec2 package, do not + reference it directly to not generate an explicit dependency. Dependency + is there, though... maybe is better to think in another example?" + (self class environment at: #EyeInspector) new inspect: Object; yourself ] layoutSpec: #inspectorSpec diff --git a/src/Spec2-Examples/SpDynamicSpecExample.class.st b/src/Spec2-Examples/SpDynamicSpecExample.class.st index a7fdc619a62..ae9c7edd18b 100644 --- a/src/Spec2-Examples/SpDynamicSpecExample.class.st +++ b/src/Spec2-Examples/SpDynamicSpecExample.class.st @@ -8,8 +8,8 @@ self exampleString Class { #name : #SpDynamicSpecExample, #superclass : #Object, - #traits : 'TSpObservable', - #classTraits : 'TSpObservable classTrait', + #traits : 'SpTObservable', + #classTraits : 'SpTObservable classTrait', #instVars : [ '#ui', '#object => SpObservableSlot' diff --git a/src/Spec2-Examples/SpEditableList.extension.st b/src/Spec2-Examples/SpEditableListPresenter.extension.st similarity index 55% rename from src/Spec2-Examples/SpEditableList.extension.st rename to src/Spec2-Examples/SpEditableListPresenter.extension.st index edfeb70943d..cead73408f0 100644 --- a/src/Spec2-Examples/SpEditableList.extension.st +++ b/src/Spec2-Examples/SpEditableListPresenter.extension.st @@ -1,11 +1,12 @@ -Extension { #name : #SpEditableList } +Extension { #name : #SpEditableListPresenter } { #category : #'*Spec2-Examples' } -SpEditableList class >> example [ +SpEditableListPresenter class >> example [ | presenter | presenter := self new - list: self selectors; + items: self selectors asOrderedCollection; + addItemBlock: [ 1 ]; openWithSpec; yourself. diff --git a/src/Spec2-Examples/SpRadioButtonExample.class.st b/src/Spec2-Examples/SpRadioButtonExample.class.st index 98f63e1d42b..014af64e863 100644 --- a/src/Spec2-Examples/SpRadioButtonExample.class.st +++ b/src/Spec2-Examples/SpRadioButtonExample.class.st @@ -18,20 +18,18 @@ Class { { #category : #specs } SpRadioButtonExample class >> defaultSpec [ ^ SpBoxLayout newVertical - add: - (SpBoxLayout newHorizontal - add: #button1; - add: #button2; - add: #button3; - yourself) - withConstraints: [ :c | c height: self toolbarHeight ]; - add: #label withConstraints: [ :c | c height: self labelHeight ]; + add: (SpBoxLayout newVertical + add: #button1 expand: false; + add: #button2 expand: false; + add: #button3 expand: false; + yourself); + add: #label expand: false; yourself ] { #category : #example } SpRadioButtonExample class >> example [ - + ^ self new openWithSpec ] @@ -53,27 +51,18 @@ SpRadioButtonExample >> connectPresenters [ { #category : #initialization } SpRadioButtonExample >> initializePresenters [ + button1 := self newRadioButton. button2 := self newRadioButton. button3 := self newRadioButton. label := self newLabel. - - button1 associatedRadioButtons: {button2 . button3}. + button1 associatedRadioButtons: { button2. button3 }. button1 label: 'Button 1'. button2 label: 'Button 2'. button3 label: 'Button 3'. self updateLabel. - self setFocus -] - -{ #category : #initialization } -SpRadioButtonExample >> setFocus [ - self focusOrder - add: button1; - add: button2; - add: button3 ] { #category : #updating } diff --git a/src/Spec2-Inspector/EyeInspectorNavigator.class.st b/src/Spec2-Inspector/EyeInspectorNavigator.class.st index 021bc6bfb63..6b962fa790a 100644 --- a/src/Spec2-Inspector/EyeInspectorNavigator.class.st +++ b/src/Spec2-Inspector/EyeInspectorNavigator.class.st @@ -4,8 +4,6 @@ This a wrapper around inspectors for diving. It is used in the case where the in Class { #name : #EyeInspectorNavigator, #superclass : #SpPresenter, - #traits : 'TSpObservable', - #classTraits : 'TSpObservable classTrait', #instVars : [ '#inspector => SpObservableSlot', '#history', diff --git a/src/Spec2-Layout/SpMillerLayout.class.st b/src/Spec2-Layout/SpMillerLayout.class.st index 609c5c19c4f..5f79c60980d 100644 --- a/src/Spec2-Layout/SpMillerLayout.class.st +++ b/src/Spec2-Layout/SpMillerLayout.class.st @@ -5,8 +5,8 @@ Since I am intended to be used dinamically (adding/removing components on demand Class { #name : #SpMillerLayout, #superclass : #SpExecutableLayout, - #traits : 'TSpObservable', - #classTraits : 'TSpObservable classTrait', + #traits : 'SpTObservable', + #classTraits : 'SpTObservable classTrait', #instVars : [ '#direction', '#spacing', diff --git a/src/Spec2-Morphic-Backend-Tests/SpMorphStyleTest.class.st b/src/Spec2-Morphic-Backend-Tests/SpMorphStyleTest.class.st index fe5a626c7e8..118103198b0 100644 --- a/src/Spec2-Morphic-Backend-Tests/SpMorphStyleTest.class.st +++ b/src/Spec2-Morphic-Backend-Tests/SpMorphStyleTest.class.st @@ -118,6 +118,43 @@ SpMorphStyleTest >> testFromStylesheetAdapter [ ] +{ #category : #tests } +SpMorphStyleTest >> testNestedStyles [ + | lookup labelAdapter styleSheet | + + styleSheet := (SpStyleSTONReader fromString: ' +.application [ + .label [ + Geometry { #width: 21 }, + .nested [ + Geometry { #width: 42 }, + .deepNested [ + Geometry { #width: 84 } ] ] ] ]'). + + "No nesting" + labelAdapter := SpLabelPresenter new + buildWithSpec; + adapter. + lookup := SpMorphStyle fromStylesheet: styleSheet adapter: labelAdapter. + self assert: lookup width equals: 21. + + "nesting" + labelAdapter := SpLabelPresenter new + addStyle: 'nested'; + buildWithSpec; + adapter. + lookup := SpMorphStyle fromStylesheet: styleSheet adapter: labelAdapter. + self assert: lookup width equals: 42. + + "deep-nesting" + labelAdapter := SpLabelPresenter new + addStyle: 'nested.deepNested'; + buildWithSpec; + adapter. + lookup := SpMorphStyle fromStylesheet: styleSheet adapter: labelAdapter. + self assert: lookup width equals: 84 +] + { #category : #tests } SpMorphStyleTest >> testSimpleLookup [ "this should answer the width defined in the only level" diff --git a/src/Spec2-ObservableSlot/SpObservablePoint.class.st b/src/Spec2-ObservableSlot/SpObservablePoint.class.st index aa158cc15ef..6e4b0a696bb 100644 --- a/src/Spec2-ObservableSlot/SpObservablePoint.class.st +++ b/src/Spec2-ObservableSlot/SpObservablePoint.class.st @@ -7,8 +7,8 @@ I use TObservable that has methods to ease the usage of my observable properties Class { #name : #SpObservablePoint, #superclass : #Object, - #traits : 'TSpObservable', - #classTraits : 'TSpObservable classTrait', + #traits : 'SpTObservable', + #classTraits : 'SpTObservable classTrait', #instVars : [ '#x => SpObservableSlot', '#y' diff --git a/src/Spec2-ObservableSlot/TSpObservable.trait.st b/src/Spec2-ObservableSlot/SpTObservable.trait.st similarity index 77% rename from src/Spec2-ObservableSlot/TSpObservable.trait.st rename to src/Spec2-ObservableSlot/SpTObservable.trait.st index 187b8fd75cf..6627c23fc00 100644 --- a/src/Spec2-ObservableSlot/TSpObservable.trait.st +++ b/src/Spec2-ObservableSlot/SpTObservable.trait.st @@ -1,16 +1,16 @@ Trait { - #name : #TSpObservable, + #name : #SpTObservable, #category : #'Spec2-ObservableSlot' } { #category : #events } -TSpObservable >> notifyPropertyChanged: aName [ +SpTObservable >> notifyPropertyChanged: aName [ self flag: #todo. "This is used for collections but collections should be managed in a better way and this method removed." (self observablePropertyNamed: aName) valueChanged ] { #category : #events } -TSpObservable >> observablePropertyNamed: aName [ +SpTObservable >> observablePropertyNamed: aName [ | slot | slot := self class slotNamed: aName. @@ -23,14 +23,14 @@ TSpObservable >> observablePropertyNamed: aName [ ] { #category : #events } -TSpObservable >> property: aName rawValue: anObject [ +SpTObservable >> property: aName rawValue: anObject [ "Write in the slot without announcing it." (self observablePropertyNamed: aName) rawValue: anObject ] { #category : #events } -TSpObservable >> property: aName whenChangedDo: aBlockClosure [ +SpTObservable >> property: aName whenChangedDo: aBlockClosure [ "Obtain the raw value. We need to access the underlying value holder to subscribe to it" diff --git a/src/Spec2-Tests/SpAbstractTextPresenterTest.class.st b/src/Spec2-Tests/SpAbstractTextPresenterTest.class.st index 9afbce7fb1d..5c1df4fdd2a 100644 --- a/src/Spec2-Tests/SpAbstractTextPresenterTest.class.st +++ b/src/Spec2-Tests/SpAbstractTextPresenterTest.class.st @@ -36,10 +36,10 @@ SpAbstractTextPresenterTest >> testClearContent [ SpAbstractTextPresenterTest >> testClearSelection [ self initializationText. self openInstance. - presenter selection: (1 to: 10). - self assert: presenter selection equals: (1 to: 10). + presenter selectionInterval: (1 to: 10). + self assert: presenter selectionInterval equals: (1 to: 10). presenter clearSelection. - self assert: presenter selection isEmpty + self assert: presenter selectionInterval isEmpty ] { #category : #tests } @@ -69,5 +69,5 @@ SpAbstractTextPresenterTest >> testSelectAll [ self initializationText. self openInstance. presenter selectAll. - self assert: presenter selection equals: (1 to: 15) + self assert: presenter selectionInterval equals: (1 to: 15) ] diff --git a/src/Spec2-Tests/SpCodePresenterTest.class.st b/src/Spec2-Tests/SpCodePresenterTest.class.st index 125e7a127b7..ee7293fc295 100644 --- a/src/Spec2-Tests/SpCodePresenterTest.class.st +++ b/src/Spec2-Tests/SpCodePresenterTest.class.st @@ -34,6 +34,26 @@ SpCodePresenterTest >> testContextMenu [ self assert: changed ] +{ #category : #tests } +SpCodePresenterTest >> testFindClassFrom [ + + self assert: (presenter findClassFrom: '') equals: nil. + self assert: (presenter findClassFrom: 'Object') equals: Object. + self assert: (presenter findClassFrom: 'Object.') equals: Object. + self assert: (presenter findClassFrom: '.Object.') equals: Object. + self + assert: (presenter findClassFrom: 'somethingBefore := 42.Object') + equals: Object. + self + assert: + (presenter + findClassFrom: 'somethingBefore := 42.Object. somethingAfter := 11') + equals: Object. + self + assert: (presenter findClassFrom: 'NonExistingClass.Object.') + equals: Object +] + { #category : #tests } SpCodePresenterTest >> testWhenSyntaxHighlightChangedDo [ | count result | diff --git a/src/Spec2-Tests/SpComponentListPresenterTest.class.st b/src/Spec2-Tests/SpComponentListPresenterTest.class.st index 5e9a0975412..2b192ee27af 100644 --- a/src/Spec2-Tests/SpComponentListPresenterTest.class.st +++ b/src/Spec2-Tests/SpComponentListPresenterTest.class.st @@ -1,6 +1,6 @@ Class { #name : #SpComponentListPresenterTest, - #superclass : #SpTest, + #superclass : #SpAbstractListPresenterTest, #category : #'Spec2-Tests-Core-Widgets' } @@ -9,19 +9,47 @@ SpComponentListPresenterTest >> classToTest [ ^ SpComponentListPresenter ] +{ #category : #'tests-activation' } +SpComponentListPresenterTest >> testActivationOnDoubleClickShouldActivateOnDoubleClick [ + + | activatedItem | + activatedItem := nil. + presenter + activateOnDoubleClick; + whenActivatedDo: [ :selection | activatedItem := selection selectedItem ]. + + presenter doubleClickAtIndex: 1. + + self assert: activatedItem label equals: '10'. +] + +{ #category : #'tests-activation' } +SpComponentListPresenterTest >> testActivationOnSingleClickShouldActivateOnClick [ + + | activatedItem | + activatedItem := nil. + presenter + activateOnSingleClick; + whenActivatedDo: [ :selection | activatedItem := selection selectedItem ]. + + presenter clickAtIndex: 1. + + self assert: activatedItem label equals: '10'. +] + { #category : #tests } SpComponentListPresenterTest >> testAddNoPresenterToComponentListDoesNotRaiseEvent [ | raised | + raised := false. presenter whenPresentersChangedDo: [ raised := true ]. - - self deny: raised ] { #category : #tests } SpComponentListPresenterTest >> testAddPresenterToComponentListIsInPresenterCollection [ | button | + button := SpButtonPresenter new. presenter addPresenter: button. self assert: (presenter includes: button) @@ -59,5 +87,71 @@ SpComponentListPresenterTest >> testAddPresenterToComponentListShouldNotBeEmpty { #category : #tests } SpComponentListPresenterTest >> testNewComponentListIsEmpty [ - self assertEmpty: presenter + + self assertEmpty: self classToTest new +] + +{ #category : #tests } +SpComponentListPresenterTest >> testReplaceItemList [ + | changed | + + changed := false. + presenter whenModelChangedDo: [ changed := true ]. + presenter items: #(a b c). + + self + assert: (presenter model collection collect: #label) + equals: #(a b c). + self assert: changed +] + +{ #category : #tests } +SpComponentListPresenterTest >> testSelectAll [ + + presenter beSingleSelection. + presenter selectAll. + "in single mode selectAll has no effect" + self assertEmpty: presenter selection selectedItems. + presenter beMultipleSelection. + presenter selectAll. + "but in multiple mode selectAll works" + self + assert: (presenter selection selectedItems asArray collect: #label) + equals: #('10' '20' '30') +] + +{ #category : #'tests-smoke' } +SpComponentListPresenterTest >> testSetSortingBlockBeforeItems [ + | count | + + count := 0. + presenter whenSortingBlockChangedDo: [ :sortFunction | count := count + 1 ]. + presenter sortingBlock: [ :each | each label asNumber ] ascending. + presenter items: #(3 8 1 0). + self assert: count equals: 1. + self assert: (presenter model at: 1) label equals: '0' +] + +{ #category : #'tests-smoke' } +SpComponentListPresenterTest >> testSortingBlock [ + | count | + + count := 0. + presenter whenSortingBlockChangedDo: [ :sortFunction | count := count + 1 ]. + presenter items: #(3 8 1 0). + presenter sortingBlock: [ :each | each label asNumber ] ascending. + self assert: count equals: 1. + self assert: (presenter model at: 1) label equals: '0' +] + +{ #category : #tests } +SpComponentListPresenterTest >> testUnselectAll [ + + presenter beMultipleSelection. + presenter selectAll. + self + assert: (presenter selection selectedItems collect: #label as: Array) + equals: #('10' '20' '30'). + presenter unselectAll. + self assertEmpty: presenter selection selectedItems ] diff --git a/src/Spec2-Tests/SpComposablePresenterWithModelTest.class.st b/src/Spec2-Tests/SpComposablePresenterWithModelTest.class.st index ec09540eb53..13946bbe5a3 100644 --- a/src/Spec2-Tests/SpComposablePresenterWithModelTest.class.st +++ b/src/Spec2-Tests/SpComposablePresenterWithModelTest.class.st @@ -37,8 +37,8 @@ SpComposablePresenterWithModelTest >> testInstanceCreationWithValueHolder [ { #category : #testing } SpComposablePresenterWithModelTest >> testModelSettingModelToModel [ - "we had a Model, new model is another Model" + "we had a Model, new model is another Model" | model model2 presenter | model := SpTestingPointModel x: 1 y: 2. model2 := SpTestingPointModel x: 4 y: 5. @@ -50,15 +50,18 @@ SpComposablePresenterWithModelTest >> testModelSettingModelToModel [ presenter model: model2. self assert: presenter announcingObject isSpAnnouncingObject. self deny: presenter announcingObject isValueHolder. - self assert: presenter announcingObject identicalTo: model2. - self assert: presenter announcingObject announcer numberOfSubscriptions > 0 + self assert: presenter announcingObject == model2. + self assert: presenter announcingObject announcer numberOfSubscriptions > 0. + ] { #category : #testing } SpComposablePresenterWithModelTest >> testModelSettingModelToValueHolder [ + | point model presenter | + "we had value holder, new model is a model" - point := 40 @ 54. + point := 40@54. presenter := SpTestingPresenterWithModel on: point. model := SpTestingPointModel x: 1 y: 2. @@ -69,16 +72,20 @@ SpComposablePresenterWithModelTest >> testModelSettingModelToValueHolder [ presenter model: model. self assert: presenter announcingObject isSpAnnouncingObject. self deny: presenter announcingObject isValueHolder. - self assert: presenter announcingObject identicalTo: model. - self assert: presenter announcingObject announcer numberOfSubscriptions > 0 + self assert: presenter announcingObject == model. + self assert: presenter announcingObject announcer numberOfSubscriptions > 0. + + ] { #category : #testing } SpComposablePresenterWithModelTest >> testModelSettingObjectToModel [ + | point model presenter | + "we had a Model, new model is a regular object" model := SpTestingPointModel x: 1 y: 2. - point := 40 @ 54. + point := 40@54. presenter := SpTestingPresenterWithModel on: model. self assert: presenter announcingObject isSpAnnouncingObject. self deny: presenter announcingObject isValueHolder. @@ -87,17 +94,21 @@ SpComposablePresenterWithModelTest >> testModelSettingObjectToModel [ presenter model: point. self assert: presenter announcingObject isSpAnnouncingObject. self assert: presenter announcingObject isValueHolder. - self assert: presenter model identicalTo: point. - self deny: presenter announcingObject identicalTo: model. - self assert: presenter announcingObject announcer numberOfSubscriptions > 0 + self assert: presenter model == point. + self deny: presenter announcingObject == model. + self assert: presenter announcingObject announcer numberOfSubscriptions > 0. + + ] { #category : #testing } SpComposablePresenterWithModelTest >> testModelSettingObjectToValueHolder [ + | point point2 presenter | + "we had value holder, new model is a regular object" - point := 40 @ 54. - point2 := 1 @ 0. + point := 40@54. + point2 := 1@0. presenter := SpTestingPresenterWithModel on: point. self assert: presenter announcingObject isSpAnnouncingObject. self assert: presenter announcingObject isValueHolder. @@ -106,16 +117,17 @@ SpComposablePresenterWithModelTest >> testModelSettingObjectToValueHolder [ presenter model: point2. self assert: presenter announcingObject isSpAnnouncingObject. self assert: presenter announcingObject isValueHolder. - self assert: presenter model identicalTo: point2. - self assert: presenter announcingObject announcer numberOfSubscriptions > 0 + self assert: presenter model == point2. + self assert: presenter announcingObject announcer numberOfSubscriptions > 0. + ] { #category : #testing } SpComposablePresenterWithModelTest >> testModelSettingValueHolderToModel [ - "we had a Model, new model is a value holder" + "we had a Model, new model is a value holder" | model point valueHolder presenter | - point := 1 @ 0. + point := 1@0. model := SpTestingPointModel x: 1 y: 2. valueHolder := NewValueHolder value: point. presenter := SpTestingPresenterWithModel on: model. @@ -126,17 +138,20 @@ SpComposablePresenterWithModelTest >> testModelSettingValueHolderToModel [ presenter model: valueHolder. self assert: presenter announcingObject isSpAnnouncingObject. self assert: presenter announcingObject isValueHolder. - self assert: presenter announcingObject identicalTo: valueHolder. - self assert: presenter announcingObject announcer numberOfSubscriptions > 0 + self assert: presenter announcingObject == valueHolder. + self assert: presenter announcingObject announcer numberOfSubscriptions > 0. + ] { #category : #testing } SpComposablePresenterWithModelTest >> testModelSettingValueHolderToValueHolder [ + | point point2 valueHolder presenter | + "we had value holder, new model is a regular object" - point := 40 @ 54. - point2 := 1 @ 0. - + point := 40@54. + point2 := 1@0. + "we had value holder, new model is a value holder" presenter := SpTestingPresenterWithModel on: point. valueHolder := NewValueHolder value: point2. @@ -147,9 +162,10 @@ SpComposablePresenterWithModelTest >> testModelSettingValueHolderToValueHolder [ presenter model: valueHolder. self assert: presenter announcingObject isSpAnnouncingObject. self assert: presenter announcingObject isValueHolder. - self assert: presenter model identicalTo: point2. - self assert: presenter announcingObject identicalTo: valueHolder. - self assert: presenter announcingObject announcer numberOfSubscriptions > 0 + self assert: presenter model == point2. + self assert: presenter announcingObject == valueHolder. + self assert: presenter announcingObject announcer numberOfSubscriptions > 0. + ] { #category : #testing } @@ -177,28 +193,33 @@ SpComposablePresenterWithModelTest >> testUpdateModel [ { #category : #testing } SpComposablePresenterWithModelTest >> testUpdateModelWithValueHolder [ + | aPoint aValueHolder presenter anAnnouncer | + "create a point and a value holder that contains it and can react on announcements" - aPoint := 40 @ 54. + aPoint := 40@54. aValueHolder := NewValueHolder value: aPoint. - - self assert: aValueHolder value identicalTo: aPoint. + + self assert: (aValueHolder value == aPoint). anAnnouncer := aValueHolder announcer. - self assert: aValueHolder announcer subscriptions subscriptions size equals: 0. - + self assert: (aValueHolder announcer subscriptions subscriptions size) equals: 0. + presenter := SpTestingPresenterWithModel on: aValueHolder. - self assert: anAnnouncer identicalTo: aValueHolder announcer. + self assert: (anAnnouncer == aValueHolder announcer). self assert: presenter x text equals: aPoint x asString. self assert: presenter y text equals: aPoint y asString. - + aPoint setX: 1 setY: 2. - self assert: aValueHolder value identicalTo: aPoint. + self assert: (aValueHolder value == aPoint). aValueHolder valueChanged. - self assert: anAnnouncer identicalTo: aValueHolder announcer. - + self assert: (anAnnouncer == aValueHolder announcer). + "the point itself is not subscribed to the presenter" self assert: presenter x text equals: aPoint x asString. - self assert: presenter y text equals: aPoint y asString + self assert: presenter y text equals: aPoint y asString. + + + ] diff --git a/src/Spec2-Tests/SpEditableListPresenterTest.class.st b/src/Spec2-Tests/SpEditableListPresenterTest.class.st new file mode 100644 index 00000000000..974cb08e2ce --- /dev/null +++ b/src/Spec2-Tests/SpEditableListPresenterTest.class.st @@ -0,0 +1,77 @@ +Class { + #name : #SpEditableListPresenterTest, + #superclass : #SpSmokeTest, + #category : #'Spec2-Tests-Core-Widgets' +} + +{ #category : #running } +SpEditableListPresenterTest >> classToTest [ + ^ SpEditableListPresenter +] + +{ #category : #tests } +SpEditableListPresenterTest >> testCanAddNewItem [ + presenter + items: #(1 2 3) asOrderedCollection; + addItemBlock: [ 4 ]. + + presenter addButton click. + + self + assertCollection: presenter items + hasSameElements: #(1 2 3 4) +] + +{ #category : #tests } +SpEditableListPresenterTest >> testCanCancelAddNewItem [ + presenter + items: #(1 2 3) asOrderedCollection; + addItemBlock: [ nil ]. + + presenter addButton click. + + self + assertCollection: presenter items + hasSameElements: #(1 2 3) +] + +{ #category : #tests } +SpEditableListPresenterTest >> testCanRemoveSelectedItem [ + presenter + items: #(1 2 3) asOrderedCollection; + selectItem: 2. + + presenter removeButton click. + + self + assertCollection: presenter items + hasSameElements: #(1 3) +] + +{ #category : #tests } +SpEditableListPresenterTest >> testMoveElementAtTo [ + presenter items: {'AAA' . 'BBB' . 'CCC'} asOrderedCollection. + presenter moveElementAt: 1 to: 3. + self + assert: presenter items asArray + equals: {'BBB' . 'CCC' . 'AAA'} +] + +{ #category : #tests } +SpEditableListPresenterTest >> testRemoveBlockExecutedWhenSelectedItemRemoved [ + | executed selectedItem | + executed := false. + presenter + items: #(1 2 3) asOrderedCollection; + removeItemBlock: [ :item | executed := true. selectedItem := item ]; + selectItem: 2. + + presenter removeButton click. + + self + assert: executed + description: 'removeBlock not exeuted when selected item removed!'. + self + assert: selectedItem + equals: 2 +] diff --git a/src/Spec2-Tests/SpEditableListTest.class.st b/src/Spec2-Tests/SpEditableListTest.class.st deleted file mode 100644 index 7a7560dd872..00000000000 --- a/src/Spec2-Tests/SpEditableListTest.class.st +++ /dev/null @@ -1,19 +0,0 @@ -Class { - #name : #SpEditableListTest, - #superclass : #SpSmokeTest, - #category : #'Spec2-Tests-Core-Widgets' -} - -{ #category : #running } -SpEditableListTest >> classToTest [ - ^ SpEditableList -] - -{ #category : #tests } -SpEditableListTest >> testMoveElementAtTo [ - presenter list: {'AAA' . 'BBB' . 'CCC'}. - presenter moveElementAt: 1 to: 3. - self - assert: presenter list model items asArray - equals: {'BBB' . 'CCC' . 'AAA'} -] diff --git a/src/Spec2-Tests/SpInterpreterTest.class.st b/src/Spec2-Tests/SpInterpreterTest.class.st index 1b2f415caa3..1a0e0ecbf86 100644 --- a/src/Spec2-Tests/SpInterpreterTest.class.st +++ b/src/Spec2-Tests/SpInterpreterTest.class.st @@ -61,7 +61,7 @@ SpInterpreterTest >> testInterpretASpecModelMorphAssociation [ model := SpAbstractWidgetPresenter new. spec := {#MenuRegistration . #help: . #icon:}. morph := specInterpreterClass interpretASpec: spec presenter: model. - self assert: model adapter identicalTo: morph + self assert: model adapter == morph ] { #category : #tests } diff --git a/src/Spec2-Tests/SpListPresenterSingleSelectionTest.class.st b/src/Spec2-Tests/SpListPresenterSingleSelectionTest.class.st index 2adeebcd0a8..cd094fd15f0 100644 --- a/src/Spec2-Tests/SpListPresenterSingleSelectionTest.class.st +++ b/src/Spec2-Tests/SpListPresenterSingleSelectionTest.class.st @@ -347,8 +347,8 @@ SpListPresenterSingleSelectionTest >> testUnselectSelectedItemRaisesSingleEvent SpListPresenterSingleSelectionTest >> testUnselectSelectedItemRemovesSelection [ presenter - selectIndex: 10; - unselectIndex: 10. + selectItem: 10; + unselectItem: 10. self assert: presenter selection isEmpty ] diff --git a/src/Spec2-Tests/SpSliderPresenterTest.class.st b/src/Spec2-Tests/SpSliderPresenterTest.class.st index cc66d9fb9db..a009b990257 100644 --- a/src/Spec2-Tests/SpSliderPresenterTest.class.st +++ b/src/Spec2-Tests/SpSliderPresenterTest.class.st @@ -19,7 +19,7 @@ SpSliderPresenterTest >> initMinMax [ SpSliderPresenterTest >> testAbsoluteValue [ self initMinMax. presenter absoluteValue: 0.5. - self assert: presenter value identicalTo: 50 + self assert: presenter value == 50 ] { #category : #tests } @@ -34,7 +34,7 @@ SpSliderPresenterTest >> testReset [ presenter value: 50; reset. - self assert: presenter value identicalTo: 0 + self assert: presenter value == 0 ] { #category : #tests } diff --git a/src/Spec2-Tests/SpTextPresenterTest.class.st b/src/Spec2-Tests/SpTextPresenterTest.class.st index 23b248378bc..897754ffe3e 100644 --- a/src/Spec2-Tests/SpTextPresenterTest.class.st +++ b/src/Spec2-Tests/SpTextPresenterTest.class.st @@ -20,9 +20,8 @@ SpTextPresenterTest >> testInsertAt [ { #category : #tests } SpTextPresenterTest >> testSelectLine [ - self initializationText. self openInstance. presenter selectLine. - self assert: presenter selection equals: (1 to: 15) + self assert: presenter selectionInterval equals: (1 to: 15) ] diff --git a/src/Spec2-Tests/SpTreeTablePresenterMultipleSelectionTest.class.st b/src/Spec2-Tests/SpTreeTablePresenterMultipleSelectionTest.class.st new file mode 100644 index 00000000000..d0406a88199 --- /dev/null +++ b/src/Spec2-Tests/SpTreeTablePresenterMultipleSelectionTest.class.st @@ -0,0 +1,490 @@ +Class { + #name : #SpTreeTablePresenterMultipleSelectionTest, + #superclass : #SpTest, + #category : #'Spec2-Tests-Core-Widgets' +} + +{ #category : #running } +SpTreeTablePresenterMultipleSelectionTest >> classToTest [ + ^ SpTreeTablePresenter +] + +{ #category : #running } +SpTreeTablePresenterMultipleSelectionTest >> setUp [ + super setUp. + presenter + addColumn: (SpStringTableColumn title: 'Value' evaluated: #printString); + beMultipleSelection; + roots: #(1 2 3); + children: [ :aNumber | + aNumber < 100 + ifTrue: [ { aNumber * 2. aNumber * 3. aNumber * 10 } ] + ifFalse: [ #() ] ]; + yourself. +] + +{ #category : #'tests-select-item' } +SpTreeTablePresenterMultipleSelectionTest >> testSelectAbsentItemGivesEmptySelection [ + + presenter selectItem: 4000. + self assert: presenter selection isEmpty +] + +{ #category : #'tests-select-index' } +SpTreeTablePresenterMultipleSelectionTest >> testSelectInvalidPathHasNoSelectedItems [ + + presenter selectPath: #(4). + self assert: presenter selection selectedItems isEmpty +] + +{ #category : #'tests-select-index' } +SpTreeTablePresenterMultipleSelectionTest >> testSelectInvalidPathHasNoSelectedPaths [ + + presenter selectPath: #(4). + self assert: presenter selection selectedPaths isEmpty +] + +{ #category : #'tests-select-index' } +SpTreeTablePresenterMultipleSelectionTest >> testSelectInvalidPathsHasNoSelectedItems [ + presenter selectPaths: { #(10 20) . #(20 20) }. + self assert: presenter selection selectedItems isEmpty +] + +{ #category : #'tests-select-index' } +SpTreeTablePresenterMultipleSelectionTest >> testSelectInvalidPathsHasNoSelectedPaths [ + presenter selectPaths: { #(10 20) . #(20 20) }. + self assert: presenter selection selectedPaths isEmpty +] + +{ #category : #'tests-select-index' } +SpTreeTablePresenterMultipleSelectionTest >> testSelectInvalidPathsIsEmpty [ + presenter selectPaths: { #(40) . #(10 20)}. + self assert: presenter selection isEmpty +] + +{ #category : #'tests-select-item' } +SpTreeTablePresenterMultipleSelectionTest >> testSelectItemAddsItemToSelectedItemList [ + + presenter selectItem: 10. + self assert: (presenter selection includesItem: 10) +] + +{ #category : #'tests-select-item' } +SpTreeTablePresenterMultipleSelectionTest >> testSelectItemAddsPathToSelectedPathList [ + + presenter selectItem: 10. + self assert: (presenter selection includesPath: #(1 3)) +] + +{ #category : #'tests-select-item' } +SpTreeTablePresenterMultipleSelectionTest >> testSelectItemOutsideRangeHasNoSelectedItems [ + + presenter selectItem: 4000. + self assert: presenter selection selectedItems isEmpty +] + +{ #category : #'tests-select-item' } +SpTreeTablePresenterMultipleSelectionTest >> testSelectItemOutsideRangeHasNoSelectedPath [ + + presenter selectItem: 4000. + self assert: presenter selection selectedPaths isEmpty +] + +{ #category : #'tests-select-item' } +SpTreeTablePresenterMultipleSelectionTest >> testSelectItemThenSelectOutsideRangeKeepsFirstElement [ + + presenter selectItem: 10. + presenter selectItem: 5000. + self assert: (presenter selection includesItem: 10) +] + +{ #category : #'tests-select-item' } +SpTreeTablePresenterMultipleSelectionTest >> testSelectItemThenSelectOutsideRangeKeepsFirstPath [ + + presenter selectItem: 10. + presenter selectItem: 5000. + self + assertCollection: presenter selection selectedPaths + hasSameElements: #( #(1 3) ) +] + +{ #category : #'tests-select-item' } +SpTreeTablePresenterMultipleSelectionTest >> testSelectItemThenSelectOutsideRangeKeepsSingleSelectedItem [ + + presenter selectItem: 10. + presenter selectItem: 3000. + self assert: presenter selection selectedItems size equals: 1 +] + +{ #category : #'tests-select-item' } +SpTreeTablePresenterMultipleSelectionTest >> testSelectItemsAddsItemsToSelectedItemList [ + presenter selectItems: {10 . 20}. + self assert: (presenter selection includesItems: {10 . 20}) +] + +{ #category : #'tests-select-item' } +SpTreeTablePresenterMultipleSelectionTest >> testSelectItemsAddsPathsToSelectedPathList [ + presenter selectItems: {10 . 20}. + + self + assertCollection: presenter selection selectedPaths + hasSameElements: { #(1 3) . #(1 1 3) } +] + +{ #category : #'tests-select-item' } +SpTreeTablePresenterMultipleSelectionTest >> testSelectItemsOutsideRangeHasNoSelectedItems [ + presenter selectItems: {3000 . 4000}. + + self assert: presenter selection selectedItems isEmpty +] + +{ #category : #'tests-select-item' } +SpTreeTablePresenterMultipleSelectionTest >> testSelectItemsOutsideRangeHasNoSelectedPaths [ + presenter selectItems: {3000 . 4000}. + + self assert: presenter selection selectedPaths isEmpty +] + +{ #category : #'tests-select-item' } +SpTreeTablePresenterMultipleSelectionTest >> testSelectItemsOutsideRangeIsEmpty [ + presenter selectItems: {4000 . 5000}. + self assert: presenter selection isEmpty +] + +{ #category : #'tests-select-item' } +SpTreeTablePresenterMultipleSelectionTest >> testSelectItemsThenSelectOutsideRangeKeepsElements [ + presenter selectItems: {10 . 20}. + presenter selectItems: {4000 . 5000}. + self assert: (presenter selection includesItems: {10 . 20}) +] + +{ #category : #'tests-select-item' } +SpTreeTablePresenterMultipleSelectionTest >> testSelectItemsThenSelectOutsideRangeKeepsPaths [ + presenter selectItems: {10 . 20}. + presenter selectItems: {5000 . 6000}. + + self + assertCollection: presenter selection selectedPaths + hasSameElements: { #(1 1 3) . #(1 3) } +] + +{ #category : #'tests-select-item' } +SpTreeTablePresenterMultipleSelectionTest >> testSelectMultipleItemAddsAllToSelectedPathList [ + + presenter + selectItem: 10; + selectItem: 30. + self + assertCollection: presenter selection selectedPaths + hasSameElements: { #(1 3) . #(1 2 3) } +] + +{ #category : #'tests-select-item' } +SpTreeTablePresenterMultipleSelectionTest >> testSelectMultipleItemsAddsAllToSelectedItemList [ + + presenter selectItem: 10. + presenter selectItem: 30. + self assert: (presenter selection includesItem: 10). + self assert: (presenter selection includesItem: 30). +] + +{ #category : #'tests-select-item' } +SpTreeTablePresenterMultipleSelectionTest >> testSelectMultipleItemsRaisesSelectionChangeEventMultipleTimes [ + | events | + events := 0. + presenter whenSelectionChangedDo: [ :selection | events := events + 1 ]. + + presenter selectItem: 10. + presenter selectItem: 30. + + self assert: events equals: 2 +] + +{ #category : #'tests-select-index' } +SpTreeTablePresenterMultipleSelectionTest >> testSelectMultiplePathsAddsAllToSelectedItemList [ + + presenter + selectPath: #(1 2); + selectPath: #(2 2). + self assert: (presenter selection includesItem: 3). + self assert: (presenter selection includesItem: 6). +] + +{ #category : #'tests-select-index' } +SpTreeTablePresenterMultipleSelectionTest >> testSelectMultiplePathsAddsAllToSelectedPathList [ + + presenter + selectPath: #(1 2); + selectPath: #(2 2). + self assert: (presenter selection includesItem: 3). + self assert: (presenter selection includesItem: 6). + + self assert: (presenter selection includesPath: #(1 2)). + self assert: (presenter selection includesPath: #(2 2)). +] + +{ #category : #'tests-select-index' } +SpTreeTablePresenterMultipleSelectionTest >> testSelectMultiplePathsRaisesSelectionChangeEventMultipleTimes [ + | events | + events := 0. + presenter whenSelectionChangedDo: [ :selection | events := events + 1 ]. + + presenter selectPath: #(1 1). + presenter selectPath: #(3). + + self assert: events equals: 2 +] + +{ #category : #'tests-select-index' } +SpTreeTablePresenterMultipleSelectionTest >> testSelectPathAddsIndexToSelectedPathList [ + + presenter selectPath: #(1). + self assert: (presenter selection includesPath: #(1)) +] + +{ #category : #'tests-select-index' } +SpTreeTablePresenterMultipleSelectionTest >> testSelectPathAddsItemToSelectedItemList [ + + presenter selectPath: #(1 3). + self assert: (presenter selection includesItem: 10) +] + +{ #category : #'tests-select-index' } +SpTreeTablePresenterMultipleSelectionTest >> testSelectPathRaisesSelectionChangeEventWithSelectedPath [ + | selectedPaths | + presenter + whenSelectionChangedDo: [ :selection | selectedPaths := selection selectedPaths ]. + + presenter selectPath: #(1 2). + + self assert: (selectedPaths includes: #(1 2)). +] + +{ #category : #'tests-select-index' } +SpTreeTablePresenterMultipleSelectionTest >> testSelectPathThenSelectInvalidPathKeepsFirstElement [ + + presenter selectPath: #(1 3). + presenter selectPath: #(50). + self assert: (presenter selection includesItem: 10) +] + +{ #category : #'tests-select-index' } +SpTreeTablePresenterMultipleSelectionTest >> testSelectPathThenSelectInvalidPathKeepsFirstPath [ + + presenter selectPath: #(1 3). + presenter selectPath: #(50). + self assert: (presenter selection includesPath: #(1 3)) +] + +{ #category : #'tests-select-index' } +SpTreeTablePresenterMultipleSelectionTest >> testSelectPathThenSelectInvalidPathKeepsSingleSelectedItem [ + + presenter selectPath: #(1 3). + presenter selectPath: #(50). + self + assert: presenter selection selectedItems size + equals: 1 +] + +{ #category : #'tests-select-index' } +SpTreeTablePresenterMultipleSelectionTest >> testSelectPathTwiceAddsPathToSelectedPathListOnlyOnce [ + + presenter selectPath: #(1 3). + presenter selectPath: #(1 3). + self + assert: presenter selection selectedPaths + equals: #( #(1 3) ) +] + +{ #category : #'tests-select-index' } +SpTreeTablePresenterMultipleSelectionTest >> testSelectPathsAddsItemsToSelectedItemList [ + | paths | + paths := { #(1 2) . #(2 2) }. + presenter selectPaths: paths. + + self assert: (presenter selection includesItems: {3 . 6}) + +] + +{ #category : #'tests-select-index' } +SpTreeTablePresenterMultipleSelectionTest >> testSelectPathsAddsPathsToSelectedPathList [ + | paths | + paths := { #(1 2) . #(2 2) }. + presenter selectPaths: paths. + self assert: (presenter selection includesPaths: paths). +] + +{ #category : #'tests-select-index' } +SpTreeTablePresenterMultipleSelectionTest >> testSelectPathsThenSelectInvalidPathKeepsElements [ + + presenter + selectPaths: {#(1 3) . #(2 2)}; + selectPaths: {#(50) . #(60 2)}. + self assert: (presenter selection includesItems: #(10 6)) +] + +{ #category : #'tests-select-index' } +SpTreeTablePresenterMultipleSelectionTest >> testSelectPathsThenSelectInvalidPathKeepsPaths [ + | paths | + paths := {#(1 3) . #(2 2)}. + presenter + selectPaths: paths; + selectPaths: {#(50) . #(60 2)}. + self assert: (presenter selection includesPaths: paths) +] + +{ #category : #'tests-select-index' } +SpTreeTablePresenterMultipleSelectionTest >> testSelectPathsTwiceAddsPathssToSelectedPathListOnlyOnce [ + | paths | + paths := {#(1 3) . #(2 2)}. + presenter + selectPaths: paths; + selectPaths: paths. + self + assertCollection: presenter selection selectedPaths + hasSameElements: paths +] + +{ #category : #'tests-select-index' } +SpTreeTablePresenterMultipleSelectionTest >> testSetSelectInvalidPathDoesNotModifySelection [ + + presenter whenSelectionChangedDo: [ :selection | self fail ]. + + presenter selectPath: #(50 1). + "If we arrive here and the test did not fail, we succeeded". +] + +{ #category : #'tests-select-item' } +SpTreeTablePresenterMultipleSelectionTest >> testSetSelectItemOutsideRangeDoesNotModifySelection [ + + presenter whenSelectionChangedDo: [ :selection | self fail ]. + + presenter selectItem: 1000. + "If we arrive here and the test did not fail, we succeeded" +] + +{ #category : #'tests-select-index' } +SpTreeTablePresenterMultipleSelectionTest >> testSetSelectPathRaisesSelectionChangeEventWithSelectedItem [ + | selectedItems | + presenter + whenSelectionChangedDo: [ :selection | selectedItems := selection selectedItems ]. + + presenter selectPath: #(1 3). + + self assert: (selectedItems includes: 10) +] + +{ #category : #'tests-unselect-index' } +SpTreeTablePresenterMultipleSelectionTest >> testUnselectAllRaisesSelectionEventOnce [ + "Because it does nothing in single selection mode" + + | nbEvents | + nbEvents := 0. + + "Be sure there is one element selected at least to make selection change" + presenter selectPath: #(1 1). + presenter + whenSelectionChangedDo: [ :selection | nbEvents := nbEvents + 1 ]. + + presenter unselectAll. + + self assert: nbEvents equals: 1 +] + +{ #category : #'tests-unselect-index' } +SpTreeTablePresenterMultipleSelectionTest >> testUnselectAllUnselectsall [ + + presenter + selectPath: #(1 2); + unselectAll. + + self assert: presenter selection isEmpty +] + +{ #category : #'tests-unselect-item' } +SpTreeTablePresenterMultipleSelectionTest >> testUnselectSelectedItemRaisesSelectionEventOnce [ + + | counter | + counter := 0. + presenter + selectItem: 10; + whenSelectionChangedDo: [ counter := counter + 1 ]; + unselectItem: 10. + self assert: counter equals: 1 +] + +{ #category : #'tests-unselect-item' } +SpTreeTablePresenterMultipleSelectionTest >> testUnselectSelectedItemRemovesItFromSelectionList [ + + presenter + selectItem: 10; + unselectItem: 10. + self assert: (presenter selection isEmpty) +] + +{ #category : #'tests-unselect-index' } +SpTreeTablePresenterMultipleSelectionTest >> testUnselectSelectedPathRaisesSelectionEventOnce [ + + | counter | + counter := 0. + presenter + selectPath: #(1 2); + whenSelectionChangedDo: [ counter := counter + 1 ]; + unselectPath: #(1 2). + + self assert: counter equals: 1 +] + +{ #category : #'tests-unselect-index' } +SpTreeTablePresenterMultipleSelectionTest >> testUnselectSelectedPathRemovesItFromSelectionList [ + + presenter + selectPath: #(1 2); + unselectPath: #(1 2). + self assert: (presenter selection isEmpty) +] + +{ #category : #'tests-unselect-item' } +SpTreeTablePresenterMultipleSelectionTest >> testUnselectUnselectedItemKeepsSelectionList [ + + presenter + selectItem: 10; + unselectItem: 20. + self assert: presenter selection selectedItems asArray equals: #(10) +] + +{ #category : #'tests-unselect-item' } +SpTreeTablePresenterMultipleSelectionTest >> testUnselectUnselectedItemRaisesNoSelectionEvent [ + + | counter | + counter := 0. + presenter + selectItem: 10; + whenSelectionChangedDo: [ counter := counter + 1 ]; + unselectItem: 20. + self assert: counter equals: 0 +] + +{ #category : #'tests-unselect-index' } +SpTreeTablePresenterMultipleSelectionTest >> testUnselectUnselectedPathKeepsSelectionList [ + + presenter + selectPath: #(1 2); + unselectPath: #(2 2). + self + assert: presenter selection selectedPaths + equals: { #(1 2) } +] + +{ #category : #'tests-unselect-index' } +SpTreeTablePresenterMultipleSelectionTest >> testUnselectUnselectedPathRaisesNoSelectionEvent [ + + | counter | + counter := 0. + presenter + selectPath: #(1 2); + whenSelectionChangedDo: [ counter := counter + 1 ]; + unselectPath: #(2 2). + + self assert: counter equals: 0 +] diff --git a/src/Spec2-Tests/SpTreeTablePresenterSingleSelectionTest.class.st b/src/Spec2-Tests/SpTreeTablePresenterSingleSelectionTest.class.st new file mode 100644 index 00000000000..fe7dc461dc4 --- /dev/null +++ b/src/Spec2-Tests/SpTreeTablePresenterSingleSelectionTest.class.st @@ -0,0 +1,352 @@ +Class { + #name : #SpTreeTablePresenterSingleSelectionTest, + #superclass : #SpTest, + #category : #'Spec2-Tests-Core-Widgets' +} + +{ #category : #running } +SpTreeTablePresenterSingleSelectionTest >> classToTest [ + ^ SpTreeTablePresenter +] + +{ #category : #running } +SpTreeTablePresenterSingleSelectionTest >> setUp [ + super setUp. + + super setUp. + presenter + addColumn: (SpStringTableColumn title: 'Value' evaluated: #printString); + beSingleSelection; + roots: #(1 2 3); + children: [ :aNumber | + aNumber < 100 + ifTrue: [ { aNumber * 2. aNumber * 3. aNumber * 10 } ] + ifFalse: [ #() ] ]; + yourself. +] + +{ #category : #'tests-select-item' } +SpTreeTablePresenterSingleSelectionTest >> testSelectItemOutsideRangeUnsetsSelectedItem [ + + presenter selectItem: 4000. + self assert: presenter selection selectedItem equals: nil +] + +{ #category : #'tests-select-item' } +SpTreeTablePresenterSingleSelectionTest >> testSelectItemOutsideRangeUnsetsSelectedPath [ + + presenter selectItem: 4000. + + self + assert: presenter selection selectedPath equals: #() +] + +{ #category : #'tests-select-item' } +SpTreeTablePresenterSingleSelectionTest >> testSelectItemSetsSelectedItem [ + presenter selectItem: 20. + self assert: presenter selection selectedItem equals: 20 +] + +{ #category : #'tests-select-item' } +SpTreeTablePresenterSingleSelectionTest >> testSelectItemSetsSelectedPath [ + + presenter selectItem: 20. + self assert: presenter selection selectedPath equals: #(1 1 3) +] + +{ #category : #'tests-select-index' } +SpTreeTablePresenterSingleSelectionTest >> testSelectMultiplePathsRaisesSelectionChangeEventMultipleTimes [ + | events | + events := 0. + presenter whenSelectionChangedDo: [ :selection | events := events + 1 ]. + + presenter selectPath: #(1). + presenter selectPath: #(1 3). + + self assert: events equals: 2 +] + +{ #category : #'tests-select-index' } +SpTreeTablePresenterSingleSelectionTest >> testSelectPathOutsideRangeUnsetsSelectedItem [ + presenter selectPath: { 4 }. + + self + assert: presenter selection selectedItem + equals: nil +] + +{ #category : #'tests-select-index' } +SpTreeTablePresenterSingleSelectionTest >> testSelectPathOutsideRangeUnsetsSelectedPath [ + presenter selectPath: #(4). + + self + assert: presenter selection selectedPath + equals: #() +] + +{ #category : #'tests-select-index' } +SpTreeTablePresenterSingleSelectionTest >> testSelectPathSetsSelectedItem [ + + presenter selectPath: #(1 3). + + self + assert: presenter selection selectedItem + equals: 10 +] + +{ #category : #'tests-select-index' } +SpTreeTablePresenterSingleSelectionTest >> testSelectPathSetsSelectedPath [ + + presenter selectPath: #(1 1). + + self + assert: presenter selection selectedPath + equals: #(1 1) +] + +{ #category : #'tests-select-item' } +SpTreeTablePresenterSingleSelectionTest >> testSetSelectItemOutsideRangeRaisesSelectionChangeEventWithUnsetItem [ + | selectedItem | + presenter + whenSelectionChangedDo: [ :selection | selectedItem := selection selectedItem ]. + presenter selectItem: 4000. + self assert: selectedItem equals: nil +] + +{ #category : #'tests-select-item' } +SpTreeTablePresenterSingleSelectionTest >> testSetSelectItemOutsideRangeRaisesSelectionChangeEventWithUnsetPath [ + | selectedPath | + + presenter + whenSelectionChangedDo: [ :selection | selectedPath := selection selectedPath ]. + presenter selectItem: 4000. + self assert: selectedPath equals: #() +] + +{ #category : #'tests-select-item' } +SpTreeTablePresenterSingleSelectionTest >> testSetSelectItemRaisesSelectionChangeEventWithSelectedItem [ + | selectedElement | + presenter + whenSelectionChangedDo: [ :selection | selectedElement := selection selectedItem ]. + presenter selectItem: 20. + self assert: selectedElement equals: 20 +] + +{ #category : #'tests-select-item' } +SpTreeTablePresenterSingleSelectionTest >> testSetSelectItemRaisesSelectionChangeEventWithSelectedPath [ + | selectedPath | + + presenter + whenSelectionChangedDo: [ :selection | selectedPath := selection selectedPath ]. + presenter selectItem: 20. + + self assert: selectedPath equals: #(1 1 3) +] + +{ #category : #'tests-select-item' } +SpTreeTablePresenterSingleSelectionTest >> testSetSelectItemRaisesSelectionItemChangeEventWithSelectedItem [ + | selectedItem | + presenter + whenSelectionChangedDo: [ :selection | selectedItem := selection selectedItem ]. + presenter selectItem: 10. + self assert: selectedItem equals: 10 +] + +{ #category : #'tests-select-item' } +SpTreeTablePresenterSingleSelectionTest >> testSetSelectItemRaisesSelectionPathChangeEventWithSelectedPath [ + | selectedPath | + + presenter selection + whenChangedDo: [ :selection | selectedPath := selection ]. + presenter selectItem: 10. + + self assert: selectedPath equals: #(1 3) +] + +{ #category : #'tests-select-index' } +SpTreeTablePresenterSingleSelectionTest >> testSetSelectPathOutsideRangeRaisesSelectionChangeEventWithUnsetItem [ + | selectedItem | + presenter + whenSelectionChangedDo: [ :selection | selectedItem := selection selectedItem ]. + presenter selectPath: #(4). + + self assert: selectedItem equals: nil +] + +{ #category : #'tests-select-index' } +SpTreeTablePresenterSingleSelectionTest >> testSetSelectPathOutsideRangeRaisesSelectionChangeEventWithUnsetPath [ + | selectedPath | + presenter + whenSelectionChangedDo: [ :selection | selectedPath := selection selectedPath ]. + presenter selectPath: #(4). + + self assert: selectedPath equals: nil +] + +{ #category : #'tests-select-index' } +SpTreeTablePresenterSingleSelectionTest >> testSetSelectPathRaisesSelectionChangeEventWithSelectedItem [ + | selectedElement | + + presenter + whenSelectionChangedDo: [ :selection | selectedElement := selection selectedItem ]. + presenter selectPath: #(1 3). + + self assert: selectedElement equals: 10 +] + +{ #category : #'tests-select-index' } +SpTreeTablePresenterSingleSelectionTest >> testSetSelectPathRaisesSelectionChangeEventWithSelectedPath [ + | selectedPath | + presenter + whenSelectionChangedDo: [ :selection | selectedPath := selection selectedPath ]. + presenter selectPath: #(1 2). + + self assert: selectedPath equals: #(1 2). +] + +{ #category : #'tests-select-index' } +SpTreeTablePresenterSingleSelectionTest >> testSetSelectPathRaisesSelectionItemChangeEventWithSelectedItem [ + | selectedItem | + presenter + whenSelectionChangedDo: [ :selection | selectedItem := selection selectedItem ]. + presenter selectPath: #(1 3). + + self + assert: selectedItem + equals: 10 +] + +{ #category : #'tests-select-index' } +SpTreeTablePresenterSingleSelectionTest >> testSetSelectPathRaisesSelectionPathChangeEventWithSelectedPath [ + | selectedPath | + presenter selection + whenChangedDo: [ :selection | selectedPath := selection ]. + presenter selectPath: #(1 2). + + self assert: selectedPath equals: #(1 2) +] + +{ #category : #'tests-unselect-index' } +SpTreeTablePresenterSingleSelectionTest >> testUnselectAllRaisesSelectionEventOnce [ + "Because it does nothing in single selection mode" + | events | + events := 0. + presenter whenSelectionChangedDo: [ :selection | events := events + 1 ]. + + presenter unselectAll. + + self assert: events equals: 1 +] + +{ #category : #'tests-unselect-index' } +SpTreeTablePresenterSingleSelectionTest >> testUnselectAllUnselectsSingleSelection [ + + presenter + selectPath: #(1 1); + unselectAll. + self assert: presenter selection isEmpty +] + +{ #category : #'tests-unselect-item' } +SpTreeTablePresenterSingleSelectionTest >> testUnselectNonSelectedItemDoesNotRemovesSelection [ + presenter + selectItem: 10; + unselectItem: 30. + + self + assert: presenter selection selectedItem + equals: 10 +] + +{ #category : #'tests-unselect-item' } +SpTreeTablePresenterSingleSelectionTest >> testUnselectNonSelectedItemRaisesNoEvent [ + + | counter | + counter := 0. + presenter + selectItem: 10; + whenSelectionChangedDo: [ counter := counter + 1 ]; + unselectItem: 20. + + self assert: counter equals: 0 +] + +{ #category : #'tests-unselect-index' } +SpTreeTablePresenterSingleSelectionTest >> testUnselectNonSelectedPathDoesNotRemovesSelection [ + presenter + selectPath: #(1 1); + unselectPath: #(1 3). + + self + assert: presenter selection selectedPath + equals: #(1 1) +] + +{ #category : #'tests-unselect-index' } +SpTreeTablePresenterSingleSelectionTest >> testUnselectNonSelectedPathRaisesNoEvent [ + + | counter | + counter := 0. + presenter + selectPath: #(1 1); + whenSelectionChangedDo: [ counter := counter + 1 ]; + unselectPath: #(2 1). + + self assert: counter equals: 0 +] + +{ #category : #'tests-unselect-item' } +SpTreeTablePresenterSingleSelectionTest >> testUnselectSelectedItemRaisesSingleEvent [ + + | counter | + counter := 0. + presenter + selectItem: 10; + whenSelectionChangedDo: [ counter := counter + 1 ]; + unselectItem: 10. + + self assert: counter equals: 1 +] + +{ #category : #'tests-unselect-item' } +SpTreeTablePresenterSingleSelectionTest >> testUnselectSelectedItemRemovesSelection [ + + presenter + selectItem: 10; + unselectItem: 10. + + self assert: presenter selection isEmpty +] + +{ #category : #'tests-unselect-index' } +SpTreeTablePresenterSingleSelectionTest >> testUnselectSelectedPathRaisesSingleEvent [ + + | counter | + counter := 0. + presenter + selectPath: #(1 1); + whenSelectionChangedDo: [ counter := counter + 1 ]; + unselectPath: #(1 1). + + self assert: counter equals: 1 +] + +{ #category : #'tests-unselect-index' } +SpTreeTablePresenterSingleSelectionTest >> testUnselectSelectedPathRemovesSelection [ + presenter + selectPath: #(1 1); + unselectPath: #(1 1). + + self assert: presenter selection isEmpty +] + +{ #category : #'tests-select-index' } +SpTreeTablePresenterSingleSelectionTest >> testWhenSelectPathTwiceThenIsListedOnceInSelectedPaths [ + presenter + selectPath: #(3 1); + selectPath: #(3 1). + + self + assertCollection: presenter selection selectedPaths + hasSameElements: { #(3 1) } +] diff --git a/src/Spec2-Tools/KeymapBrowser.class.st b/src/Spec2-Tools/KeymapBrowser.class.st index 130a2ec3d41..5affc68313f 100644 --- a/src/Spec2-Tools/KeymapBrowser.class.st +++ b/src/Spec2-Tools/KeymapBrowser.class.st @@ -9,8 +9,7 @@ Class { #instVars : [ 'clearFilterButton', 'filterField', - 'kmTable', - 'contextMenuPresenter' + 'kmTable' ], #category : #'Spec2-Tools-Keymapping' } @@ -48,11 +47,14 @@ KeymapBrowser class >> taskbarIconName [ { #category : #private } KeymapBrowser >> browseDefinitionOfSelectedShortcut [ | selection action class selector | - selection := self kmTable selectedItem ifNil: [ ^ self ]. + selection := self kmTable selection selectedItem ifNil: [ ^ self ]. action := selection realValue keymap action ifNil: [ ^ self ]. class := action method methodClass. selector := action method selector. - Smalltalk tools browser openOnClass: class selector: selector highlight: selection shortcutName + Smalltalk tools browser + openOnClass: class + selector: selector + highlight: selection shortcutName ] { #category : #accessing } @@ -96,16 +98,13 @@ KeymapBrowser >> initialExtent [ { #category : #initialization } KeymapBrowser >> initializePresenters [ - self initiliazeContextMenu. - kmTable := self newTable. kmTable addColumn: (SpStringTableColumn title: 'Shortcut' evaluated: [ :aKMShortcutDeclaration | aKMShortcutDeclaration realValue shortcut asString ]); addColumn: (SpStringTableColumn title: 'Name' evaluated: #shortcutName); addColumn: (SpStringTableColumn title: 'Category' evaluated: #categoryName); beResizable; - contextMenu: contextMenuPresenter. - + menu: [ :m :s | self menu: m shifted: s ]. filterField := self newTextInput. filterField removeEntryCompletion; @@ -118,38 +117,10 @@ KeymapBrowser >> initializePresenters [ self collectAllShortcuts ] -{ #category : #initialization } -KeymapBrowser >> initiliazeContextMenu [ - contextMenuPresenter := self newMenu. - - contextMenuPresenter - addItem: [ :anItem | - anItem - name: 'Refresh'; - action: [ self collectAllShortcuts ]; - icon: (self iconNamed: #smallUpdateIcon)]. - - contextMenuPresenter - addItem: [ :anItem | - anItem - name: 'Browse Definition'; - action: [ self browseDefinitionOfSelectedShortcut ]; - state: [ self kmTable selection selectedItem isNotNil ]; - icon: (self iconNamed: #smallSystemBrowserIcon)]. - - contextMenuPresenter - addItem: [ :anItem | - anItem - name: 'Inspect Action'; - action: [ self inspectActionOfSelectedShortcut ]; - state: [ self kmTable selection selectedItem isNotNil ]; - icon: (self iconNamed: #smallInspectItIcon)]. -] - { #category : #private } KeymapBrowser >> inspectActionOfSelectedShortcut [ - | selection action | - selection := self kmTable selectedItem ifNil: [ ^ self ]. + | selection action | + selection := self kmTable selection selectedItem ifNil: [ ^ self ]. action := selection realValue keymap ifNil: [ ^ self ]. action inspect ] @@ -164,6 +135,24 @@ KeymapBrowser >> kmTable: anObject [ kmTable := anObject ] +{ #category : #private } +KeymapBrowser >> menu: aMenu shifted: aBoolean [ + (aMenu add: 'Refresh' target: self selector: #collectAllShortcuts) + icon: (self iconNamed: #smallUpdateIcon). + self kmTable selection selectedItem ifNil: [ ^ aMenu ]. + (aMenu + add: 'Browse Definition' + target: self + selector: #browseDefinitionOfSelectedShortcut) + icon: (self iconNamed: #smallSystemBrowserIcon). + (aMenu + add: 'Inspect Action' + target: self + selector: #inspectActionOfSelectedShortcut) + icon: (self iconNamed: #smallInspectItIcon). + ^ aMenu +] + { #category : #private } KeymapBrowser >> setFilter: aFilterText [ aFilterText diff --git a/src/Spec2-Tools/MessageBrowser.class.st b/src/Spec2-Tools/MessageBrowser.class.st index f29f8a5f4de..3edbde1edf7 100644 --- a/src/Spec2-Tools/MessageBrowser.class.st +++ b/src/Spec2-Tools/MessageBrowser.class.st @@ -13,8 +13,7 @@ Class { #superclass : #AbstractMessageCentricBrowser, #instVars : [ 'textModel', - 'refreshingBlock', - 'title' + 'refreshingBlock' ], #category : #'Spec2-Tools-Senders' } @@ -177,11 +176,6 @@ MessageBrowser >> connectPresenters [ textModel acceptBlock: [ :text :notifyer | (self accept: text notifying: notifyer) notNil ] ] -{ #category : #private } -MessageBrowser >> defaultTitle [ - ^ self class title , ' [' , messageList numberOfElements printString , ']' -] - { #category : #'text selection' } MessageBrowser >> findFirstOccurrenceOf: searchedString in: textToSearchIn [ "Return the first index of aString in textToSearchIn " @@ -550,14 +544,7 @@ MessageBrowser >> textModel: aModel [ { #category : #private } MessageBrowser >> title [ - ^ title ifNil: [ self defaultTitle ] - -] - -{ #category : #private } -MessageBrowser >> title: aString [ - title := aString. - self updateTitle + ^ self class title , ' [' , messageList numberOfElements printString , ']' ] { #category : #accessing } diff --git a/src/Spec2-Tools/SpChooseMethodUI.class.st b/src/Spec2-Tools/SpChooseMethodUI.class.st index e7c92bb6950..e6760eb7c1e 100644 --- a/src/Spec2-Tools/SpChooseMethodUI.class.st +++ b/src/Spec2-Tools/SpChooseMethodUI.class.st @@ -227,9 +227,11 @@ SpChooseMethodUI >> protocolList [ SpChooseMethodUI >> protocolListAction [ protocolList transmitTo: methodList - transform: - [ :selectedProtocol | selectedProtocol - ifNotNil: [ (selectedProtocol methods collect: [ :methodSelector | self methodNamed: methodSelector ]) asOrderedCollection ] + transform: [ :selectedProtocol | + selectedProtocol + ifNotNil: [ (selectedProtocol methodSelectors + collect: [ :methodSelector | self methodNamed: methodSelector ]) + asOrderedCollection ] ifNil: [ #() ] ] postTransmission: [ :methodPresenter | methodPresenter selectIndex: 1 ] ] diff --git a/src/Spec2-Transmission/SpAbstractSelectionMode.extension.st b/src/Spec2-Transmission/SpAbstractSelectionMode.extension.st new file mode 100644 index 00000000000..b55ae426dd5 --- /dev/null +++ b/src/Spec2-Transmission/SpAbstractSelectionMode.extension.st @@ -0,0 +1,6 @@ +Extension { #name : #SpAbstractSelectionMode } + +{ #category : #'*Spec2-Transmission' } +SpAbstractSelectionMode >> transmission [ + self subclassResponsibility +] diff --git a/src/Spec2-Transmission/SpAbstractTreeSelectionMode.extension.st b/src/Spec2-Transmission/SpAbstractTreeSelectionMode.extension.st new file mode 100644 index 00000000000..7c672cb2f3c --- /dev/null +++ b/src/Spec2-Transmission/SpAbstractTreeSelectionMode.extension.st @@ -0,0 +1,6 @@ +Extension { #name : #SpAbstractTreeSelectionMode } + +{ #category : #'*Spec2-Transmission' } +SpAbstractTreeSelectionMode >> transmission [ + self subclassResponsibility +] diff --git a/src/Spec2-Transmission/SpMultipleSelectionMode.extension.st b/src/Spec2-Transmission/SpMultipleSelectionMode.extension.st new file mode 100644 index 00000000000..1505da574b4 --- /dev/null +++ b/src/Spec2-Transmission/SpMultipleSelectionMode.extension.st @@ -0,0 +1,7 @@ +Extension { #name : #SpMultipleSelectionMode } + +{ #category : #'*Spec2-Transmission' } +SpMultipleSelectionMode >> transmission [ + + ^ self selectedItems +] diff --git a/src/Spec2-Transmission/SpSelectionPort.class.st b/src/Spec2-Transmission/SpSelectionPort.class.st index 87f94b0910f..d392fea5c9a 100644 --- a/src/Spec2-Transmission/SpSelectionPort.class.st +++ b/src/Spec2-Transmission/SpSelectionPort.class.st @@ -20,5 +20,5 @@ SpSelectionPort >> attachTransmission: aTransmission [ self destinationPresenter whenSelectionChangedDo: [ :selection | self transmitWith: aTransmission - value: selection selectedItem ] + value: selection transmission ] ] diff --git a/src/Spec2-Transmission/SpSingleSelectionMode.extension.st b/src/Spec2-Transmission/SpSingleSelectionMode.extension.st new file mode 100644 index 00000000000..b363d2fd602 --- /dev/null +++ b/src/Spec2-Transmission/SpSingleSelectionMode.extension.st @@ -0,0 +1,7 @@ +Extension { #name : #SpSingleSelectionMode } + +{ #category : #'*Spec2-Transmission' } +SpSingleSelectionMode >> transmission [ + + ^ self selectedItem +] diff --git a/src/Spec2-Transmission/SpTreeMultipleSelectionMode.extension.st b/src/Spec2-Transmission/SpTreeMultipleSelectionMode.extension.st new file mode 100644 index 00000000000..08fa44bba5c --- /dev/null +++ b/src/Spec2-Transmission/SpTreeMultipleSelectionMode.extension.st @@ -0,0 +1,7 @@ +Extension { #name : #SpTreeMultipleSelectionMode } + +{ #category : #'*Spec2-Transmission' } +SpTreeMultipleSelectionMode >> transmission [ + + ^ self selectedItems +] diff --git a/src/Spec2-Transmission/SpTreeSingleSelectionMode.extension.st b/src/Spec2-Transmission/SpTreeSingleSelectionMode.extension.st new file mode 100644 index 00000000000..42c6efdc86c --- /dev/null +++ b/src/Spec2-Transmission/SpTreeSingleSelectionMode.extension.st @@ -0,0 +1,7 @@ +Extension { #name : #SpTreeSingleSelectionMode } + +{ #category : #'*Spec2-Transmission' } +SpTreeSingleSelectionMode >> transmission [ + + ^ self selectedItem +] diff --git a/src/System-DependenciesTests/SystemDependenciesTest.class.st b/src/System-DependenciesTests/SystemDependenciesTest.class.st index c48505ca664..b291d9fd25f 100644 --- a/src/System-DependenciesTests/SystemDependenciesTest.class.st +++ b/src/System-DependenciesTests/SystemDependenciesTest.class.st @@ -208,7 +208,7 @@ SystemDependenciesTest >> testExternalBasicToolsDependencies [ { BaselineOfMenuRegistration name }, BaselineOfMenuRegistration allPackageNames, { BaselineOfUI name }, BaselineOfUI allPackageNames, { BaselineOfSpec name }, BaselineOfSpec allPackageNames, - { BaselineOfCommander2 name }, BaselineOfCommander2 allPackageNames, + { BaselineOfCommander2 name }, (BaselineOfCommander2 deepPackagesOfGroupNamed: #default), { BaselineOfSpec2 name }, BaselineOfSpec2 allPackageNames, { BaselineOfBasicTools name }, BaselineOfBasicTools allPackageNames, { BaselineOfFuel name }, (BaselineOfFuel packagesOfGroupNamed: #Core) ). @@ -281,7 +281,6 @@ SystemDependenciesTest >> testExternalIDEDependencies [ BaselineOfMorphicCore. BaselineOfSlot. BaselineOfSpec. - BaselineOfCommander2. BaselineOfSpec2. BaselineOfParametrizedTests. BaselineOfSUnit. @@ -317,6 +316,7 @@ SystemDependenciesTest >> testExternalIDEDependencies [ } do: [ :baseline | packages := packages , {baseline name} , baseline allPackageNames ]. packages := packages , { BaselineOfCommander name} , (self packagesOfGroupNamed: 'default' on: BaselineOfCommander). + packages := packages , { BaselineOfCommander2 name} , (self packagesOfGroupNamed: 'default' on: BaselineOfCommander2). packages := packages , { BaselineOfIceberg name. BaselineOfLibGit name. BaselineOfCalypso name}. packages := packages , (self packagesOfGroupNamed: 'FullEnvironment' on: BaselineOfCalypso ). @@ -499,11 +499,10 @@ SystemDependenciesTest >> testExternalSpec2Dependencies [ BaselineOfMenuRegistration allPackageNames, (BaselineOfFuel packagesOfGroupNamed: #Core), - BaselineOfCommander2 allPackageNames, + (BaselineOfCommander2 deepPackagesOfGroupNamed: #default), BaselineOfSpec2 allPackageNames, - "Tests" BaselineOfSUnit defaultPackageNames, BaselineOfParametrizedTests allPackageNames)) @@ -547,7 +546,7 @@ SystemDependenciesTest >> testExternalUIDependencies [ BaselineOfMorphicCore allPackageNames, BaselineOfMorphic allPackageNames, BaselineOfSpec allPackageNames, - BaselineOfCommander2 allPackageNames, + (BaselineOfCommander2 deepPackagesOfGroupNamed: #default), BaselineOfSpec2 allPackageNames, BaselineOfUI allPackageNames, BaselineOfMenuRegistration allPackageNames, diff --git a/src/Tool-Registry/PharoCommonTools.class.st b/src/Tool-Registry/PharoCommonTools.class.st index 147db0d1b0b..a4c74c4d43e 100644 --- a/src/Tool-Registry/PharoCommonTools.class.st +++ b/src/Tool-Registry/PharoCommonTools.class.st @@ -48,6 +48,7 @@ PharoCommonTools class >> settingsOn: aBuilder [ getSelector: #browserTool; setSelector: #browserTool:; label: 'Systembrowser'; + default: (Smalltalk at: #ClyFullBrowser); domainValues: Smalltalk tools recentBrowserTools ]; with: [ (aBuilder pickOne: #inspectorTool) @@ -65,6 +66,7 @@ PharoCommonTools class >> settingsOn: aBuilder [ getSelector: #workspaceTool; setSelector: #workspaceTool:; label: 'Workspace'; + default: (Smalltalk at: #GTPlayground); domainValues: Smalltalk tools recentWorkspaceTools ]; with: [ (aBuilder pickOne: #debuggerTool) @@ -90,6 +92,7 @@ PharoCommonTools class >> settingsOn: aBuilder [ target: Smalltalk; targetSelector: #tools; label: 'Filelist'; + default: (Smalltalk at: #FileList); domainValues: Smalltalk tools recentFileListTools]; with: [ (aBuilder pickOne: #changeSorterTool)