diff --git a/.smalltalk.all.ston b/.smalltalk.all.ston index 1439f921e..b476c2e05 100644 --- a/.smalltalk.all.ston +++ b/.smalltalk.all.ston @@ -22,6 +22,7 @@ SmalltalkCISpec { 'Monticello.*', 'Metacello.*', 'System-Settings-Tests.*', + 'System-Dependencies-Tests', 'RPackage.*', 'ReleaseTests.*' ], #classes : [ diff --git a/.smalltalk.release.ston b/.smalltalk.release.ston index 44b82202e..589df1fe2 100644 --- a/.smalltalk.release.ston +++ b/.smalltalk.release.ston @@ -13,6 +13,7 @@ SmalltalkCISpec { #testing : { #packages : [ 'System-Settings-Tests.*', + 'System-Dependencies-Tests', 'ReleaseTests.*' ] } } diff --git a/src/BaselineOfSpec2/BaselineOfSpec2.class.st b/src/BaselineOfSpec2/BaselineOfSpec2.class.st index 38a12817c..ea19f2348 100644 --- a/src/BaselineOfSpec2/BaselineOfSpec2.class.st +++ b/src/BaselineOfSpec2/BaselineOfSpec2.class.st @@ -17,6 +17,7 @@ BaselineOfSpec2 >> baseline: spec [ spec "Core" package: 'Spec2-Adapters-Morphic' with: [ spec requires: #('SpecCore') ]; + package: 'Spec2-Adapters-Morphic-ListView' with: [ spec requires: #('SpecCore' 'Spec2-Adapters-Morphic') ]; package: 'Spec2-Code-Morphic' with: [ spec requires: #('Spec2-Adapters-Morphic') ]; package: 'Spec2-Code-Diff-Morphic' with: [ spec requires: #('Spec2-Adapters-Morphic') ]; package: 'Spec2-Morphic' with: [ spec requires: #('Spec2-Adapters-Morphic') ]; @@ -31,7 +32,7 @@ BaselineOfSpec2 >> baseline: spec [ package: 'Spec2-Microdown' with: [ spec requires: #('SpecCore' 'Spec2-Adapters-Morphic') ]; package: 'Spec2-Transformations' ]. - spec group: 'Core' with: #('SpecCore' 'Spec2-Microdown' 'Spec2-Morphic' 'Spec2-Adapters-Morphic'). + spec group: 'Core' with: #('SpecCore' 'Spec2-Microdown' 'Spec2-Morphic' 'Spec2-Adapters-Morphic' 'Spec2-Adapters-Morphic-ListView'). spec group: 'Code' with: #('Core' 'SpecCoreCode' 'Spec2-Code-Morphic' 'Spec2-Code-Diff-Morphic'). spec group: 'CodeTests' with: #('Code' 'Spec2-Code-Backend-Tests'). spec group: 'Support' with: #('Core' 'Spec2-Morphic-Examples'). diff --git a/src/BaselineOfSpecCore/BaselineOfSpecCore.class.st b/src/BaselineOfSpecCore/BaselineOfSpecCore.class.st index 68f89d33c..f1dfa7ab2 100644 --- a/src/BaselineOfSpecCore/BaselineOfSpecCore.class.st +++ b/src/BaselineOfSpecCore/BaselineOfSpecCore.class.st @@ -23,6 +23,8 @@ BaselineOfSpecCore >> baseline: spec [ package: 'Spec2-Transmission' with: [ spec requires: #('Spec2-Core') ]; package: 'Spec2-Interactions' with: [ spec requires: #('Spec2-Core') ]; package: 'Spec2-Commander2' with: [ spec requires: #('Spec2-Core' 'Spec2-Interactions') ]; + "ListView" + package: 'Spec2-ListView' with: [ spec requires: #('Spec2-Core') ]; "Code" package: 'Spec2-Code' with: [ spec requires: #('Spec2-Core' 'Spec2-Commands') ]; package: 'Spec2-Code-Commands' with: [ spec requires: #('Spec2-Core' 'Spec2-Commands') ]; @@ -34,6 +36,7 @@ BaselineOfSpecCore >> baseline: spec [ package: 'Spec2-Adapters-Stub' with: [ spec requires: #('Spec2-Core') ]; package: 'Spec2-Commander2-Tests' with: [ spec requires: #('Spec2-Commander2') ]; package: 'Spec2-Tests' with: [ spec requires: #('Spec2-Core' 'Spec2-Examples' 'Spec2-Dialogs-Tests') ]; + package: 'Spec2-ListView-Tests' with: [ spec requires: #('Spec2-ListView' 'Spec2-Tests') ]; package: 'Spec2-Code-Tests' with: [ spec requires: #('Spec2-Tests' 'Spec2-Code') ]; package: 'Spec2-Code-Diff-Tests' with: [ spec requires: #('Spec2-Tests' 'Spec2-Code-Diff') ]; "Examples" @@ -51,13 +54,14 @@ BaselineOfSpecCore >> baseline: spec [ 'Spec2-Core' 'Spec2-Dialogs' 'Spec2-CommandLine' - 'Spec2-Adapters-Stub' + 'Spec2-Adapters-Stub' + 'Spec2-ListView' 'Spec2-Interactions' 'Spec2-Commander2' ). spec group: 'Code' with: #('Core' 'Spec2-Code-Commands' 'Spec2-Code' 'Spec2-Code-Diff'). spec group: 'CodeTests' with: #('Spec2-Code-Tests' 'Spec2-Code-Diff-Tests'). spec group: 'Support' with: #('Core' 'Spec2-Examples'). - spec group: 'Tests' with: #('Core' 'Spec2-Tests' 'Spec2-Commander2-Tests'). + spec group: 'Tests' with: #('Core' 'Spec2-Tests' 'Spec2-Commander2-Tests' 'Spec2-ListView-Tests'). spec group: 'SupportTests' with: #('Support'). spec group: 'Pillar' with: #('Spec2-Pillar' ). spec group: 'Base' with: #('Core' 'Support'). diff --git a/src/Spec2-Adapters-Morphic-Alexandrie/SpAlexandrieMorph.class.st b/src/Spec2-Adapters-Morphic-Alexandrie/SpAlexandrieMorph.class.st index 8a3c2f2c3..6c1a31e4c 100644 --- a/src/Spec2-Adapters-Morphic-Alexandrie/SpAlexandrieMorph.class.st +++ b/src/Spec2-Adapters-Morphic-Alexandrie/SpAlexandrieMorph.class.st @@ -1,43 +1,48 @@ Class { - #name : #SpAlexandrieMorph, - #superclass : #Morph, + #name : 'SpAlexandrieMorph', + #superclass : 'Morph', #instVars : [ 'surface', 'drawBlock', 'lastExtent' ], - #category : #'Spec2-Adapters-Morphic-Alexandrie-Base' + #category : 'Spec2-Adapters-Morphic-Alexandrie-Base', + #package : 'Spec2-Adapters-Morphic-Alexandrie', + #tag : 'Base' } -{ #category : #accessing } +{ #category : 'accessing' } SpAlexandrieMorph >> drawBlock: aBlock [ drawBlock := aBlock ] -{ #category : #drawing } +{ #category : 'drawing' } SpAlexandrieMorph >> drawOn: aMorphicCanvas [ self redraw. - self surface - displayOnMorphicCanvas: aMorphicCanvas - at: bounds origin + aMorphicCanvas + image: self surface asForm + at: self position + sourceRect: (0@0 extent: self extent) + rule: 34 ] -{ #category : #drawing } +{ #category : 'drawing' } SpAlexandrieMorph >> redraw [ + | context | - self surface drawDuring: [ :canvas | - drawBlock - cull: canvas - cull: (0@0 extent: self extent) ] + context := self surface newContext. + drawBlock + cull: context + cull: (0@0 extent: self extent) ] -{ #category : #accessing } +{ #category : 'accessing' } SpAlexandrieMorph >> surface [ lastExtent = self extent ifFalse: [ surface := nil ]. ^ surface ifNil: [ lastExtent := self extent. - surface := AthensCairoSurface extent: self extent ] + surface := AeCairoImageSurface extent: self extent ] ] diff --git a/src/Spec2-Adapters-Morphic-Alexandrie/SpMorphicAlexandrieAdapter.class.st b/src/Spec2-Adapters-Morphic-Alexandrie/SpMorphicAlexandrieAdapter.class.st index eb663dcf7..b7e967767 100644 --- a/src/Spec2-Adapters-Morphic-Alexandrie/SpMorphicAlexandrieAdapter.class.st +++ b/src/Spec2-Adapters-Morphic-Alexandrie/SpMorphicAlexandrieAdapter.class.st @@ -1,14 +1,16 @@ Class { - #name : #SpMorphicAlexandrieAdapter, - #superclass : #SpAbstractMorphicAdapter, - #category : #'Spec2-Adapters-Morphic-Alexandrie-Base' + #name : 'SpMorphicAlexandrieAdapter', + #superclass : 'SpAbstractMorphicAdapter', + #category : 'Spec2-Adapters-Morphic-Alexandrie-Base', + #package : 'Spec2-Adapters-Morphic-Alexandrie', + #tag : 'Base' } -{ #category : #factory } +{ #category : 'factory' } SpMorphicAlexandrieAdapter >> buildWidget [ - | instance | - instance := SpAthensMorph new. + + instance := SpAlexandrieMorph new. self presenter whenDrawBlockChangedDo: [ :newBlock | instance drawBlock: newBlock ]. self presenter whenExtentChangedDo: [ :newExtent | @@ -21,13 +23,13 @@ SpMorphicAlexandrieAdapter >> buildWidget [ ^ instance ] -{ #category : #drawing } +{ #category : 'drawing' } SpMorphicAlexandrieAdapter >> redraw [ widget redraw ] -{ #category : #accessing } +{ #category : 'accessing' } SpMorphicAlexandrieAdapter >> surface [ ^ widget surface diff --git a/src/Spec2-Adapters-Morphic-Alexandrie/package.st b/src/Spec2-Adapters-Morphic-Alexandrie/package.st index 5422aea30..0db7df8a3 100644 --- a/src/Spec2-Adapters-Morphic-Alexandrie/package.st +++ b/src/Spec2-Adapters-Morphic-Alexandrie/package.st @@ -1 +1 @@ -Package { #name : #'Spec2-Adapters-Morphic-Alexandrie' } +Package { #name : 'Spec2-Adapters-Morphic-Alexandrie' } diff --git a/src/Spec2-Adapters-Morphic-ListView/SpMorphicListViewAdapter.class.st b/src/Spec2-Adapters-Morphic-ListView/SpMorphicListViewAdapter.class.st new file mode 100644 index 000000000..4c5878e18 --- /dev/null +++ b/src/Spec2-Adapters-Morphic-ListView/SpMorphicListViewAdapter.class.st @@ -0,0 +1,53 @@ +" +A morphic adapter for `SpListViewPresenter` +" +Class { + #name : 'SpMorphicListViewAdapter', + #superclass : 'SpMorphicListAdapter', + #category : 'Spec2-Adapters-Morphic-ListView', + #package : 'Spec2-Adapters-Morphic-ListView' +} + +{ #category : 'factory' } +SpMorphicListViewAdapter >> buildWidget [ + | datasource | + + datasource := self newDataSource. + datasource model: self model. + widget := self newTableWith: datasource. + + self presenter whenModelChangedDo: [ widget refresh ]. + self presenter whenSelectionChangedDo: [ self refreshWidgetSelection ]. + self presenter selection whenChangedDo: [ self refreshWidgetSelection ]. + + self refreshWidgetSelection. + self configureScrolling. + + ^ widget +] + +{ #category : 'factory' } +SpMorphicListViewAdapter >> newDataSource [ + + ^ SpMorphicListViewDataSource new +] + +{ #category : 'factory' } +SpMorphicListViewAdapter >> newTableWith: datasource [ + + ^ SpFTTableMorph new + beRowNotHomogeneous; + disableFunction; + dataSource: datasource; + hideColumnHeaders; + beResizable; + setMultipleSelection: self model isMultipleSelection; + dragEnabled: self dragEnabled; + dropEnabled: self dropEnabled; + setBalloonText: self help; + hResizing: #spaceFill; + vResizing: #spaceFill; + onAnnouncement: FTSelectionChanged send: #selectionChanged: to: self; + onAnnouncement: FTStrongSelectionChanged send: #strongSelectionChanged: to: self; + yourself +] diff --git a/src/Spec2-Adapters-Morphic-ListView/SpMorphicListViewDataSource.class.st b/src/Spec2-Adapters-Morphic-ListView/SpMorphicListViewDataSource.class.st new file mode 100644 index 000000000..a0a8659ba --- /dev/null +++ b/src/Spec2-Adapters-Morphic-ListView/SpMorphicListViewDataSource.class.st @@ -0,0 +1,46 @@ +" +A morphic datasource for `SpListViewPresenter`, to be used on the `SpMorphicListViewAdapter`. +" +Class { + #name : 'SpMorphicListViewDataSource', + #superclass : 'SpMorphicListDataSource', + #instVars : [ + 'rowHeights' + ], + #category : 'Spec2-Adapters-Morphic-ListView', + #package : 'Spec2-Adapters-Morphic-ListView' +} + +{ #category : 'accessing' } +SpMorphicListViewDataSource >> cellColumn: column row: rowIndex [ + | cell contentPresenter contentMorph | + + cell := FTCellMorph new. + + contentPresenter := self model setupAction value: self model. + self model bindAction + value: contentPresenter + value: (self elementAt: rowIndex). + + contentMorph := contentPresenter build. + + "register wor height" + rowHeights at: rowIndex put: contentMorph height. + + ^ cell addMorphBack: contentMorph +] + +{ #category : 'initialization' } +SpMorphicListViewDataSource >> initialize [ + + super initialize. + rowHeights := Dictionary new +] + +{ #category : 'accessing' } +SpMorphicListViewDataSource >> rowHeight: index [ + + ^ rowHeights + at: index + ifAbsent: [ super rowHeight: index ] +] diff --git a/src/Spec2-Adapters-Morphic-ListView/package.st b/src/Spec2-Adapters-Morphic-ListView/package.st new file mode 100644 index 000000000..6ccea4bf7 --- /dev/null +++ b/src/Spec2-Adapters-Morphic-ListView/package.st @@ -0,0 +1 @@ +Package { #name : 'Spec2-Adapters-Morphic-ListView' } diff --git a/src/Spec2-Adapters-Morphic-Tests/SpMorphicScrollableAdapterTest.class.st b/src/Spec2-Adapters-Morphic-Tests/SpMorphicScrollableAdapterTest.class.st index 8b15509cc..d1dbd7e77 100644 --- a/src/Spec2-Adapters-Morphic-Tests/SpMorphicScrollableAdapterTest.class.st +++ b/src/Spec2-Adapters-Morphic-Tests/SpMorphicScrollableAdapterTest.class.st @@ -1,81 +1,6 @@ Class { #name : 'SpMorphicScrollableAdapterTest', #superclass : 'TestCase', - #instVars : [ - 'scrollable', - 'presenter' - ], #category : 'Spec2-Adapters-Morphic-Tests', #package : 'Spec2-Adapters-Morphic-Tests' } - -{ #category : 'running' } -SpMorphicScrollableAdapterTest >> configureBasicContainer: aNumber [ - - | boxLayout widgets | - boxLayout := SpBoxLayout newVertical. - widgets := (1 to: aNumber) collect: [ : i | - boxLayout add: (SpButtonPresenter new label: i asString; yourself) ]. - - presenter := SpPresenter new - layout: (scrollable := SpScrollableLayout new - child:(SpPresenter new - layout: boxLayout; - yourself); - yourself); - yourself. - -] - -{ #category : 'running' } -SpMorphicScrollableAdapterTest >> tearDown [ - - presenter delete. - super tearDown. -] - -{ #category : 'tests' } -SpMorphicScrollableAdapterTest >> testVScrollToAfterOpen100SubPresenters [ - - | adapterWidget | - - self configureBasicContainer: 100. - presenter open. - scrollable withAdapterDo: [ : a | a widget height: 270 ]. - - self assert: presenter isDisplayed. - self assert: presenter isVisible. - - scrollable scrollTo: 0.1 @ 2. - adapterWidget := scrollable adapter widget. - self assert: adapterWidget vScrollbarValue closeTo: 0.74074074074074. - - scrollable scrollTo: 0.5 @ 2. - adapterWidget := scrollable adapter widget. - self assert: adapterWidget vScrollbarValue closeTo: 0.74074074074074 -] - -{ #category : 'tests' } -SpMorphicScrollableAdapterTest >> testVScrollToAfterOpen500SubPresenters [ - - | adapterWidget | - - self configureBasicContainer: 500. - presenter open. - scrollable withAdapterDo: [ : a | a widget height: 270 ]. - scrollable scrollTo: 0.1 @ 2. - adapterWidget := scrollable adapter widget. - self assert: adapterWidget vScrollbarValue closeTo: 0.74074074074074 -] - -{ #category : 'tests' } -SpMorphicScrollableAdapterTest >> testVScrollToBeforeOpen100SubPresenters [ - - | adapterWidget | - - self configureBasicContainer: 100. - scrollable scrollTo: 0.1 @ 2. - presenter open. - adapterWidget := scrollable adapter widget. - self assert: adapterWidget vScrollbarValue closeTo: 0.0 -] diff --git a/src/Spec2-Adapters-Morphic/SpAbstractMorphicAdapter.class.st b/src/Spec2-Adapters-Morphic/SpAbstractMorphicAdapter.class.st index aa40b32f8..f4c4ddae5 100644 --- a/src/Spec2-Adapters-Morphic/SpAbstractMorphicAdapter.class.st +++ b/src/Spec2-Adapters-Morphic/SpAbstractMorphicAdapter.class.st @@ -56,22 +56,12 @@ SpAbstractMorphicAdapter >> add: anAdapter [ self widgetDo: [ :w | w spEnsureLayoutAndAddMorph: anAdapter widget ] ] -{ #category : 'private' } -SpAbstractMorphicAdapter >> addContextMenuKeyBindings: aWidget [ - - self flag: #TODO. "Take this from a configuration" - self - bindKeyCombination: $t command mac | $t control unix | $t control win - toAction: [ self showContextMenu ] - -] - { #category : 'initialization' } SpAbstractMorphicAdapter >> addFocusRotationKeyBindings [ self presenter canTakeKeyboardFocus ifFalse: [ ^ self ]. - self + self bindKeyCombination: Character tab asKeyCombination toAction: [ self focusNext ]. self @@ -79,12 +69,29 @@ SpAbstractMorphicAdapter >> addFocusRotationKeyBindings [ toAction: [ self focusPrevious ] ] +{ #category : 'initialization' } +SpAbstractMorphicAdapter >> addKeyBindingsFromGroup: actionGroup [ + + actionGroup asKMCategory allEntries keymaps do: [ :each | + self + bindKeyCombination: each shortcut + toAction: each action ] +] + { #category : 'initialization' } SpAbstractMorphicAdapter >> addKeyBindingsTo: aMorph [ self addFocusRotationKeyBindings. - self presenter contextKeyBindings ifNotNil: [ :aCategory | - aCategory allEntries keymaps do: [ :each | + + self presenter internalActions ifNotNil: [ :actionGroup | + self addKeyBindingsFromGroup: actionGroup ]. + self presenter actions ifNotNil: [ :actionGroup | + self addKeyBindingsFromGroup: actionGroup ]. + + self presenter contextKeyBindings ifNotNil: [ :aKMCategory | + self presenter actions ifNotNil: [ + Error signal: 'You are using contextKeyBindings: and actions: at the same time. Both mechanisms are mutually exclusive.' ]. + aKMCategory allEntries keymaps do: [ :each | self bindKeyCombination: each shortcut toAction: each action ] ] @@ -99,7 +106,9 @@ SpAbstractMorphicAdapter >> addSettingsTo: aMorph [ somehow, but no time to dig at it." self widget isMorph ifTrue: [ self widget presenter: self presenter ]. - self applyVisibility + self applyVisibility. + + self presenter whenActionsChangedDo: [ self updateKeyBindings ] ] { #category : 'styling' } @@ -596,9 +605,19 @@ SpAbstractMorphicAdapter >> show [ { #category : 'private' } SpAbstractMorphicAdapter >> showContextMenu [ - - self presenter contextMenu ifNil: [ ^ self ]. - self showMenu: self presenter contextMenu + | menuPresenter | + + "apply actions" + self presenter actions ifNotNil: [ :actions | + menuPresenter := self presenter newMenu. + menuPresenter fillWith: actions ]. + "apply context menu if there is one" + self presenter contextMenu ifNotNil: [ :aContextMenu | + self presenter actions ifNotNil: [ + Error signal: 'You are using contextMenu: and actions: at the same time. Both mechanisms are mutually exclusive.' ]. + menuPresenter := aContextMenu ]. + + self showMenu: menuPresenter ] { #category : 'private' } @@ -667,6 +686,13 @@ SpAbstractMorphicAdapter >> unsubscribe [ unsubscribe: self ] +{ #category : 'initialization' } +SpAbstractMorphicAdapter >> updateKeyBindings [ + + self widget removeProperty: #kmDispatcher. + self addKeyBindingsTo: self widget +] + { #category : 'protocol' } SpAbstractMorphicAdapter >> useProportionalLayout [ diff --git a/src/Spec2-Adapters-Morphic/SpAbstractMorphicListAdapter.class.st b/src/Spec2-Adapters-Morphic/SpAbstractMorphicListAdapter.class.st index 5046732a0..2ba43d825 100644 --- a/src/Spec2-Adapters-Morphic/SpAbstractMorphicListAdapter.class.st +++ b/src/Spec2-Adapters-Morphic/SpAbstractMorphicListAdapter.class.st @@ -35,7 +35,6 @@ SpAbstractMorphicListAdapter >> addActivationKeyBindings: aWidget [ SpAbstractMorphicListAdapter >> addKeyBindingsTo: aWidget [ super addKeyBindingsTo: aWidget. - self addContextMenuKeyBindings: aWidget. self addActivationKeyBindings: aWidget ] diff --git a/src/Spec2-Adapters-Morphic/SpComponentListDataSource.class.st b/src/Spec2-Adapters-Morphic/SpComponentListDataSource.class.st index 947a3ae50..4a6b33969 100644 --- a/src/Spec2-Adapters-Morphic/SpComponentListDataSource.class.st +++ b/src/Spec2-Adapters-Morphic/SpComponentListDataSource.class.st @@ -46,10 +46,18 @@ SpComponentListDataSource >> headerColumn: column [ { #category : 'accessing' } SpComponentListDataSource >> menuColumn: column row: rowIndex [ - | menuPresenter | - menuPresenter := self model contextMenu. - menuPresenter ifNil: [ ^ nil ]. + + "apply actions" + self model actions ifNotNil: [ :actions | + menuPresenter := self model newMenu. + menuPresenter fillWith: actions ]. + "apply context menu if there is one" + self model contextMenu ifNotNil: [ :aContextMenu | + self model actions ifNotNil: [ + Error signal: 'You are using contextMenu: and actions: at the same time. Both mechanisms are mutually exclusive.' ]. + menuPresenter := aContextMenu ]. + ^ SpBindings value: self model application adapterBindings during: [ diff --git a/src/Spec2-Adapters-Morphic/SpDialogWindowMorph.class.st b/src/Spec2-Adapters-Morphic/SpDialogWindowMorph.class.st index 64446ffb1..53c1c252c 100644 --- a/src/Spec2-Adapters-Morphic/SpDialogWindowMorph.class.st +++ b/src/Spec2-Adapters-Morphic/SpDialogWindowMorph.class.st @@ -6,7 +6,8 @@ Class { #name : 'SpDialogWindowMorph', #superclass : 'DialogWindowMorph', #instVars : [ - 'toolbar' + 'toolbar', + 'toolbarMorph' ], #category : 'Spec2-Adapters-Morphic-Support', #package : 'Spec2-Adapters-Morphic', @@ -75,6 +76,13 @@ SpDialogWindowMorph >> okAction: aBlock [ self toolbar okAction: aBlock ] +{ #category : 'accessing' } +SpDialogWindowMorph >> removeToolbar [ + + toolbarMorph ifNil: [ ^ self ]. + self submorphs last removeMorph: toolbarMorph +] + { #category : 'protocol' } SpDialogWindowMorph >> setToolbarFrom: aBlock [ | newToolbar | @@ -95,11 +103,18 @@ SpDialogWindowMorph >> toolbar: anObject [ | content | toolbar := anObject. - self removeMorph: (content := self submorphs last). - self - addMorph: (self newDialogPanel - addMorphBack: content; - addMorphBack: self newButtonRow; - yourself) - frame: (0 @ 0 corner: 1 @ 1) + toolbarMorph + ifNotNil: [ + self removeToolbar. + toolbarMorph := self newButtonRow. + self submorphs last addMorphBack: toolbarMorph ] + ifNil: [ + toolbarMorph := self newButtonRow. + self removeMorph: (content := self submorphs last). + self + addMorph: (self newDialogPanel + addMorphBack: content; + addMorphBack: toolbarMorph; + yourself) + frame: (0 @ 0 corner: 1 @ 1) ] ] diff --git a/src/Spec2-Adapters-Morphic/SpMorphicBackend.class.st b/src/Spec2-Adapters-Morphic/SpMorphicBackend.class.st index 3b347afc5..c8eb23fae 100644 --- a/src/Spec2-Adapters-Morphic/SpMorphicBackend.class.st +++ b/src/Spec2-Adapters-Morphic/SpMorphicBackend.class.st @@ -21,6 +21,12 @@ SpMorphicBackend >> adapterBindingsClass [ ^ SpMorphicAdapterBindings ] +{ #category : 'accessing' } +SpMorphicBackend >> componentListClass [ + + ^ SpComponentListPresenter +] + { #category : 'accessing' } SpMorphicBackend >> defaultConfigurationFor: anApplication [ @@ -33,6 +39,12 @@ SpMorphicBackend >> defer: aBlock [ UIManager default defer: aBlock ] +{ #category : 'accessing' } +SpMorphicBackend >> dropListClass [ + + ^ SpDropListPresenter +] + { #category : 'deferred message' } SpMorphicBackend >> forceDefer: aBlock [ @@ -48,6 +60,12 @@ SpMorphicBackend >> inform: aString [ contents: aString ] +{ #category : 'accessing' } +SpMorphicBackend >> listClass [ + + ^ SpListPresenter +] + { #category : 'private - notifying' } SpMorphicBackend >> notifyError: aSpecNotification [ @@ -66,23 +84,26 @@ SpMorphicBackend >> notifyInfo: aSpecNotification [ contents: aSpecNotification message ] -{ #category : 'ui - dialogs' } -SpMorphicBackend >> selectDirectoryTitle: aString [ +{ #category : 'display' } +SpMorphicBackend >> showWaitCursorWhile: aBlock inApplication: anApplication [ - ^ UIManager default chooseDirectory: aString path: '' + Cursor wait showWhile: aBlock ] -{ #category : 'ui - dialogs' } -SpMorphicBackend >> selectFileTitle: aString [ +{ #category : 'accessing' } +SpMorphicBackend >> tableClass [ - ^ UIManager default - chooseExistingFileReference: aString - extensions: nil - path: '' + ^ SpTablePresenter ] -{ #category : 'display' } -SpMorphicBackend >> showWaitCursorWhile: aBlock inApplication: anApplication [ +{ #category : 'accessing' } +SpMorphicBackend >> treeClass [ - Cursor wait showWhile: aBlock + ^ SpTreePresenter +] + +{ #category : 'accessing' } +SpMorphicBackend >> treeTableClass [ + + ^ SpTreeTablePresenter ] diff --git a/src/Spec2-Adapters-Morphic/SpMorphicBaseMenuAdapter.class.st b/src/Spec2-Adapters-Morphic/SpMorphicBaseMenuAdapter.class.st index 8e717d270..98480cc9d 100644 --- a/src/Spec2-Adapters-Morphic/SpMorphicBaseMenuAdapter.class.st +++ b/src/Spec2-Adapters-Morphic/SpMorphicBaseMenuAdapter.class.st @@ -15,11 +15,6 @@ SpMorphicBaseMenuAdapter class >> isAbstract [ ^ self name = #SpMorphicBaseMenuAdapter ] -{ #category : 'initialization' } -SpMorphicBaseMenuAdapter >> addKeyBindingsTo: aMorph [ - "This does not have keybindings" -] - { #category : 'private' } SpMorphicBaseMenuAdapter >> getTitleText [ diff --git a/src/Spec2-Adapters-Morphic/SpMorphicBaseTextAdapter.class.st b/src/Spec2-Adapters-Morphic/SpMorphicBaseTextAdapter.class.st index 8986f1d8d..0ae1adb6f 100644 --- a/src/Spec2-Adapters-Morphic/SpMorphicBaseTextAdapter.class.st +++ b/src/Spec2-Adapters-Morphic/SpMorphicBaseTextAdapter.class.st @@ -47,9 +47,7 @@ SpMorphicBaseTextAdapter >> addKeyBindingsTo: aMorph [ super addKeyBindingsTo: aMorph. self bindKeyCombination: Character escape asKeyCombination - toAction: [ :target :morph :event | self bubbleUpEvent: event ]; - bindKeyCombination: $t meta - toAction: [ self showContextMenu ] + toAction: [ :target :morph :event | self bubbleUpEvent: event ] ] { #category : 'accessing' } @@ -62,6 +60,7 @@ SpMorphicBaseTextAdapter >> announcer [ SpMorphicBaseTextAdapter >> bubbleUpEvent: anEvent [ anEvent wasHandled: false. + self presenter hasWindow ifFalse: [ ^ self ]. self presenter window adapter widget handleEvent: anEvent ] @@ -86,9 +85,10 @@ SpMorphicBaseTextAdapter >> clearUserEditFlag [ { #category : 'widget API' } SpMorphicBaseTextAdapter >> codePaneMenu: aMenu shifted: shifted [ - | menuPresenter | - menuPresenter := self model contextMenu. + + self model actions ifNil: [ ^ nil ]. + menuPresenter := self model actions asMenuPresenter. menuPresenter ifNil: [ ^ nil ]. ^ SpBindings value: self model application adapterBindings diff --git a/src/Spec2-Adapters-Morphic/SpMorphicButtonAdapter.class.st b/src/Spec2-Adapters-Morphic/SpMorphicButtonAdapter.class.st index f74e44569..b143c9e20 100644 --- a/src/Spec2-Adapters-Morphic/SpMorphicButtonAdapter.class.st +++ b/src/Spec2-Adapters-Morphic/SpMorphicButtonAdapter.class.st @@ -19,7 +19,7 @@ Class { { #category : 'widget API' } SpMorphicButtonAdapter >> action [ - self showSubMenuIfPresent. + "self showSubMenuIfPresent." self widget ifNotNil: [:m | m takeKeyboardFocus ]. self model performAction @@ -147,21 +147,35 @@ SpMorphicButtonAdapter >> keyStroke: anEvent fromMorph: aMorph [ { #category : 'widget API' } SpMorphicButtonAdapter >> label [ + | labelString | + + labelString := self presenter label + ifNotNil: [ :aString | aString withAccentuatedCharacter: self presenter shortcutCharacter ]. ^ self - buildLabel: (self presenter label withAccentuatedCharacter: self presenter shortcutCharacter) + buildLabel: labelString withIcon: self presenter icon ] { #category : 'widget API' } SpMorphicButtonAdapter >> menu: aMenu [ - | menuPresenter | - menuPresenter := self presenter contextMenu. + + "apply actions" + self presenter actions ifNotNil: [ :actions | + menuPresenter := self presenter newMenu. + menuPresenter fillWith: actions ]. + "apply context menu if there is one" + self presenter contextMenu ifNotNil: [ :aContextMenu | + self presenter actions ifNotNil: [ + Error signal: 'You are using contextMenu: and actions: at the same time. Both mechanisms are mutually exclusive.' ]. + menuPresenter := aContextMenu ]. + menuPresenter ifNil: [ ^ nil ]. + ^ SpBindings value: self presenter application adapterBindings - during: [ menuPresenter build ] + during: [ menuPresenter value build ] ] { #category : 'factory' } @@ -219,10 +233,20 @@ SpMorphicButtonAdapter >> showSubMenu: aMenu [ { #category : 'widget API' } SpMorphicButtonAdapter >> showSubMenuIfPresent [ + | menuPresenter | - self presenter contextMenu ifNil: [ ^ self ]. - self showSubMenu: self presenter contextMenu - + "apply actions" + self presenter actions ifNotNil: [ :actions | + menuPresenter := self presenter newMenu. + menuPresenter fillWith: actions ]. + "apply context menu if there is one" + self presenter contextMenu ifNotNil: [ :aContextMenu | + self presenter actions ifNotNil: [ + Error signal: 'You are using contextMenu: and actions: at the same time. Both mechanisms are mutually exclusive.' ]. + menuPresenter := aContextMenu ]. + + self presenter actions ifNil: [ ^ self ]. + self showSubMenu: menuPresenter ] { #category : 'widget API' } diff --git a/src/Spec2-Adapters-Morphic/SpMorphicComponentListAdapter.class.st b/src/Spec2-Adapters-Morphic/SpMorphicComponentListAdapter.class.st index 47a79323e..6ee9ef159 100644 --- a/src/Spec2-Adapters-Morphic/SpMorphicComponentListAdapter.class.st +++ b/src/Spec2-Adapters-Morphic/SpMorphicComponentListAdapter.class.st @@ -18,7 +18,6 @@ SpMorphicComponentListAdapter >> addActivationKeyBindings: aWidget [ SpMorphicComponentListAdapter >> addKeyBindingsTo: aWidget [ super addKeyBindingsTo: aWidget. - self addContextMenuKeyBindings: aWidget. self addActivationKeyBindings: aWidget ] diff --git a/src/Spec2-Adapters-Morphic/SpMorphicDialogWindowAdapter.class.st b/src/Spec2-Adapters-Morphic/SpMorphicDialogWindowAdapter.class.st index beb3a0cd1..ace79163a 100644 --- a/src/Spec2-Adapters-Morphic/SpMorphicDialogWindowAdapter.class.st +++ b/src/Spec2-Adapters-Morphic/SpMorphicDialogWindowAdapter.class.st @@ -9,16 +9,27 @@ Class { #tag : 'Base' } +{ #category : 'private' } +SpMorphicDialogWindowAdapter >> addButtonsDecorationTo: widgetToBuild [ + + widgetToBuild setToolbarFrom: [ self buildButtonBar ]. + self model buttons ifNotEmpty: [ + self presenter defaultButton + ifNotNil: [ :aButton | aButton adapter setAsDefault ] ] +] + { #category : 'private' } SpMorphicDialogWindowAdapter >> addPresenterIn: widgetToBuild withSpecLayout: aSpec [ "I replace the mainPanel (which contains contents and button bar) because like that I get the status bar at the end (where it belongs)" super addPresenterIn: widgetToBuild withSpecLayout: aSpec. - self model buttons ifNotEmpty: [ - widgetToBuild setToolbarFrom: [ self buildButtonBar ]. - self presenter defaultButton - ifNotNil: [ :aButton | aButton adapter setAsDefault ] ] + self presenter hasButtonDecorations + ifTrue: [ self addButtonsDecorationTo: widgetToBuild ]. + self presenter whenButtonDecorationsChangedDo: [ :aBoolean | + aBoolean + ifTrue: [ self addButtonsDecorationTo: widgetToBuild ] + ifFalse: [ widgetToBuild removeToolbar ] ] ] { #category : 'factory' } diff --git a/src/Spec2-Adapters-Morphic/SpMorphicDiffUnifiedAdapter.class.st b/src/Spec2-Adapters-Morphic/SpMorphicDiffUnifiedAdapter.class.st index 97c05ae3c..9b57bf465 100644 --- a/src/Spec2-Adapters-Morphic/SpMorphicDiffUnifiedAdapter.class.st +++ b/src/Spec2-Adapters-Morphic/SpMorphicDiffUnifiedAdapter.class.st @@ -9,7 +9,7 @@ Class { { #category : 'factory' } SpMorphicDiffUnifiedAdapter >> buildWidget [ - ^ UnifiedDiffChangesMorph new + ^ StUnifiedDiffChangesMorph new on: self; from: self leftText to: self rightText diff --git a/src/Spec2-Adapters-Morphic/SpMorphicDropListAdapter.class.st b/src/Spec2-Adapters-Morphic/SpMorphicDropListAdapter.class.st index fccd48539..d6ef35a5c 100644 --- a/src/Spec2-Adapters-Morphic/SpMorphicDropListAdapter.class.st +++ b/src/Spec2-Adapters-Morphic/SpMorphicDropListAdapter.class.st @@ -88,6 +88,12 @@ SpMorphicDropListAdapter >> setIndex: anIndex [ self presenter selectIndex: anIndex ] +{ #category : 'accessing' } +SpMorphicDropListAdapter >> styleName: aString [ + + "for compatibility with tool buttons, but not used at the moment" +] + { #category : 'factory' } SpMorphicDropListAdapter >> verifyInitialStatus [ diff --git a/src/Spec2-Adapters-Morphic/SpMorphicLabelAdapter.class.st b/src/Spec2-Adapters-Morphic/SpMorphicLabelAdapter.class.st index 080823861..910a39de4 100644 --- a/src/Spec2-Adapters-Morphic/SpMorphicLabelAdapter.class.st +++ b/src/Spec2-Adapters-Morphic/SpMorphicLabelAdapter.class.st @@ -26,6 +26,8 @@ SpMorphicLabelAdapter >> applyDecorationsTo: aString [ self presenter displayUnderline ifNotNil: [ :block | (block cull: aString) ifTrue: [ text addAttribute: TextEmphasis underlined ] ]. + "this in fact does not work (background in LabelMorph objects). + See applyStyle instead" self presenter displayBackgroundColor ifNotNil: [ :block | (block cull: aString) ifNotNil: [ :aColor | text addAttribute: (TextBackgroundColor color: aColor) ] ]. @@ -42,13 +44,37 @@ SpMorphicLabelAdapter >> applyStyle: aMorph [ height is smaller than current height of morph, we need to take care about this even if this means we cannot have a label smaller than the font :(" aMorph height < aMorph font height - ifTrue: [ aMorph height: aMorph font height ] + ifTrue: [ aMorph height: aMorph font height ]. + + "I need to check background here because a LabelMorph is uncapable of apply a + background color (because meh... morphic+polymorph)" + self presenter displayBackgroundColor ifNotNil: [ :block | + (block cull: self presenter label) ifNotNil: [ :aColor | + aMorph backgroundColor: aColor ] ]. + +] + +{ #category : 'accessing' } +SpMorphicLabelAdapter >> beJustifyCenter [ +] + +{ #category : 'accessing' } +SpMorphicLabelAdapter >> beJustifyLeft [ + +] + +{ #category : 'accessing' } +SpMorphicLabelAdapter >> beJustifyRight [ +] + +{ #category : 'accessing' } +SpMorphicLabelAdapter >> beWrap [ ] { #category : 'factory' } SpMorphicLabelAdapter >> buildWidget [ - | label | + label := LabelMorph new model: self. label getEnabledSelector: #enabled; diff --git a/src/Spec2-Adapters-Morphic/SpMorphicLayoutAdapter.class.st b/src/Spec2-Adapters-Morphic/SpMorphicLayoutAdapter.class.st index 11996a667..17eb08a0e 100644 --- a/src/Spec2-Adapters-Morphic/SpMorphicLayoutAdapter.class.st +++ b/src/Spec2-Adapters-Morphic/SpMorphicLayoutAdapter.class.st @@ -39,7 +39,6 @@ SpMorphicLayoutAdapter >> addConstraints: constraints toChild: childMorph [ SpMorphicLayoutAdapter >> addKeyBindingsTo: aMorph [ "This is called before the layout actually exists. Skipping it." - ] { #category : 'private' } diff --git a/src/Spec2-Adapters-Morphic/SpMorphicListDataSource.class.st b/src/Spec2-Adapters-Morphic/SpMorphicListDataSource.class.st index 66c4802aa..851becf5b 100644 --- a/src/Spec2-Adapters-Morphic/SpMorphicListDataSource.class.st +++ b/src/Spec2-Adapters-Morphic/SpMorphicListDataSource.class.st @@ -65,8 +65,16 @@ SpMorphicListDataSource >> listModel [ SpMorphicListDataSource >> menuColumn: column row: rowIndex [ | menuPresenter | - menuPresenter := self model contextMenu. - menuPresenter ifNil: [ ^ nil ]. + "apply actions" + self model actions ifNotNil: [ :actions | + menuPresenter := self model newMenu. + menuPresenter fillWith: actions ]. + "apply context menu if there is one" + self model contextMenu ifNotNil: [ :aContextMenu | + self model actions ifNotNil: [ + Error signal: 'You are using contextMenu: and actions: at the same time. Both mechanisms are mutually exclusive.' ]. + menuPresenter := aContextMenu ]. + ^ SpBindings value: self model application adapterBindings during: [ diff --git a/src/Spec2-Adapters-Morphic/SpMorphicMenuBarAdapter.class.st b/src/Spec2-Adapters-Morphic/SpMorphicMenuBarAdapter.class.st index 5edce6cb9..282451979 100644 --- a/src/Spec2-Adapters-Morphic/SpMorphicMenuBarAdapter.class.st +++ b/src/Spec2-Adapters-Morphic/SpMorphicMenuBarAdapter.class.st @@ -63,9 +63,10 @@ SpMorphicMenuBarAdapter >> buildButtonFor: item [ SpMorphicMenuBarAdapter >> buildWidget [ widget := ToolDockingBarMorph new - hResizing: #spaceFill; - vResizing: #spaceFill; - yourself. + hResizing: #spaceFill; + vResizing: #spaceFill; + height: 24 * self currentWorld displayScaleFactor; + yourself. self menuGroups doWithIndex: [ :aGroup :index | self adoptMenuGroupModel: aGroup first: index = 1 ]. diff --git a/src/Spec2-Adapters-Morphic/SpMorphicSwitchAdapter.class.st b/src/Spec2-Adapters-Morphic/SpMorphicSwitchAdapter.class.st new file mode 100644 index 000000000..01486be9e --- /dev/null +++ b/src/Spec2-Adapters-Morphic/SpMorphicSwitchAdapter.class.st @@ -0,0 +1,7 @@ +Class { + #name : 'SpMorphicSwitchAdapter', + #superclass : 'SpMorphicCheckBoxAdapter', + #category : 'Spec2-Adapters-Morphic-Base', + #package : 'Spec2-Adapters-Morphic', + #tag : 'Base' +} diff --git a/src/Spec2-Adapters-Morphic/SpMorphicTableAdapter.class.st b/src/Spec2-Adapters-Morphic/SpMorphicTableAdapter.class.st index a5ed37268..1282c9b83 100644 --- a/src/Spec2-Adapters-Morphic/SpMorphicTableAdapter.class.st +++ b/src/Spec2-Adapters-Morphic/SpMorphicTableAdapter.class.st @@ -18,13 +18,6 @@ SpMorphicTableAdapter class >> intercellSpacing [ ^ 2@0 ] -{ #category : 'initialization' } -SpMorphicTableAdapter >> addKeyBindingsTo: aWidget [ - - super addKeyBindingsTo: aWidget. - self addContextMenuKeyBindings: aWidget -] - { #category : 'factory' } SpMorphicTableAdapter >> addModelTo: tableMorph [ @@ -272,7 +265,6 @@ SpMorphicTableAdapter >> transferFrom: aTransferMorph event: anEvent [ rowAndColumn := self widget container rowAndColumnIndexContainingPoint: anEvent position. ^ SpDragAndDropTransferToTable new passenger: aTransferMorph passenger; - shouldCopy: aTransferMorph shouldCopy; row: (rowAndColumn first ifNil: [ 0 ]); column: (rowAndColumn second ifNil: [ 0 ]); yourself diff --git a/src/Spec2-Adapters-Morphic/SpMorphicTextAdapter.class.st b/src/Spec2-Adapters-Morphic/SpMorphicTextAdapter.class.st index 81e1ddde3..1a873a341 100644 --- a/src/Spec2-Adapters-Morphic/SpMorphicTextAdapter.class.st +++ b/src/Spec2-Adapters-Morphic/SpMorphicTextAdapter.class.st @@ -29,7 +29,7 @@ SpMorphicTextAdapter >> backendIncludesEditionMenu [ ] { #category : 'protocol - shortcuts' } -SpMorphicTextAdapter >> bindKeyCombination: aShortcut toAction: aBlock [ +SpMorphicTextAdapter >> bindKeyCombination: aShortcut toAction: aBlock [ self widgetDo: [ :w | w textArea @@ -85,15 +85,25 @@ SpMorphicTextAdapter >> buildWidget [ { #category : 'widget API' } SpMorphicTextAdapter >> codePaneMenu: aMenu shifted: shifted [ - | menuPresenter | + | menuPresenter actionGroup | - menuPresenter := self model contextMenu value - ifNotNil: [ :contextMenu | contextMenu ] - ifNil: [ SpMenuPresenter new ]. + actionGroup := SpActionGroup new beRoot. + self presenter internalActions ifNotNil: [ :group | + actionGroup add: group beRoot ]. + self presenter actions ifNotNil: [ :group | + actionGroup add: group beRoot ]. self presenter hasEditionContextMenu ifTrue: [ - self presenter editionContextMenu menuGroups do: [ :each | - menuPresenter addMenuGroup: each ] ]. + actionGroup add: self presenter editionCommandsGroup beRoot ]. + + menuPresenter := self presenter newMenu. + menuPresenter fillWith: actionGroup. + + "apply context menu if there is one" + self presenter contextMenu ifNotNil: [ :aContextMenu | + self presenter actions ifNotNil: [ + Error signal: 'You are using contextMenu: and actions: at the same time. Both mechanisms are mutually exclusive.' ]. + menuPresenter := aContextMenu ]. ^ SpBindings value: self model application adapterBindings @@ -251,3 +261,10 @@ SpMorphicTextAdapter >> updateExtentPropagationOf: string on: aWidget [ yourself) height + 2)"min: self currentWorld height / 3". aWidget height: height ] ] + +{ #category : 'initialization' } +SpMorphicTextAdapter >> updateKeyBindings [ + + self widgetDo: [ :w | w textArea removeProperty: #kmDispatcher ]. + super updateKeyBindings +] diff --git a/src/Spec2-Adapters-Morphic/SpMorphicTextInputFieldAdapter.class.st b/src/Spec2-Adapters-Morphic/SpMorphicTextInputFieldAdapter.class.st index 707f645ad..20bff443f 100644 --- a/src/Spec2-Adapters-Morphic/SpMorphicTextInputFieldAdapter.class.st +++ b/src/Spec2-Adapters-Morphic/SpMorphicTextInputFieldAdapter.class.st @@ -105,12 +105,6 @@ SpMorphicTextInputFieldAdapter >> isPassword [ ^ self widget font isKindOf: FixedFaceFont ] -{ #category : 'accessing' } -SpMorphicTextInputFieldAdapter >> maxLength [ - - ^ widget maxLength -] - { #category : 'private' } SpMorphicTextInputFieldAdapter >> setEditable: aBoolean to: aWidget [ diff --git a/src/Spec2-Adapters-Morphic/SpMorphicTreeTableAdapter.class.st b/src/Spec2-Adapters-Morphic/SpMorphicTreeTableAdapter.class.st index 1c0a0978d..4558e8024 100644 --- a/src/Spec2-Adapters-Morphic/SpMorphicTreeTableAdapter.class.st +++ b/src/Spec2-Adapters-Morphic/SpMorphicTreeTableAdapter.class.st @@ -58,7 +58,6 @@ SpMorphicTreeTableAdapter >> addFocusRotationKeyBindings [ SpMorphicTreeTableAdapter >> addKeyBindingsTo: aWidget [ super addKeyBindingsTo: aWidget. - self addContextMenuKeyBindings: aWidget. self addActivationKeyBindings: aWidget ] @@ -493,7 +492,6 @@ SpMorphicTreeTableAdapter >> transferFrom: aTransferMorph event: anEvent [ ^ SpDragAndDropTransferToTree new passenger: aTransferMorph passenger; - shouldCopy: aTransferMorph shouldCopy; row: (rowAndColumn first ifNil: [ 0 ]); column: (rowAndColumn second ifNil: [ 0 ]); target: aTarget; diff --git a/src/Spec2-Adapters-Morphic/SpMorphicWindowAdapter.class.st b/src/Spec2-Adapters-Morphic/SpMorphicWindowAdapter.class.st index f76922c49..9ace3f4c8 100644 --- a/src/Spec2-Adapters-Morphic/SpMorphicWindowAdapter.class.st +++ b/src/Spec2-Adapters-Morphic/SpMorphicWindowAdapter.class.st @@ -242,6 +242,12 @@ SpMorphicWindowAdapter >> restore [ self widgetDo: [ :w | w restore ] ] +{ #category : 'widget API' } +SpMorphicWindowAdapter >> size [ + + ^ widget extent +] + { #category : 'factory' } SpMorphicWindowAdapter >> subscribeToAnnouncements: aWindow [ diff --git a/src/Spec2-Adapters-Morphic/SpTMorphicTableDataSourceCommons.trait.st b/src/Spec2-Adapters-Morphic/SpTMorphicTableDataSourceCommons.trait.st index 2276b059a..0eb29cc54 100644 --- a/src/Spec2-Adapters-Morphic/SpTMorphicTableDataSourceCommons.trait.st +++ b/src/Spec2-Adapters-Morphic/SpTMorphicTableDataSourceCommons.trait.st @@ -32,13 +32,25 @@ SpTMorphicTableDataSourceCommons >> headersByColumn [ { #category : 'accessing' } SpTMorphicTableDataSourceCommons >> menuColumn: column row: rowIndex [ - | menuPresenter | - menuPresenter := self model contextMenu. + + menuPresenter := nil. + "apply actions" + self model actions ifNotNil: [ :actions | + menuPresenter := self model newMenu. + menuPresenter fillWith: actions ]. + "apply context menu if there is one" + self model contextMenu ifNotNil: [ :aContextMenu | + self model actions ifNotNil: [ + self error: 'You are using contextMenu: and actions: at the same time. Both mechanisms are mutually exclusive.' ]. + menuPresenter := aContextMenu ]. + menuPresenter ifNil: [ ^ nil ]. + ^ SpBindings value: self model application adapterBindings - during: [ menuPresenter value ifNotNil: [ :presenter | presenter build ] ] + during: [ menuPresenter value + ifNotNil: [ :presenter | presenter build ] ] ] { #category : 'accessing' } diff --git a/src/Spec2-Adapters-Morphic/SpWindow.class.st b/src/Spec2-Adapters-Morphic/SpWindow.class.st index b34ed7be3..455431b7a 100644 --- a/src/Spec2-Adapters-Morphic/SpWindow.class.st +++ b/src/Spec2-Adapters-Morphic/SpWindow.class.st @@ -42,14 +42,13 @@ SpWindow >> announceWillClose [ { #category : 'open/close' } SpWindow >> close [ - self announceWillClose ifFalse: [ ^ self ]. super close. ] { #category : 'open/close' } SpWindow >> deleteDiscardingChanges [ - self announceWillClose. + self announceWillClose ifFalse: [ ^ self ]. ^ super deleteDiscardingChanges ] @@ -80,16 +79,25 @@ SpWindow >> okToChange [ ^ self model okToChange ] +{ #category : 'private' } +SpWindow >> taskbarIcon [ + + ^ self model windowIcon + ifNil: [ super taskbarIcon ] +] + { #category : 'accessing' } SpWindow >> taskbarTask [ "Answer a taskbar task for the receiver. Answer nil if not required." - (self valueOfProperty: #noTaskbarTask ifAbsent: [false]) ifTrue: [^nil]. + (self valueOfProperty: #noTaskbarTask ifAbsent: [ false ]) ifTrue: [ + ^ nil ]. + taskbarTask := TaskbarTask morph: self state: self taskbarState - icon: self model taskbarIcon + icon: (self model iconNamed: self model taskbarIconName) label: self taskbarLabel. ^ taskbarTask diff --git a/src/Spec2-Backend-Tests/SpCheckboxAdapterTest.class.st b/src/Spec2-Backend-Tests/SpCheckboxAdapterTest.class.st index 59025a9be..879161343 100644 --- a/src/Spec2-Backend-Tests/SpCheckboxAdapterTest.class.st +++ b/src/Spec2-Backend-Tests/SpCheckboxAdapterTest.class.st @@ -49,7 +49,7 @@ SpCheckboxAdapterTest >> testChangeDeactivatedAfterOpenCheckboxDectivatesIt [ SpCheckboxAdapterTest >> testChangingLabelAffectTheWidget [ presenter label: 'ALabel'. - self assert: self adapter label equals: 'ALabel' + self assert: self widget label equals: 'ALabel' ] { #category : 'tests' } diff --git a/src/Spec2-Backend-Tests/SpDropListAdapterTest.class.st b/src/Spec2-Backend-Tests/SpDropListAdapterTest.class.st index f54fde14f..c91e70e47 100644 --- a/src/Spec2-Backend-Tests/SpDropListAdapterTest.class.st +++ b/src/Spec2-Backend-Tests/SpDropListAdapterTest.class.st @@ -19,35 +19,12 @@ SpDropListAdapterTest >> initializeTestedInstance [ presenter items: #(10 20 30). ] -{ #category : 'tests' } -SpDropListAdapterTest >> testAddingIconsShowTheIcon [ - #(pharo add book) do: [ :each | self presenter addItemLabeled: each do: [ ] icon: (self iconNamed: each) ]. - - self presenter selectItem: #pharo. - - self assert: self adapter selectedIndexes equals: #(4). - backendForTest assertIcon: self adapter displayedIcon equals: (self iconNamed: #pharo) -] - { #category : 'tests' } SpDropListAdapterTest >> testDoesNotShowIcons [ backendForTest assertIcon: self adapter displayedIcon equals: nil. ] -{ #category : 'tests' } -SpDropListAdapterTest >> testRemovingIconsAfterAddingThem [ - #(pharo add book) do: [ :each | self presenter addItemLabeled: each do: [ ] icon: (self iconNamed: each) ]. - - self presenter selectItem: nil. - self presenter model removeAll. - - #(pharo add book) do: [ :each | self presenter addItemLabeled: each do: [ ] icon: nil ]. - - self assert: self adapter selectedIndexes equals: #(1). - backendForTest assertIcon: self adapter displayedIcon equals: nil -] - { #category : 'tests' } SpDropListAdapterTest >> testResetingSelectionResetsSelection [ diff --git a/src/Spec2-Backend-Tests/SpLabelAdapterTest.class.st b/src/Spec2-Backend-Tests/SpLabelAdapterTest.class.st index 4b7809546..e395df785 100644 --- a/src/Spec2-Backend-Tests/SpLabelAdapterTest.class.st +++ b/src/Spec2-Backend-Tests/SpLabelAdapterTest.class.st @@ -14,6 +14,16 @@ SpLabelAdapterTest >> classToTest [ ^ SpLabelPresenter ] +{ #category : 'tests' } +SpLabelAdapterTest >> testBackgroundColorChangesColor [ + "test this issue: https://github.com/pharo-spec/Spec/issues/1524" + + presenter label: 'Test'. + presenter displayBackgroundColor: [ Color green ]. + self openInstance. + self assert: self adapter widget backgroundColor equals: Color green +] + { #category : 'tests' } SpLabelAdapterTest >> testSetLabelInPresenterAffectsWidget [ presenter label: 'something'. diff --git a/src/Spec2-Backend-Tests/SpRadioButtonAdapterTest.class.st b/src/Spec2-Backend-Tests/SpRadioButtonAdapterTest.class.st index 6a58ba6f2..38bc2d2d8 100644 --- a/src/Spec2-Backend-Tests/SpRadioButtonAdapterTest.class.st +++ b/src/Spec2-Backend-Tests/SpRadioButtonAdapterTest.class.st @@ -16,7 +16,7 @@ SpRadioButtonAdapterTest >> classToTest [ SpRadioButtonAdapterTest >> testChangingLabelAffectTheWidget [ presenter label: 'ALabel'. - self assert: self adapter label equals: 'ALabel' + self assert: self widget label equals: 'ALabel' ] { #category : 'tests' } diff --git a/src/Spec2-Backend-Tests/SpSliderAdapterTest.class.st b/src/Spec2-Backend-Tests/SpSliderAdapterTest.class.st index a3ca04849..37915e3a1 100644 --- a/src/Spec2-Backend-Tests/SpSliderAdapterTest.class.st +++ b/src/Spec2-Backend-Tests/SpSliderAdapterTest.class.st @@ -8,168 +8,6 @@ Class { { #category : 'accessing' } SpSliderAdapterTest >> classToTest [ - ^ SpSliderPresenter -] - -{ #category : 'tests' } -SpSliderAdapterTest >> testChangeInLabelUpdatesWidget [ - - self - assert: self adapter widgetLabel - closeTo: ''. - - presenter label: 'test'. - - self - assert: self adapter widgetLabel - equals: 'test' -] - -{ #category : 'tests' } -SpSliderAdapterTest >> testChangeInMaxUpdatesWidget [ - - presenter value: 80. - - "Default max is 100" - self - assert: self adapter widgetAbsoluteValue - closeTo: 0.8. - self - assert: self adapter widgetValue - equals: 80. - - "Changing max updates the slider value" - presenter max: 1000. - self - assert: self adapter widgetAbsoluteValue - closeTo: 0.8. - self - assert: self adapter widgetValue - equals: 800 -] - -{ #category : 'tests' } -SpSliderAdapterTest >> testChangeInMinUpdatesWidget [ - - presenter value: 80. - - "Default min is 0" - self - assert: self adapter widgetAbsoluteValue - closeTo: 0.8. - self - assert: self adapter widgetValue - equals: 80. - - "Changing min updates the slider value" - presenter min: 50. - self - assert: self adapter widgetAbsoluteValue - closeTo: 0.8. - self - assert: self adapter widgetValue - equals: 90 -] - -{ #category : 'tests' } -SpSliderAdapterTest >> testChangeInQuantumUpdatesWidget [ - - presenter - min: -50; - max: 150. - - "By default, quantum is 1, which means round Floats to Integer" - presenter value: 49.1. - self assert: self adapter widgetValue closeTo: 49. - - presenter value: -49.1. - self assert: self adapter widgetValue closeTo: -49. - - "Quantum is disabled when nil is set" - presenter quantum: nil. - - presenter value: 49.1. - self assert: self adapter widgetValue closeTo: 49.1. - - presenter value: -49.1. - self assert: self adapter widgetValue closeTo: -49.1. - - "Set 50 as quantum" - presenter quantum: 10. - - "Current value is automatically rounded acording to the new quamtum" - self assert: self adapter widgetValue equals: -50. - - "It also works with new values" - presenter value: 49. - self assert: self adapter widgetValue equals: 50 -] - -{ #category : 'tests' } -SpSliderAdapterTest >> testChangeInValueUpdatesWidget [ - - presenter - min: -50; - max: 150. - - presenter value: 50. - self assert: self adapter widgetValue equals: 50. - - presenter value: -50. - self assert: self adapter widgetValue equals: -50 -] - -{ #category : 'tests' } -SpSliderAdapterTest >> testPresenterUpdatesWidget [ - - presenter - min: -50; - max: 150. - - presenter value: 50. - self assert: self adapter widgetValue equals: 50. - - presenter value: -50. - self assert: self adapter widgetValue equals: -50. - - "By default, quantum is 1, which means round Floats to Integer" - presenter value: 49.1. - self assert: self adapter widgetValue closeTo: 49. - - presenter value: -49.1. - self assert: self adapter widgetValue closeTo: -49. - - "Quantum is disabled when nil is set" - presenter quantum: nil. - - presenter value: 49.1. - self assert: self adapter widgetValue closeTo: 49.1. - - presenter value: -49.1. - self assert: self adapter widgetValue closeTo: -49.1. - - "Set 50 as quantum" - presenter quantum: 10. - - "Current value is automatically rounded acording to the new quamtum" - self assert: self adapter widgetValue equals: -50. - - "It also works with new values" - presenter value: 49. - self assert: self adapter widgetValue equals: 50 -] - -{ #category : 'tests' } -SpSliderAdapterTest >> testWidgetUpdatesPresenter [ - - presenter - min: -50; - max: 150; - quantum: 10. - - "Emulate a change on the widget" - self adapter widgetValue: 54. - self assert: presenter value equals: 50. - self assert: presenter absoluteValue equals: 0.5 + ^ SpSliderPresenter ] diff --git a/src/Spec2-Backend-Tests/SpTextAdapterTest.class.st b/src/Spec2-Backend-Tests/SpTextAdapterTest.class.st index 694a4a120..d505fc28c 100644 --- a/src/Spec2-Backend-Tests/SpTextAdapterTest.class.st +++ b/src/Spec2-Backend-Tests/SpTextAdapterTest.class.st @@ -12,6 +12,26 @@ SpTextAdapterTest >> classToTest [ ^ SpTextPresenter ] +{ #category : 'accessing' } +SpTextAdapterTest >> testAddShortcut [ + | handled | + + handled := false. + presenter + addShortcutWith: [ :action | action + shortcutKey: $x meta; + action: [ handled := true ] ]. + + self adapter + keyDown: $x + shift: false + meta: true + control: false + option: false. + + self assert: handled +] + { #category : 'accessing' } SpTextAdapterTest >> testKeyBindings [ | handled | diff --git a/src/Spec2-Backend-Tests/SpTextInputFieldAdapterTest.class.st b/src/Spec2-Backend-Tests/SpTextInputFieldAdapterTest.class.st index 4df712f4a..06bb32576 100644 --- a/src/Spec2-Backend-Tests/SpTextInputFieldAdapterTest.class.st +++ b/src/Spec2-Backend-Tests/SpTextInputFieldAdapterTest.class.st @@ -23,7 +23,7 @@ SpTextInputFieldAdapterTest >> testChangeWidgetTextUpdatesPresenter [ SpTextInputFieldAdapterTest >> testMaxLengthIsSetInWidget [ presenter maxLength: 10. - self assert: self adapter maxLength equals: 10 + self assert: self widget maxLength equals: 10 ] { #category : 'tests' } @@ -44,5 +44,5 @@ SpTextInputFieldAdapterTest >> testPasswordIsSetInWidget [ SpTextInputFieldAdapterTest >> testPresenterTextIsSetInWidget [ presenter text: 'something'. - self assert: self adapter getText equals: 'something' + self assert: self widget text equals: 'something' ] diff --git a/src/Spec2-Code-Morphic/SpMorphicCodeAdapter.class.st b/src/Spec2-Code-Morphic/SpMorphicCodeAdapter.class.st index 82e33029d..4c5c2cf2c 100644 --- a/src/Spec2-Code-Morphic/SpMorphicCodeAdapter.class.st +++ b/src/Spec2-Code-Morphic/SpMorphicCodeAdapter.class.st @@ -5,17 +5,6 @@ Class { #package : 'Spec2-Code-Morphic' } -{ #category : 'initialization' } -SpMorphicCodeAdapter >> addKeyBindingsTo: aMorph [ - - super addKeyBindingsTo: aMorph. - self presenter contextKeyBindings ifNotNil: [ :kmCategory | - kmCategory allEntries keymaps do: [ :each | - self - bindKeyCombination: each shortcut - toAction: each action ] ] -] - { #category : 'widget API' } SpMorphicCodeAdapter >> behavior [ @@ -36,15 +25,18 @@ SpMorphicCodeAdapter >> buildWidget [ self presenter hasLineNumbers ifTrue: [ newWidget withLineNumbers ]. - self presenter interactionModel ifNotNil: [ :im | - self setInteractionModel: im to: newWidget ]. self presenter whenLineNumbersChangedDo: [ :hasLineNumbers | self changeLineNumbers: hasLineNumbers to: newWidget ]. + + self presenter interactionModel ifNotNil: [ :im | + self setInteractionModel: im to: newWidget ]. + self presenter whenSyntaxHighlightChangedDo: [ :hasSyntaxHighlight | self setEditingModeFor: newWidget ]. + self presenter whenSmartCharactersChangedDo: [ :hasSmartCharacters | self setSmartCharactersFor: newWidget ]. - + self presenter syntaxHighlightTheme ifNotNil: [ self setSyntaxHighlightThemeFor: newWidget ]. self presenter whenSyntaxHighlightThemeChangedDo: [ :value | diff --git a/src/Spec2-Code-Tests/SpCodeObjectInteractionModelTest.class.st b/src/Spec2-Code-Tests/SpCodeObjectInteractionModelTest.class.st index 005ea43ff..984610f32 100644 --- a/src/Spec2-Code-Tests/SpCodeObjectInteractionModelTest.class.st +++ b/src/Spec2-Code-Tests/SpCodeObjectInteractionModelTest.class.st @@ -49,8 +49,8 @@ SpCodeObjectInteractionModelTest >> testBindingOf [ { #category : 'tests' } SpCodeObjectInteractionModelTest >> testCompiler [ - | result | + result := interactionModel compiler evaluate: 'self'. self assert: result equals: self. diff --git a/src/Spec2-Code-Tests/SpCodePresenterTest.class.st b/src/Spec2-Code-Tests/SpCodePresenterTest.class.st index 0efebcb51..4f43c0b8e 100644 --- a/src/Spec2-Code-Tests/SpCodePresenterTest.class.st +++ b/src/Spec2-Code-Tests/SpCodePresenterTest.class.st @@ -57,16 +57,20 @@ SpCodePresenterTest >> testContextKeyBindings [ | contextKeyBindings | contextKeyBindings := presenter contextKeyBindings. - self assert: contextKeyBindings isNotNil. - self assert: (contextKeyBindings isKindOf: KMCategory). + self assert: contextKeyBindings isNil. + presenter bindKeyCombination: $x asKeyCombination toAction: [ "none" ]. + + contextKeyBindings := presenter contextKeyBindings. + self deny: contextKeyBindings isNil. + self assert: (contextKeyBindings isKindOf: KMCategory) ] { #category : 'tests' } SpCodePresenterTest >> testContextMenu [ | menu changed | - self assert: presenter contextMenu isNotNil. "The code presenter comes with a menu by default" + self assert: presenter contextMenu isNil. menu := SpMenuPresenter new. changed := false. presenter whenMenuChangedDo: [ @@ -177,31 +181,6 @@ SpCodePresenterTest >> testDoBrowseImplementors [ equals: { SpCodePresenterTest>>#testDoBrowseImplementors } ] -{ #category : 'tests - commands' } -SpCodePresenterTest >> testDoBrowseMethod [ - - | navigation | - navigation := SpCodeSystemNavigationMock new. - presenter systemNavigation: navigation. - presenter environment add: SpCodePresenterTest binding. - presenter environment add: SpCodeSystemNavigationMock binding. - presenter beForScripting. - self openInstance. - - - presenter text: 'Object'. - presenter doBrowseClass. - - self assert: navigation messageList isNil. - - navigation reset. - presenter text: 'selectAll'. - presenter doBrowseClass. - - self assert: navigation browseSelector notEmpty. - self assert: navigation browseSelector equals: #selectAll -] - { #category : 'tests - commands' } SpCodePresenterTest >> testDoBrowseMethodReferences [ diff --git a/src/Spec2-Code-Tests/SpCodeSystemNavigationMock.class.st b/src/Spec2-Code-Tests/SpCodeSystemNavigationMock.class.st index 8deff310c..8dfdaa2e3 100644 --- a/src/Spec2-Code-Tests/SpCodeSystemNavigationMock.class.st +++ b/src/Spec2-Code-Tests/SpCodeSystemNavigationMock.class.st @@ -16,13 +16,6 @@ SpCodeSystemNavigationMock >> browse: aClass [ browseClass := aClass ] -{ #category : 'opening' } -SpCodeSystemNavigationMock >> browseAllImplementorsOf: aSelector [ - - browseSelector := aSelector. - messageList := (self allImplementorsOf: aSelector) -] - { #category : 'accessing' } SpCodeSystemNavigationMock >> browseClass [ diff --git a/src/Spec2-Code/SpCodeBehaviorInteractionModel.class.st b/src/Spec2-Code/SpCodeBehaviorInteractionModel.class.st index 5d95a5e85..d078101cc 100644 --- a/src/Spec2-Code/SpCodeBehaviorInteractionModel.class.st +++ b/src/Spec2-Code/SpCodeBehaviorInteractionModel.class.st @@ -32,6 +32,14 @@ SpCodeBehaviorInteractionModel >> bindingOf: aString [ ^ self behavior bindingOf: aString ] +{ #category : 'accessing' } +SpCodeBehaviorInteractionModel >> compiler [ + + ^ super compiler + class: self behavior; + yourself +] + { #category : 'testing' } SpCodeBehaviorInteractionModel >> hasBindingOf: aString [ diff --git a/src/Spec2-Code/SpCodeInteractionModel.class.st b/src/Spec2-Code/SpCodeInteractionModel.class.st index 9d9e66737..64f54071c 100644 --- a/src/Spec2-Code/SpCodeInteractionModel.class.st +++ b/src/Spec2-Code/SpCodeInteractionModel.class.st @@ -49,9 +49,11 @@ SpCodeInteractionModel >> compiler [ "Provide a compiler set up on the current context/class/receiver" ^ self doItReceiver class compiler - context: self doItContext; - receiver: self doItReceiver; - requestor: self + context: self doItContext; + receiver: self doItReceiver; + isScripting: self isScripting; + requestor: self; + yourself ] { #category : 'accessing' } diff --git a/src/Spec2-Code/SpCodeMethodInteractionModel.class.st b/src/Spec2-Code/SpCodeMethodInteractionModel.class.st index 37924abbf..d4e8b360f 100644 --- a/src/Spec2-Code/SpCodeMethodInteractionModel.class.st +++ b/src/Spec2-Code/SpCodeMethodInteractionModel.class.st @@ -27,6 +27,14 @@ SpCodeMethodInteractionModel >> bindingOf: aString [ ^ self behavior bindingOf: aString ] +{ #category : 'accessing' } +SpCodeMethodInteractionModel >> compiler [ + + ^ super compiler + class: self behavior; + yourself +] + { #category : 'accessing' } SpCodeMethodInteractionModel >> doItReceiver [ @@ -42,7 +50,9 @@ SpCodeMethodInteractionModel >> hasBindingOf: aString [ { #category : 'testing' } SpCodeMethodInteractionModel >> isScripting [ - ^ method ifNotNil: [ method isDoIt ] ifNil: [ false ] + ^ method + ifNotNil: [ method isDoIt ] + ifNil: [ false ] ] { #category : 'accessing' } diff --git a/src/Spec2-Code/SpCodePopoverErrorPresenter.class.st b/src/Spec2-Code/SpCodePopoverErrorPresenter.class.st index d82d6b0c0..ab689be59 100644 --- a/src/Spec2-Code/SpCodePopoverErrorPresenter.class.st +++ b/src/Spec2-Code/SpCodePopoverErrorPresenter.class.st @@ -52,17 +52,16 @@ SpCodePopoverErrorPresenter >> initializePresenters [ self initializeText. - layout := SpBoxLayout newTopToBottom + self layout: (SpBoxLayout newTopToBottom add: text expand: false; - yourself. + yourself). self flag: #TODO. "This is uber bad. Keybindings needs to come from application configuration" - text - bindKeyCombination: - Character escape asKeyCombination + text addShortcutWith: [ :action | action + shortcutKey: Character escape asKeyCombination | Character backspace asKeyCombination - | Character cr asKeyCombination - toAction: [ self dismiss ] + | Character cr asKeyCombination; + action: [ self dismiss ] ] ] { #category : 'initialization' } diff --git a/src/Spec2-Code/SpCodePopoverPrintPresenter.class.st b/src/Spec2-Code/SpCodePopoverPrintPresenter.class.st index 3fe4662df..9a695bf68 100644 --- a/src/Spec2-Code/SpCodePopoverPrintPresenter.class.st +++ b/src/Spec2-Code/SpCodePopoverPrintPresenter.class.st @@ -100,14 +100,20 @@ SpCodePopoverPrintPresenter >> initializePresenters [ self flag: #TODO. "This is uber bad. Keybindings needs to come from application configuration" text - bindKeyCombination: Character cr asKeyCombination - toAction: [ self dismissAndPrint ]; - bindKeyCombination: $p meta - toAction: [ self dismissAndPrintWithoutColons ]; - bindKeyCombination: $i meta - toAction: [ self dismissAndInspect ]; - bindKeyCombination: Character escape asKeyCombination | Character backspace asKeyCombination | $l meta - toAction: [ self dismiss ] + addShortcutWith: [ :action | action + shortcutKey: Character cr asKeyCombination; + action: [ self dismissAndPrint ] ]; + addShortcutWith: [ :action | action + shortcutKey: $p actionModifier; + action: [ self dismissAndPrintWithoutColons ] ]; + addShortcutWith: [ :action | action + shortcutKey: $i actionModifier; + action: [ self dismissAndInspect ] ]; + addShortcutWith: [ :action | action + shortcutKey: Character escape asKeyCombination + | Character backspace asKeyCombination + | $l actionModifier; + action: [ self dismiss ] ] ] { #category : 'initialization' } diff --git a/src/Spec2-Code/SpCodePresenter.class.st b/src/Spec2-Code/SpCodePresenter.class.st index 674094305..f6865c75c 100644 --- a/src/Spec2-Code/SpCodePresenter.class.st +++ b/src/Spec2-Code/SpCodePresenter.class.st @@ -135,9 +135,7 @@ SpCodePresenter class >> exampleOverridingContextMenu [ ^ self new overridingContextMenu; - contextMenu: (SpMenuPresenter new - addGroup: [ :group | group addItem: [ :item | - item name: 'Testing' ] ]); + addActionWith: [ :action| action name: 'Testing' ]; text: 'some method: 42'; open ] @@ -211,34 +209,6 @@ SpCodePresenter >> bindingOf: aString [ ^ nil ] -{ #category : 'private' } -SpCodePresenter >> buildContextKeyBindingsWith: aCategory [ - | category | - - category := self newContextMenuKeyBindings. - aCategory ifNotNil: [ - aCategory allEntries keymaps do: [ :each | - category addKeymapEntry: each ] ]. - - ^ category -] - -{ #category : 'private' } -SpCodePresenter >> buildContextMenuWith: aValuable [ - | menuPresenter | - - overrideContextMenu ifTrue: [ - ^ aValuable ]. - - menuPresenter := self newContextMenu. - aValuable ifNotNil: [ - aValuable value ifNotNil: [ :menu | - menu menuGroups do: [ :aGroup | - menuPresenter addMenuGroup: aGroup ] ] ]. - - ^ menuPresenter -] - { #category : 'testing' } SpCodePresenter >> canAddBindingOf: name [ @@ -253,24 +223,6 @@ SpCodePresenter >> clearInteractionModel [ self interactionModel: SpCodeNullInteractionModel new ] -{ #category : 'api - shortcuts' } -SpCodePresenter >> contextKeyBindings [ - - ^ self buildContextKeyBindingsWith: super contextKeyBindings -] - -{ #category : 'api' } -SpCodePresenter >> contextMenu [ - "The code presenter context menu is a compound of two menus: - 1) the basic interoperation menu (that includes operations like cut&paste but also do it, - print it, etc. - 2) the user defined context menu. - If you want to override completely this menu you need to set the 'overrideMenu' property - to true" - - ^ [ self buildContextMenuWith: super contextMenu ] -] - { #category : 'commands' } SpCodePresenter >> doBrowseClass [ | result | @@ -283,10 +235,8 @@ SpCodePresenter >> doBrowseClass [ ifTrue: [ | classToBrowse | classToBrowse := self class environment at: result ifAbsent: [ nil ]. - classToBrowse ifNotNil: [ ^ self systemNavigation browse: classToBrowse ] ]. - result - ifNil: [ self systemNavigation browseAllImplementorsOf: self selectedTextOrLine asSymbol ] - ifNotNil: [ self systemNavigation browse: result ] + classToBrowse ifNotNil: [ ^ self systemNavigation browse: classToBrowse ] ]. + self systemNavigation browse: result ] { #category : 'commands' } @@ -597,7 +547,7 @@ SpCodePresenter >> isScripting [ ifNil: [ false ] ] -{ #category : 'accessing' } +{ #category : 'private' } SpCodePresenter >> lineNumbers: aBoolean [ lineNumbers := aBoolean @@ -612,7 +562,7 @@ SpCodePresenter >> lookupEnvironment [ ifNil: [ self class environment ] ]) ] -{ #category : 'testing' } +{ #category : 'private - testing' } SpCodePresenter >> needRequestorScope [ ^ self interactionModel @@ -620,18 +570,6 @@ SpCodePresenter >> needRequestorScope [ ifNil: [ false ] ] -{ #category : 'private' } -SpCodePresenter >> newContextMenu [ - - ^ self rootCommandsGroup asMenuPresenter -] - -{ #category : 'private' } -SpCodePresenter >> newContextMenuKeyBindings [ - - ^ self rootCommandsGroup asKMCategory -] - { #category : 'private' } SpCodePresenter >> overrideContextMenu: aBoolean [ "This property set the type of menu to use: if #overrideContextMenu is false (the default), diff --git a/src/Spec2-Commander2/CmUICommandDisplayStrategy.extension.st b/src/Spec2-Commander2/CmUICommandDisplayStrategy.extension.st index 6a46b15d8..4c0a51557 100644 --- a/src/Spec2-Commander2/CmUICommandDisplayStrategy.extension.st +++ b/src/Spec2-Commander2/CmUICommandDisplayStrategy.extension.st @@ -2,10 +2,9 @@ Extension { #name : 'CmUICommandDisplayStrategy' } { #category : '*Spec2-Commander2' } CmUICommandDisplayStrategy >> display: aCmSpecCommand in: aMenuOrGroupPresenter do: aBlock [ - aMenuOrGroupPresenter addItem: [ :item | aBlock value: item. - item enabled: [ aCmSpecCommand canBeExecuted ]. + item enabled: aCmSpecCommand canBeExecuted. item ] ] diff --git a/src/Spec2-Commander2/CmUICommandGroupDisplayStrategy.extension.st b/src/Spec2-Commander2/CmUICommandGroupDisplayStrategy.extension.st index 8dbecde72..d5459188a 100644 --- a/src/Spec2-Commander2/CmUICommandGroupDisplayStrategy.extension.st +++ b/src/Spec2-Commander2/CmUICommandGroupDisplayStrategy.extension.st @@ -4,3 +4,15 @@ Extension { #name : 'CmUICommandGroupDisplayStrategy' } CmUICommandGroupDisplayStrategy >> display: aCmSpecCommandGroup in: aMenuPresenter do: aBlock [ self subclassResponsibility ] + +{ #category : '*Spec2-Commander2' } +CmUICommandGroupDisplayStrategy >> isGroup [ + + self subclassResponsibility +] + +{ #category : '*Spec2-Commander2' } +CmUICommandGroupDisplayStrategy >> isSubMenu [ + + ^ self isGroup not +] diff --git a/src/Spec2-Commander2/CmUIDisplayAsGroup.extension.st b/src/Spec2-Commander2/CmUIDisplayAsGroup.extension.st index c302a86e5..03007e83a 100644 --- a/src/Spec2-Commander2/CmUIDisplayAsGroup.extension.st +++ b/src/Spec2-Commander2/CmUIDisplayAsGroup.extension.st @@ -2,7 +2,13 @@ Extension { #name : 'CmUIDisplayAsGroup' } { #category : '*Spec2-Commander2' } CmUIDisplayAsGroup >> display: aCmSpecCommandGroup in: aMenuPresenter do: aBlock [ - + aMenuPresenter addGroup: [ :menuGroup | aBlock value: menuGroup ] ] + +{ #category : '*Spec2-Commander2' } +CmUIDisplayAsGroup >> isGroup [ + + ^ true +] diff --git a/src/Spec2-Commander2/CmUIDisplayAsSubMenu.extension.st b/src/Spec2-Commander2/CmUIDisplayAsSubMenu.extension.st index 2dbf3cf73..dd63792bd 100644 --- a/src/Spec2-Commander2/CmUIDisplayAsSubMenu.extension.st +++ b/src/Spec2-Commander2/CmUIDisplayAsSubMenu.extension.st @@ -22,3 +22,9 @@ CmUIDisplayAsSubMenu >> fillSubMenuIn: menuItem with: aCmSpecCommandGroup do: aB aBlock value: subMenu. ^ subMenu ] + +{ #category : '*Spec2-Commander2' } +CmUIDisplayAsSubMenu >> isGroup [ + + ^ false +] diff --git a/src/Spec2-Commander2/SpAbstractListPresenter.extension.st b/src/Spec2-Commander2/SpAbstractListPresenter.extension.st index 9a3492d84..af2fc78f6 100644 --- a/src/Spec2-Commander2/SpAbstractListPresenter.extension.st +++ b/src/Spec2-Commander2/SpAbstractListPresenter.extension.st @@ -2,5 +2,6 @@ Extension { #name : 'SpAbstractListPresenter' } { #category : '*Spec2-Commander2' } SpAbstractListPresenter >> contextMenuFromCommandsGroup: aValuable [ - self contextMenu: [ aValuable value beRoot asMenuPresenter ] + + self actions: aValuable value ] diff --git a/src/Spec2-Commander2/SpAbstractTextPresenter.extension.st b/src/Spec2-Commander2/SpAbstractTextPresenter.extension.st index 9d8b8a6f9..f22d87146 100644 --- a/src/Spec2-Commander2/SpAbstractTextPresenter.extension.st +++ b/src/Spec2-Commander2/SpAbstractTextPresenter.extension.st @@ -2,5 +2,6 @@ Extension { #name : 'SpAbstractTextPresenter' } { #category : '*Spec2-Commander2' } SpAbstractTextPresenter >> contextMenuFromCommandsGroup: aValuable [ - self contextMenu: [ aValuable value beRoot asMenuPresenter ] + + self actions: aValuable value ] diff --git a/src/Spec2-Commander2/SpAbstractTreePresenter.extension.st b/src/Spec2-Commander2/SpAbstractTreePresenter.extension.st index bb2ff41a4..fabfe79bf 100644 --- a/src/Spec2-Commander2/SpAbstractTreePresenter.extension.st +++ b/src/Spec2-Commander2/SpAbstractTreePresenter.extension.st @@ -2,5 +2,6 @@ Extension { #name : 'SpAbstractTreePresenter' } { #category : '*Spec2-Commander2' } SpAbstractTreePresenter >> contextMenuFromCommandsGroup: aValuable [ - self contextMenu: [ aValuable value beRoot asMenuPresenter ] + + self actions: aValuable value ] diff --git a/src/Spec2-Commander2/SpAction.class.st b/src/Spec2-Commander2/SpAction.class.st index bf65a923f..3286941f5 100644 --- a/src/Spec2-Commander2/SpAction.class.st +++ b/src/Spec2-Commander2/SpAction.class.st @@ -8,7 +8,9 @@ Class { 'action', 'actionEnabled', 'visible', - 'actionVisible' + 'actionVisible', + 'id', + 'dynamicName' ], #category : 'Spec2-Commander2-Action', #package : 'Spec2-Commander2', @@ -25,7 +27,7 @@ SpAction class >> newName: aName action: aBlock [ ] { #category : 'instance creation' } -SpAction class >> newName: aName shortcut: aShortcut action: aBlock [ +SpAction class >> newName: aName shortcutKey: aShortcut action: aBlock [ ^ self new name: aName; @@ -35,17 +37,25 @@ SpAction class >> newName: aName shortcut: aShortcut action: aBlock [ ] { #category : 'instance creation' } -SpAction class >> newShortcut: aShortcut action: aBlock [ +SpAction class >> newShortcutKey: aShortcut action: aBlock [ "action without menu entry" ^ self new - name: aShortcut asString; + beShortcutOnly; shortcutKey: aShortcut; action: aBlock; - beShortcutOnly; yourself ] +{ #category : 'comparing' } +SpAction >> = anObject [ + "Answer whether the receiver and anObject represent the same object." + + self == anObject ifTrue: [ ^ true ]. + self class = anObject class ifFalse: [ ^ false ]. + ^ self id = anObject id +] + { #category : 'accessing' } SpAction >> action: aBlock [ @@ -83,6 +93,23 @@ SpAction >> canBeExecuted [ ^ actionEnabled cull: self context ] +{ #category : 'accessing' } +SpAction >> dynamicName [ + + ^ dynamicName + ifNotNil: [ :aBlock | aBlock value ] + ifNil: [ super dynamicName ] +] + +{ #category : 'accessing' } +SpAction >> dynamicName: aBlock [ + + "since name works also as identifier, we need one" + self name + ifNil: [ self name: 'dynamic-', UUID new asString ]. + dynamicName := aBlock +] + { #category : 'executing' } SpAction >> execute [ @@ -92,6 +119,19 @@ SpAction >> execute [ action cull: self context ] +{ #category : 'comparing' } +SpAction >> hash [ + "Answer an integer value that is related to the identity of the receiver." + + ^ self id hash +] + +{ #category : 'private' } +SpAction >> id [ + + ^ id ifNil: [ id := super id ] +] + { #category : 'initialization' } SpAction >> initialize [ @@ -122,7 +162,9 @@ SpAction >> printOn: stream [ { #category : 'accessing' } SpAction >> shortcut: aKeyCombination [ - "just a synonym" - + + self + deprecated: 'It was a bad idea' + transformWith: '@receiver shortcut: `@arg1' -> '@receiver shortcutKey: `@arg1'. self shortcutKey: aKeyCombination ] diff --git a/src/Spec2-Commander2/SpActionBarPresenter.extension.st b/src/Spec2-Commander2/SpActionBarPresenter.extension.st new file mode 100644 index 000000000..ebccda0a2 --- /dev/null +++ b/src/Spec2-Commander2/SpActionBarPresenter.extension.st @@ -0,0 +1,22 @@ +Extension { #name : 'SpActionBarPresenter' } + +{ #category : '*Spec2-Commander2' } +SpActionBarPresenter >> addItemLeft: anItem [ + + self add: anItem +] + +{ #category : '*Spec2-Commander2' } +SpActionBarPresenter >> addItemRight: anItem [ + + self addLast: anItem +] + +{ #category : '*Spec2-Commander2' } +SpActionBarPresenter >> fillWith: aCommandGroup [ + + items removeAll. + SpActionBarPresenterBuilder new + actionBarPresenter: self; + visit: aCommandGroup +] diff --git a/src/Spec2-Commander2/SpActionBarPresenterBuilder.class.st b/src/Spec2-Commander2/SpActionBarPresenterBuilder.class.st index 04f993272..f6cf77592 100644 --- a/src/Spec2-Commander2/SpActionBarPresenterBuilder.class.st +++ b/src/Spec2-Commander2/SpActionBarPresenterBuilder.class.st @@ -32,6 +32,7 @@ SpActionBarPresenterBuilder >> initialize [ { #category : 'visiting' } SpActionBarPresenterBuilder >> visitCommand: aCmCommandEntry [ + aCmCommandEntry positionStrategy addButton: aCmCommandEntry asButtonPresenter toActionBar: self actionBarPresenter diff --git a/src/Spec2-Commander2/SpActionGroup.class.st b/src/Spec2-Commander2/SpActionGroup.class.st index 7340f4dd8..9b386ca11 100644 --- a/src/Spec2-Commander2/SpActionGroup.class.st +++ b/src/Spec2-Commander2/SpActionGroup.class.st @@ -4,6 +4,9 @@ An action group is a spec command group (`SpCommandGroup`) that will be used for Class { #name : 'SpActionGroup', #superclass : 'SpCommandGroup', + #instVars : [ + 'id' + ], #category : 'Spec2-Commander2-Action', #package : 'Spec2-Commander2', #tag : 'Action' @@ -25,10 +28,19 @@ SpActionGroup class >> newName: aName with: aBlock [ yourself ] +{ #category : 'comparing' } +SpActionGroup >> = anObject [ + "Answer whether the receiver and anObject represent the same object." + + self == anObject ifTrue: [ ^ true ]. + self class = anObject class ifFalse: [ ^ false ]. + ^ self id = anObject id +] + { #category : 'accessing' } -SpActionGroup >> add: anAction [ +SpActionGroup >> add: anActionOrGroup [ - self register: anAction + self register: anActionOrGroup ] { #category : 'accessing' } @@ -60,9 +72,44 @@ SpActionGroup >> addShortcutWith: aBlock [ self add: action ] +{ #category : 'converting' } +SpActionGroup >> asMenuPresenter [ + + ^ SpActionMenuPresenterBuilder new + visit: self; + menuPresenter +] + +{ #category : 'comparing' } +SpActionGroup >> hash [ + "Answer an integer value that is related to the identity of the receiver." + + ^ self id hash +] + +{ #category : 'accessing' } +SpActionGroup >> id [ + + ^ id ifNil: [ id := super id ] +] + { #category : 'initialization' } SpActionGroup >> initialize [ decoratedGroup := SpBaseActionGroup new. super initialize ] + +{ #category : 'accessing' } +SpActionGroup >> remove: aCommandOrGroup [ + + self unregister: aCommandOrGroup +] + +{ #category : 'accessing' } +SpActionGroup >> removeAll [ + + self entries copy + do: [ :each | self remove: each ] + +] diff --git a/src/Spec2-Commander2/SpActionMenuPresenterBuilder.class.st b/src/Spec2-Commander2/SpActionMenuPresenterBuilder.class.st new file mode 100644 index 000000000..94c24a7f4 --- /dev/null +++ b/src/Spec2-Commander2/SpActionMenuPresenterBuilder.class.st @@ -0,0 +1,45 @@ +Class { + #name : 'SpActionMenuPresenterBuilder', + #superclass : 'SpMenuPresenterBuilder', + #category : 'Spec2-Commander2-Action', + #package : 'Spec2-Commander2', + #tag : 'Action' +} + +{ #category : 'private' } +SpActionMenuPresenterBuilder >> fillItem: aMenuItem with: aCommand [ + + super fillItem: aMenuItem with: aCommand. + aMenuItem name: aCommand dynamicName +] + +{ #category : 'accessing' } +SpActionMenuPresenterBuilder >> menuPresenter: aMenuPresenter [ + + menuPresenter := aMenuPresenter. + stack := Stack new + push: self menuPresenter; + yourself +] + +{ #category : 'visiting' } +SpActionMenuPresenterBuilder >> visitCommand: aCmCommand [ + + aCmCommand isVisible ifFalse: [ ^ self ]. + super visitCommand: aCmCommand +] + +{ #category : 'visiting' } +SpActionMenuPresenterBuilder >> visitCommandDynamicGroup: aDynamicGroup [ + + aDynamicGroup + displayIn: stack top + do: [ :specGroupOrSubMenu | + | group | + stack push: specGroupOrSubMenu. + group := SpActionGroup new. + aDynamicGroup dynamicBuilder value: group. + group entries do: [ :each | + each acceptVisitor: self ]. + stack pop ] +] diff --git a/src/Spec2-Commander2/SpBaseActionGroup.class.st b/src/Spec2-Commander2/SpBaseActionGroup.class.st index a6a70e1e4..d74e863f1 100644 --- a/src/Spec2-Commander2/SpBaseActionGroup.class.st +++ b/src/Spec2-Commander2/SpBaseActionGroup.class.st @@ -1,3 +1,8 @@ +" +Since spec command groups require a parent command group we define a base that may be used to create `SpActionGroup` instances without needing a `CmCommandGroup` before. + +Users should not use this class directly. +" Class { #name : 'SpBaseActionGroup', #superclass : 'CmCommandGroup', @@ -11,6 +16,9 @@ SpBaseActionGroup >> ensureNotDuplicated: aCommandOrGroup [ "we do not really care if this has not name (since groups as sections may not show it and actions as shortcuts do not need it)" - aCommandOrGroup name ifNil: [ ^ self ]. + ((aCommandOrGroup name isEmptyOrNil) or: [ aCommandOrGroup name = self class defaultName ]) + ifTrue: [ + "generate an unique name, since I do not care but it may be bad for generating ;)" + aCommandOrGroup assignUniqueName ]. super ensureNotDuplicated: aCommandOrGroup ] diff --git a/src/Spec2-Commander2/SpButtonPresenter.extension.st b/src/Spec2-Commander2/SpButtonPresenter.extension.st index 88b127b62..f1579de74 100644 --- a/src/Spec2-Commander2/SpButtonPresenter.extension.st +++ b/src/Spec2-Commander2/SpButtonPresenter.extension.st @@ -2,5 +2,6 @@ Extension { #name : 'SpButtonPresenter' } { #category : '*Spec2-Commander2' } SpButtonPresenter >> contextMenuFromCommandsGroup: aValuable [ - self contextMenu: [ aValuable value beRoot asMenuPresenter ] + + self actions: aValuable value ] diff --git a/src/Spec2-Commander2/SpCommand.class.st b/src/Spec2-Commander2/SpCommand.class.st index 22b2c7608..a48dfba46 100644 --- a/src/Spec2-Commander2/SpCommand.class.st +++ b/src/Spec2-Commander2/SpCommand.class.st @@ -20,6 +20,14 @@ Class { #tag : 'Core' } +{ #category : 'converting' } +SpCommand >> asActionButtonPresenter [ + + ^ self asButtonPresenter + label: nil; + yourself +] + { #category : 'converting' } SpCommand >> asButtonPresenter [ self flag: #TODO. "Needs to use inform user display strategy when available, no other available strategy can be used in this context. See issue #705" @@ -27,6 +35,24 @@ SpCommand >> asButtonPresenter [ ^ self buildPresenter ] +{ #category : 'converting' } +SpCommand >> asToggleButtonPresenter [ + + self configureAsButtonOfClass: SpToggleButtonPresenter. + ^ self buildPresenter +] + +{ #category : 'initialization' } +SpCommand >> assignUniqueName [ + "we can find a name in case this command has a shortcut (and no name, + whoich would mean it will be *just* a shortcut." + + self name ifNotNil: [ ^ self ]. + self hasShortcutKey ifFalse: [ ^ self ]. + + self name: self id +] + { #category : 'presenter building' } SpCommand >> buildPresenter [ ^ presenter := self buildPresenterBlock value: self @@ -44,6 +70,7 @@ SpCommand >> buildPresenterBlock: anObject [ { #category : 'presenter building' } SpCommand >> configureAsButton [ + self configureAsButtonOfClass: SpButtonPresenter ] @@ -64,6 +91,7 @@ SpCommand >> configureAsButtonOfClass: aButtonClass [ { #category : 'presenter building' } SpCommand >> configureAsToolBarToggleButton [ + self configureAsButtonOfClass: SpToolbarToggleButtonPresenter ] @@ -87,6 +115,22 @@ SpCommand >> iconProvider [ ^ iconProvider ] +{ #category : 'private' } +SpCommand >> id [ + + ^ String streamContents: [ :stream | + | parts name | + + name := self name + ifNil: [ + self shortcutKey + ifNotNil: [ 'shortcut ', (KMShortcutPrinter toString: self shortcutKey) ] + ifNil: [ 'unknown' ] ]. + parts := name substrings. + stream << parts first asLowercase. + parts allButFirstDo: [ :each | stream << each capitalized ] ] +] + { #category : 'initialization' } SpCommand >> initialize [ diff --git a/src/Spec2-Commander2/SpCommandGroup.class.st b/src/Spec2-Commander2/SpCommandGroup.class.st index dd36fde79..93e2b3ba3 100644 --- a/src/Spec2-Commander2/SpCommandGroup.class.st +++ b/src/Spec2-Commander2/SpCommandGroup.class.st @@ -1,9 +1,9 @@ " -I am a command group decorator adding information useful in the context of a Spec application. +I am a command group decorator adding informations useful when for usage in context of a Spec application. Basically, I add: - an #icon (#blank by default) -- the strategy to display command groups in a `SpMenuPresenter`, `SpMenuBarPresenter`, or `SpToolbarPresenter` +- the strategy to display commands group in a MenuPresenter " Class { #name : 'SpCommandGroup', @@ -35,8 +35,8 @@ SpCommandGroup >> asMenuBarPresenter [ { #category : 'converting' } SpCommandGroup >> asMenuBarPresenterWith: aBlock [ - | builder | + builder := SpMenuBarPresenterBuilder new. aBlock value: builder menuPresenter. ^ builder @@ -54,8 +54,8 @@ SpCommandGroup >> asMenuPresenter [ { #category : 'converting' } SpCommandGroup >> asMenuPresenterWith: aBlock [ - | builder | + builder := SpMenuPresenterBuilder new. aBlock value: builder menuPresenter. ^ builder @@ -63,6 +63,15 @@ SpCommandGroup >> asMenuPresenterWith: aBlock [ menuPresenter ] +{ #category : 'initialization' } +SpCommandGroup >> assignUniqueName [ + +(self name isNotNil and: [ self name ~= CmCommandGroup defaultName ]) + ifTrue: [ ^ self ]. + + self name: UUID new asString +] + { #category : 'configuring' } SpCommandGroup >> beToolbarGroup [ diff --git a/src/Spec2-Commander2/SpDynamicActionGroup.class.st b/src/Spec2-Commander2/SpDynamicActionGroup.class.st new file mode 100644 index 000000000..87c028ad2 --- /dev/null +++ b/src/Spec2-Commander2/SpDynamicActionGroup.class.st @@ -0,0 +1,91 @@ +" +An action group is a spec command group (`SpCommandGroup`) that will be used for dynamic context menus in the presenters that implement `SpTActionContainer` +" +Class { + #name : 'SpDynamicActionGroup', + #superclass : 'SpCommandGroup', + #instVars : [ + 'id', + 'dynamicBuilder' + ], + #category : 'Spec2-Commander2-Action', + #package : 'Spec2-Commander2', + #tag : 'Action' +} + +{ #category : 'instance creation' } +SpDynamicActionGroup class >> newName: aName [ + + ^ self new + name: aName; + yourself +] + +{ #category : 'instance creation' } +SpDynamicActionGroup class >> newName: aName with: aBlock [ + + ^ (self newName: aName) + in: [ :this | aBlock value: this ]; + yourself +] + +{ #category : 'instance creation' } +SpDynamicActionGroup class >> with: aBlock [ + + ^ self new with: aBlock +] + +{ #category : 'comparing' } +SpDynamicActionGroup >> = anObject [ + "Answer whether the receiver and anObject represent the same object." + + self == anObject ifTrue: [ ^ true ]. + self class = anObject class ifFalse: [ ^ false ]. + ^ self id = anObject id +] + +{ #category : 'visiting' } +SpDynamicActionGroup >> acceptVisitor: aVisitor [ + + ^ aVisitor visitCommandDynamicGroup: self +] + +{ #category : 'converting' } +SpDynamicActionGroup >> asMenuPresenter [ + + ^ SpActionMenuPresenterBuilder new + visit: self; + menuPresenter +] + +{ #category : 'private' } +SpDynamicActionGroup >> dynamicBuilder [ + + ^ dynamicBuilder +] + +{ #category : 'comparing' } +SpDynamicActionGroup >> hash [ + "Answer an integer value that is related to the identity of the receiver." + + ^ self id hash +] + +{ #category : 'accessing' } +SpDynamicActionGroup >> id [ + + ^ id ifNil: [ id := super id ] +] + +{ #category : 'initialization' } +SpDynamicActionGroup >> initialize [ + + decoratedGroup := SpBaseActionGroup new. + super initialize +] + +{ #category : 'accessing' } +SpDynamicActionGroup >> with: aBlock [ + + dynamicBuilder := aBlock +] diff --git a/src/Spec2-Commander2/SpMenuPresenter.extension.st b/src/Spec2-Commander2/SpMenuPresenter.extension.st index dd0804305..6bb7f71a2 100644 --- a/src/Spec2-Commander2/SpMenuPresenter.extension.st +++ b/src/Spec2-Commander2/SpMenuPresenter.extension.st @@ -1,16 +1,7 @@ Extension { #name : 'SpMenuPresenter' } -{ #category : '*Spec2-Commander2' } -SpMenuPresenter >> fillWith: aCommandGroup [ - - self removeAllItems. - self presenterBuilderClass new - menuPresenter: self; - visit: aCommandGroup -] - { #category : '*Spec2-Commander2' } SpMenuPresenter >> presenterBuilderClass [ - ^ SpMenuPresenterBuilder + ^ SpActionMenuPresenterBuilder ] diff --git a/src/Spec2-Commander2/SpMenuPresenterBuilder.class.st b/src/Spec2-Commander2/SpMenuPresenterBuilder.class.st index 190c05b14..fcc37cb7f 100644 --- a/src/Spec2-Commander2/SpMenuPresenterBuilder.class.st +++ b/src/Spec2-Commander2/SpMenuPresenterBuilder.class.st @@ -37,7 +37,10 @@ SpMenuPresenterBuilder >> fillItem: aMenuItem with: aCommand [ SpMenuPresenterBuilder >> initialize [ super initialize. - self menuPresenter: self class menuPresenterClass new + self menuPresenter: self class menuPresenterClass new. + stack := Stack new + push: self menuPresenter; + yourself ] { #category : 'accessing' } @@ -47,11 +50,7 @@ SpMenuPresenterBuilder >> menuPresenter [ { #category : 'accessing' } SpMenuPresenterBuilder >> menuPresenter: anObject [ - - menuPresenter := anObject. - stack := Stack new - push: self menuPresenter; - yourself + menuPresenter := anObject ] { #category : 'visiting' } @@ -68,11 +67,11 @@ SpMenuPresenterBuilder >> visitCommandGroup: aCmCommandsGroup [ aCmCommandsGroup isRoot ifTrue: [ super visitCommandGroup: aCmCommandsGroup. ^ self ]. - + aCmCommandsGroup displayIn: stack top do: [ :specGroupOrSubMenu | stack push: specGroupOrSubMenu. - super visitCommandGroup: aCmCommandsGroup. - stack pop ] + [ super visitCommandGroup: aCmCommandsGroup ] + ensure: [ stack pop ] ] ] diff --git a/src/Spec2-Commander2/SpShortcutInstaller.class.st b/src/Spec2-Commander2/SpShortcutInstaller.class.st index e4e8c33bf..9f3ccefb5 100644 --- a/src/Spec2-Commander2/SpShortcutInstaller.class.st +++ b/src/Spec2-Commander2/SpShortcutInstaller.class.st @@ -24,10 +24,12 @@ SpShortcutInstaller >> presenter: anObject [ { #category : 'visiting' } SpShortcutInstaller >> visitCommand: aCmCommand [ + aCmCommand hasShortcutKey ifFalse: [ ^ self ]. - self presenter - bindKeyCombination: aCmCommand shortcutKey - toAction: [ aCmCommand canBeExecuted - ifTrue: [ aCmCommand execute ] ] + + self presenter addShortcutWith: [ :action | action + shortcutKey: aCmCommand shortcutKey; + action: [ aCmCommand canBeExecuted + ifTrue: [ aCmCommand execute ] ] ] ] diff --git a/src/Spec2-Commands/SpBrowseMethodReferencesCommand.class.st b/src/Spec2-Commands/SpBrowseMethodReferencesCommand.class.st index e85001a7c..ba5cd9dff 100644 --- a/src/Spec2-Commands/SpBrowseMethodReferencesCommand.class.st +++ b/src/Spec2-Commands/SpBrowseMethodReferencesCommand.class.st @@ -11,6 +11,7 @@ Class { { #category : 'default' } SpBrowseMethodReferencesCommand class >> defaultDescription [ + ^ 'Browse all references to the selected method or selector' ] diff --git a/src/Spec2-CommonWidgets/SpFilteringListPresenter.class.st b/src/Spec2-CommonWidgets/SpFilteringListPresenter.class.st index 9f5109982..3783c2121 100644 --- a/src/Spec2-CommonWidgets/SpFilteringListPresenter.class.st +++ b/src/Spec2-CommonWidgets/SpFilteringListPresenter.class.st @@ -47,6 +47,18 @@ SpFilteringListPresenter class >> topLayout [ yourself ] +{ #category : 'api - actions' } +SpFilteringListPresenter >> actions [ + + ^ listPresenter actions +] + +{ #category : 'api - actions' } +SpFilteringListPresenter >> actions: aCommandGroup [ + + listPresenter actions: aCommandGroup +] + { #category : 'api' } SpFilteringListPresenter >> applyFilter: aString [ @@ -95,6 +107,12 @@ SpFilteringListPresenter >> displayIcon: aBlock [ self listPresenter displayIcon: aBlock ] +{ #category : 'private - actions' } +SpFilteringListPresenter >> ensureActions [ + + ^ listPresenter ensureActions +] + { #category : 'accessing' } SpFilteringListPresenter >> filterInputPresenter [ @@ -123,13 +141,6 @@ SpFilteringListPresenter >> filterText [ ^ self filterInputPresenter text ] -{ #category : 'api' } -SpFilteringListPresenter >> headerTitle: aString [ - "Set the receiver's title to aString" - - listPresenter headerTitle: aString -] - { #category : 'initialization' } SpFilteringListPresenter >> initializePresenters [ diff --git a/src/Spec2-CommonWidgets/SpFilteringSelectableListPresenter.class.st b/src/Spec2-CommonWidgets/SpFilteringSelectableListPresenter.class.st index 580f4c1b5..483264a2f 100644 --- a/src/Spec2-CommonWidgets/SpFilteringSelectableListPresenter.class.st +++ b/src/Spec2-CommonWidgets/SpFilteringSelectableListPresenter.class.st @@ -80,12 +80,12 @@ SpFilteringSelectableListPresenter >> initializePresenters [ super initializePresenters. listPresenter - bindKeyCombination: Character space - toAction: [ self toggleSelection ]. + addShortcutWith: [ :action | action + shortcutKey: Character space asKeyCombination; + action: [ self toggleSelection ] ]. - listPresenter selection whenSelectedIndexChangedDo: [ - :newIndex - :prevIndex | previousSelectedIndex := prevIndex ]. + listPresenter selection whenSelectedIndexChangedDo: [ :newIndex :prevIndex | + previousSelectedIndex := prevIndex ]. listPresenter eventHandler whenMouseDownDo: [ :event | event shiftPressed @@ -96,8 +96,9 @@ SpFilteringSelectableListPresenter >> initializePresenters [ ifFalse: [ self toggleSelection ] ]. listPresenter - bindKeyCombination: $a meta - toAction: [ self activateAll ] + addShortcutWith: [ :action | action + shortcutKey: $a actionModifier; + action: [ self activateAll ] ] ] { #category : 'api' } diff --git a/src/Spec2-Core/CmUICommand.extension.st b/src/Spec2-Core/CmUICommand.extension.st new file mode 100644 index 000000000..b7e7537b5 --- /dev/null +++ b/src/Spec2-Core/CmUICommand.extension.st @@ -0,0 +1,7 @@ +Extension { #name : 'CmUICommand' } + +{ #category : '*Spec2-Core' } +CmUICommand >> isVisible [ + + ^ true +] diff --git a/src/Spec2-Core/CmVisitor.extension.st b/src/Spec2-Core/CmVisitor.extension.st new file mode 100644 index 000000000..e0acc8278 --- /dev/null +++ b/src/Spec2-Core/CmVisitor.extension.st @@ -0,0 +1,7 @@ +Extension { #name : 'CmVisitor' } + +{ #category : '*Spec2-Core' } +CmVisitor >> visitCommandDynamicGroup: aDynamicGroup [ + + ^ self visitCommandGroup: aDynamicGroup +] diff --git a/src/Spec2-Core/SpAbstractFormButtonPresenter.class.st b/src/Spec2-Core/SpAbstractFormButtonPresenter.class.st index 8d9c5cdbb..a7f3445cc 100644 --- a/src/Spec2-Core/SpAbstractFormButtonPresenter.class.st +++ b/src/Spec2-Core/SpAbstractFormButtonPresenter.class.st @@ -28,6 +28,12 @@ SpAbstractFormButtonPresenter >> click [ self toggleState ] +{ #category : 'testing' } +SpAbstractFormButtonPresenter >> hasLabel [ + + ^ self label isEmptyOrNil not +] + { #category : 'initialization' } SpAbstractFormButtonPresenter >> initialize [ super initialize. diff --git a/src/Spec2-Core/SpAbstractListPresenter.class.st b/src/Spec2-Core/SpAbstractListPresenter.class.st index 3500784df..a99e5f5e0 100644 --- a/src/Spec2-Core/SpAbstractListPresenter.class.st +++ b/src/Spec2-Core/SpAbstractListPresenter.class.st @@ -104,6 +104,7 @@ SpAbstractListPresenter >> disableActivationDuring: aBlock [ SpAbstractListPresenter >> doActivateAtIndex: anIndex [ "Activate only if there is an item at that position" + activationBlock ifNil: [ ^ self ]. self model at: anIndex ifAbsent: [ ^ self ]. activationBlock cull: ((SpSingleSelectionMode on: self) @@ -119,15 +120,6 @@ SpAbstractListPresenter >> doubleClickAtIndex: anIndex [ self doActivateAtIndex: anIndex ] -{ #category : 'api' } -SpAbstractListPresenter >> indexOf: anItem ifAbsent: aBlock [ - "Answer the index of the first occurrence of anElement within the receiver. If the receiver does not contain anElement, answer the result of evaluating the argument, exceptionBlock." - - ^ self model - indexOf: anItem - ifAbsent: aBlock -] - { #category : 'initialization' } SpAbstractListPresenter >> initialize [ @@ -143,6 +135,7 @@ SpAbstractListPresenter >> initialize [ self beSingleSelection. self activateOnDoubleClick. + self registerActions. self registerEvents ] @@ -198,8 +191,8 @@ SpAbstractListPresenter >> items: aSequenceableCollection [ `aSequenceableCollection` is a collection of your domain specific items. This resets the collection model and unselects any previously selected item." - model collection: aSequenceableCollection. - self unselectAll + self unselectAll. + model collection: aSequenceableCollection ] { #category : 'private' } @@ -248,6 +241,15 @@ SpAbstractListPresenter >> refresh [ self withAdapterDo: [ :anAdapter | anAdapter refreshList ] ] +{ #category : 'initialization' } +SpAbstractListPresenter >> registerActions [ + + self ensureInternalActions + addShortcutWith: [ :action | action + shortcutKey: $t actionModifier; + action: [ self showContextMenu ] ] +] + { #category : 'initialization' } SpAbstractListPresenter >> registerEvents [ diff --git a/src/Spec2-Core/SpAbstractPresenter.class.st b/src/Spec2-Core/SpAbstractPresenter.class.st index a5bd86951..df2d016c5 100644 --- a/src/Spec2-Core/SpAbstractPresenter.class.st +++ b/src/Spec2-Core/SpAbstractPresenter.class.st @@ -295,7 +295,7 @@ SpAbstractPresenter >> hasOwner [ { #category : 'testing' } SpAbstractPresenter >> hasWindow [ - ^ self root isWindowPresenter + ^ self nearWindow notNil ] { #category : 'initialization' } @@ -352,6 +352,12 @@ SpAbstractPresenter >> layout [ self subclassResponsibility ] +{ #category : 'private' } +SpAbstractPresenter >> nearWindow [ + + ^ self owner ifNotNil: [ :anOwner | anOwner nearWindow ] +] + { #category : 'accessing' } SpAbstractPresenter >> needRebuild [ @@ -531,24 +537,22 @@ SpAbstractPresenter >> whenWillBeBuiltDo: aBlock [ { #category : 'accessing' } SpAbstractPresenter >> window [ - "Answer window containing this composition." + "Answer window containing this composition (windows can be nested, so we + need to answer the closest one)." - ^ self hasWindow - ifTrue: [ self root ] - ifFalse: [ nil ] + ^ self nearWindow ] { #category : 'private - utilities' } SpAbstractPresenter >> withAdapterDo: aValuable [ "a convenience method to avoid verify by nil all the time" - ^ self adapter ifNotNil: aValuable + ^ self adapter ifNotNil: [ :anAdapter | aValuable value: anAdapter ] ] { #category : 'private - utilities' } SpAbstractPresenter >> withWindowDo: aValuable [ - self hasWindow ifFalse: [ ^ nil ]. - "Since Presenter has window, root = window" - ^ aValuable value: self root + ^ self nearWindow + ifNotNil: [ :nearWindow | aValuable value: nearWindow ] ] diff --git a/src/Spec2-Core/SpAbstractSelectionMode.class.st b/src/Spec2-Core/SpAbstractSelectionMode.class.st index 2a69ee9ea..696de4df3 100644 --- a/src/Spec2-Core/SpAbstractSelectionMode.class.st +++ b/src/Spec2-Core/SpAbstractSelectionMode.class.st @@ -74,8 +74,10 @@ SpAbstractSelectionMode >> includesItem: anItem [ { #category : 'private' } SpAbstractSelectionMode >> indexOfItem: anItem [ - - ^ self model indexOf: anItem ifAbsent: 0 + + ^ self model + indexOf: anItem + ifAbsent: [ 0 ]. ] { #category : 'initialization' } diff --git a/src/Spec2-Core/SpAbstractTextPresenter.class.st b/src/Spec2-Core/SpAbstractTextPresenter.class.st index 9fee88aed..f8c5e6c6e 100644 --- a/src/Spec2-Core/SpAbstractTextPresenter.class.st +++ b/src/Spec2-Core/SpAbstractTextPresenter.class.st @@ -219,10 +219,10 @@ SpAbstractTextPresenter >> readSelectionBlock: aBlock [ { #category : 'initialization' } SpAbstractTextPresenter >> registerActions [ - self addActionWith: [ :action | action - beShortcutOnly; - shortcut: $t ctrl unix | $t ctrl win | $t command mac; - action: [ self showContextMenu ] ] + self ensureInternalActions + addShortcutWith: [ :action | action + shortcutKey: $t actionModifier; + action: [ self showContextMenu ] ] ] { #category : 'initialization' } @@ -371,9 +371,10 @@ SpAbstractTextPresenter >> whenResetDo: aBlock [ "Inform when a 'reset' event is triggered. It will react when user presses key (this is for historical reasons)." - self - bindKeyCombination: SpCancelChangesCommand defaultShortcutKey - toAction: aBlock + self ensureInternalActions + addShortcutWith: [ :action | action + shortcutKey: SpCancelChangesCommand defaultShortcutKey; + action: aBlock ] ] { #category : 'api - events' } diff --git a/src/Spec2-Core/SpAbstractTreePresenter.class.st b/src/Spec2-Core/SpAbstractTreePresenter.class.st index 6c577241f..921cf6b3f 100644 --- a/src/Spec2-Core/SpAbstractTreePresenter.class.st +++ b/src/Spec2-Core/SpAbstractTreePresenter.class.st @@ -47,6 +47,28 @@ SpAbstractTreePresenter >> activateOnSingleClick [ activateOnSingleClick := true ] +{ #category : 'api' } +SpAbstractTreePresenter >> activatesOnDoubleClick [ + "Answer true if activation event is triggered on double click" + + self + deprecated: 'Use isActiveOnDoubleClick' + transformWith: '`@receiver activatesOnDoubleClick' -> '`@receiver isActiveOnDoubleClick'. + + ^ activateOnSingleClick not +] + +{ #category : 'api' } +SpAbstractTreePresenter >> activatesOnSingleClick [ + "Answer true if activation event is triggered on single click" + + self + deprecated: 'Use isActiveOnSingleClick' + transformWith: '`@receiver activatesOnSingleClick' -> '`@receiver isActiveOnSingleClick'. + + ^ activateOnSingleClick +] + { #category : 'api' } SpAbstractTreePresenter >> beMultipleSelection [ "Enable multiple selection." @@ -61,7 +83,7 @@ SpAbstractTreePresenter >> beSingleSelection [ self selectionMode: (SpTreeSingleSelectionMode on: self) ] -{ #category : 'private' } +{ #category : 'api' } SpAbstractTreePresenter >> children [ ^ childrenBlock @@ -122,16 +144,30 @@ SpAbstractTreePresenter >> disableActivationDuring: aBlock [ SpAbstractTreePresenter >> doActivateAtPath: aPath [ "Activate only if there is an item at that position" + activationBlock ifNil: [ ^ self ]. self itemAtPath: aPath ifAbsent: [ ^ self ]. activationBlock cull: ((SpTreeSingleSelectionMode on: self) selectPath: aPath; yourself) ] +{ #category : 'private' } +SpAbstractTreePresenter >> doActivateSelected [ + "Activate only if there is an item at that position" + | selectedPath | + + activationBlock ifNil: [ ^ self ]. + selectedPath := self selection selectedPath. + selectedPath ifNil: [ ^ self ]. + activationBlock cull: ((SpTreeSingleSelectionMode on: self) + selectPath: selectedPath; + yourself) +] + { #category : 'simulation' } SpAbstractTreePresenter >> doubleClickAtPath: aPath [ + self selectPath: aPath. - activateOnSingleClick ifTrue: [ ^ self ]. self doActivateAtPath: aPath ] @@ -167,7 +203,9 @@ SpAbstractTreePresenter >> initialize [ super initialize. self initializeTSearchable. - self initializeTHaveWrappingScrollBars + self initializeTHaveWrappingScrollBars. + self withScrollBars. + self registerEvents ] { #category : 'testing' } @@ -288,6 +326,15 @@ SpAbstractTreePresenter >> refresh [ self withAdapterDo: [ :anAdapter | anAdapter refreshTree ] ] +{ #category : 'initialization' } +SpAbstractTreePresenter >> registerActions [ + + self ensureInternalActions + addShortcutWith: [ :action | action + shortcutKey: $t actionModifier; + action: [ self showContextMenu ] ] +] + { #category : 'initialization' } SpAbstractTreePresenter >> registerEvents [ @@ -411,6 +458,16 @@ SpAbstractTreePresenter >> selection [ ^ selectionMode value ] +{ #category : 'api' } +SpAbstractTreePresenter >> selectionMode [ + "Answer the selection object (an instance of `SpSingleSelectionMode` or `SpMultipleSelectionMode`). + This is not the item selected, but the selection container (it may contain one or many selected + items). + This is the same as `SpAbstractListPresenter>>#selection`" + + ^ selectionMode +] + { #category : 'private' } SpAbstractTreePresenter >> selectionMode: aMode [ @@ -464,7 +521,7 @@ SpAbstractTreePresenter >> verticalAlignment [ SpAbstractTreePresenter >> whenActivatedDo: aBlock [ "Inform when an element has been 'activated'. `aBlock` receives one argument (a selection object, see `SpAbstractSelectionMode`)" - + activationBlock := aBlock ] diff --git a/src/Spec2-Core/SpActionBarPresenter.class.st b/src/Spec2-Core/SpActionBarPresenter.class.st index bae49bfe3..521da1148 100644 --- a/src/Spec2-Core/SpActionBarPresenter.class.st +++ b/src/Spec2-Core/SpActionBarPresenter.class.st @@ -8,7 +8,8 @@ Class { #name : 'SpActionBarPresenter', #superclass : 'SpAbstractWidgetPresenter', #instVars : [ - 'items' + '#items', + '#centerPresenter => ObservableSlot' ], #category : 'Spec2-Core-Widgets', #package : 'Spec2-Core', @@ -31,6 +32,7 @@ SpActionBarPresenter class >> documentFactoryMethodSelector [ SpActionBarPresenter >> add: aButtonPresenter [ "Add a button presenter to be shown at the start of the action bar (at the left)." + aButtonPresenter owner: self. (items at: #start ifAbsentPut: [ OrderedCollection new ] ) @@ -41,12 +43,25 @@ SpActionBarPresenter >> add: aButtonPresenter [ SpActionBarPresenter >> addLast: aButtonPresenter [ "Add a button presenter to be shown at the end of the action bar (at the right)." + aButtonPresenter owner: self. (items at: #end ifAbsentPut: [ OrderedCollection new ] ) add: aButtonPresenter ] +{ #category : 'api' } +SpActionBarPresenter >> centerPresenter [ + + ^ centerPresenter +] + +{ #category : 'api' } +SpActionBarPresenter >> centerPresenter: aPresenter [ + + centerPresenter := aPresenter +] + { #category : 'initialization' } SpActionBarPresenter >> initialize [ @@ -81,3 +96,19 @@ SpActionBarPresenter >> traverseInFocusOrderDo: aBlock excluding: excludes [ self presentersInFocusOrder do: [ :each | each traverseInFocusOrderDo: aBlock excluding: excludes ] ] + +{ #category : 'private - traversing' } +SpActionBarPresenter >> traversePresentersDo: aBlock excluding: excludes [ + + super traversePresentersDo: aBlock excluding: excludes. + self presenters do: [ :each | + each traversePresentersDo: aBlock excluding: excludes ]. + self centerPresenter ifNotNil: [ :aPresenter | + aPresenter traversePresentersDo: aBlock excluding: excludes ] +] + +{ #category : 'api - events' } +SpActionBarPresenter >> whenCenterPresenterChangedDo: aBlock [ + + self property: #centerPresenter whenChangedDo: aBlock +] diff --git a/src/Spec2-Core/SpApplicationBackend.class.st b/src/Spec2-Core/SpApplicationBackend.class.st index 840ecab3a..25ea8b983 100644 --- a/src/Spec2-Core/SpApplicationBackend.class.st +++ b/src/Spec2-Core/SpApplicationBackend.class.st @@ -43,12 +43,24 @@ SpApplicationBackend >> adapterBindingsClass [ self subclassResponsibility ] +{ #category : 'accessing' } +SpApplicationBackend >> componentListClass [ + + ^ self subclassResponsibility +] + { #category : 'accessing' } SpApplicationBackend >> defaultConfigurationFor: anApplication [ ^ self subclassResponsibility ] +{ #category : 'accessing' } +SpApplicationBackend >> dropListClass [ + + self subclassResponsibility +] + { #category : 'ui - dialogs' } SpApplicationBackend >> inform: aString [ @@ -62,6 +74,13 @@ SpApplicationBackend >> initialize [ self resetAdapterBindings ] +{ #category : 'accessing' } +SpApplicationBackend >> listClass [ + + self subclassResponsibility + +] + { #category : 'accessing' } SpApplicationBackend >> name [ @@ -80,20 +99,39 @@ SpApplicationBackend >> notifyInfo: aSpecNotification [ self subclassResponsibility ] +{ #category : 'ui - dialogs' } +SpApplicationBackend >> openFileDialog: aFileDialog [ + + self subclassResponsibility +] + { #category : 'initialization' } SpApplicationBackend >> resetAdapterBindings [ adapterBindings := self adapterBindingsClass new ] -{ #category : 'ui - dialogs' } -SpApplicationBackend >> selectFileTitle: aString [ +{ #category : 'ui' } +SpApplicationBackend >> showWaitCursorWhile: aBlock inApplication: anApplication [ self subclassResponsibility ] -{ #category : 'ui' } -SpApplicationBackend >> showWaitCursorWhile: aBlock inApplication: anApplication [ +{ #category : 'accessing' } +SpApplicationBackend >> tableClass [ + + self subclassResponsibility +] + +{ #category : 'accessing' } +SpApplicationBackend >> treeClass [ + + self subclassResponsibility + +] + +{ #category : 'accessing' } +SpApplicationBackend >> treeTableClass [ self subclassResponsibility ] diff --git a/src/Spec2-Core/SpButtonPresenter.class.st b/src/Spec2-Core/SpButtonPresenter.class.st index 29e0ad86e..4af3168aa 100644 --- a/src/Spec2-Core/SpButtonPresenter.class.st +++ b/src/Spec2-Core/SpButtonPresenter.class.st @@ -131,8 +131,9 @@ SpButtonPresenter >> registerShortcut: newShortcut [ receiver := self window. (receiver isNil or: [ newShortcut isNil ]) ifTrue: [ ^ self ]. receiver presenter - bindKeyCombination: newShortcut - toAction: [ self performAction ] + addShortcutWith: [ :act | act + shortcutKey: newShortcut; + action: [ self performAction ] ] ] { #category : 'api' } diff --git a/src/Spec2-Core/SpCollectionListModel.class.st b/src/Spec2-Core/SpCollectionListModel.class.st index 318748bc1..9889f3183 100644 --- a/src/Spec2-Core/SpCollectionListModel.class.st +++ b/src/Spec2-Core/SpCollectionListModel.class.st @@ -11,8 +11,7 @@ Class { #instVars : [ '#announcer', '#collection', - '#sorting => ObservableSlot', - '#comparisonStrategy' + '#sorting => ObservableSlot' ], #category : 'Spec2-Core-Widgets-Table', #package : 'Spec2-Core', @@ -73,20 +72,6 @@ SpCollectionListModel >> collection: anObject [ newValue: collection) ] -{ #category : 'accessing' } -SpCollectionListModel >> comparisonStrategy [ - "Answer a that specifies how receiver's elements are compared" - - ^ comparisonStrategy -] - -{ #category : 'accessing' } -SpCollectionListModel >> comparisonStrategy: aBlockClosure [ - "Set the receiver's comparison strategy to a two argument's , that specifies how receiver's elements are compared" - - comparisonStrategy := aBlockClosure -] - { #category : 'testing' } SpCollectionListModel >> hasElementAt: index [ @@ -94,18 +79,15 @@ SpCollectionListModel >> hasElementAt: index [ ] { #category : 'accessing' } -SpCollectionListModel >> indexOf: anItem ifAbsent: aBlock [ - "Answer the index of the first occurrence of anElement within the receiver. If the receiver does not contain anElement, answer the result of evaluating the argument, exceptionBlock." - - ^ collection indexOf: anItem ifAbsent: aBlock using: self comparisonStrategy +SpCollectionListModel >> indexOf: anIndex ifAbsent: aBlock [ + + ^ collection indexOf: anIndex ifAbsent: aBlock ] { #category : 'initialization' } SpCollectionListModel >> initialize [ - self class initializeSlots: self. - super initialize. - comparisonStrategy := [ :a :b | a == b]. + super initialize ] { #category : 'testing' } diff --git a/src/Spec2-Core/SpComponentListPresenter.class.st b/src/Spec2-Core/SpComponentListPresenter.class.st index f7dbce815..05eaa6775 100644 --- a/src/Spec2-Core/SpComponentListPresenter.class.st +++ b/src/Spec2-Core/SpComponentListPresenter.class.st @@ -33,6 +33,7 @@ SpComponentListPresenter >> addPresenter: aPresenter [ SpComponentListPresenter >> doActivateAtIndex: index [ "Activate only if there is an item at that position" + activationBlock ifNil: [ ^ self ]. self presenters at: index ifAbsent: [ ^ self ]. activationBlock cull: ((SpSingleSelectionMode on: self) diff --git a/src/Spec2-Core/SpDialogWindowPresenter.class.st b/src/Spec2-Core/SpDialogWindowPresenter.class.st index ac05a9e69..9f0bcf2af 100644 --- a/src/Spec2-Core/SpDialogWindowPresenter.class.st +++ b/src/Spec2-Core/SpDialogWindowPresenter.class.st @@ -32,11 +32,12 @@ Class { #name : 'SpDialogWindowPresenter', #superclass : 'SpWindowPresenter', #instVars : [ - 'buttons', - 'okAction', - 'cancelAction', - 'cancelled', - 'defaultButton' + '#buttons', + '#okAction', + '#cancelAction', + '#cancelled', + '#defaultButton', + '#buttonDecorations => ObservableSlot' ], #category : 'Spec2-Core-Windows', #package : 'Spec2-Core', @@ -165,6 +166,12 @@ SpDialogWindowPresenter >> executeDefaultAction [ defaultButton action cull: self ] +{ #category : 'testing' } +SpDialogWindowPresenter >> hasButtonDecorations [ + + ^ buttonDecorations and: [ self buttons isNotEmpty ] +] + { #category : 'testing' } SpDialogWindowPresenter >> hasDefaultButton [ @@ -177,7 +184,9 @@ SpDialogWindowPresenter >> initialize [ super initialize. buttons := OrderedCollection new. cancelled := true. + self withButtons. self initializeDefaultActions + ] { #category : 'initialization' } @@ -273,3 +282,25 @@ SpDialogWindowPresenter >> triggerOkAction [ okAction ifNil: [ ^ nil ]. ^ okAction cull: self ] + +{ #category : 'api - events' } +SpDialogWindowPresenter >> whenButtonDecorationsChangedDo: aBlock [ + + self + property: #buttonDecorations + whenChangedDo: aBlock +] + +{ #category : 'api' } +SpDialogWindowPresenter >> withButtons [ + "Show buttons" + + buttonDecorations := true +] + +{ #category : 'api' } +SpDialogWindowPresenter >> withoutButtons [ + "Remove all previously added buttons" + + buttonDecorations := false +] diff --git a/src/Spec2-Core/SpDropListItem.class.st b/src/Spec2-Core/SpDropListItem.class.st index 9302ee5b0..8a4690f17 100644 --- a/src/Spec2-Core/SpDropListItem.class.st +++ b/src/Spec2-Core/SpDropListItem.class.st @@ -21,7 +21,7 @@ SpDropListItem class >> named: label do: aBlock [ ^ self new action: aBlock; model: label; - display: [ :e | e ]; + display: [ :aString | aString ]; yourself ] @@ -40,7 +40,7 @@ SpDropListItem >> = anObject [ self == anObject ifTrue: [ ^ true ]. self class = anObject class ifFalse: [ ^ false ]. - ^ self label = anObject label and: [ action = anObject action ] + ^ self model = anObject model ] { #category : 'protocol' } @@ -83,7 +83,7 @@ SpDropListItem >> initialize [ super initialize. action := [ ]. - displayBlock := [ :e | e asString ] + displayBlock := [ :anObject | anObject asString ] ] { #category : 'accessing' } diff --git a/src/Spec2-Core/SpDropListPresenter.class.st b/src/Spec2-Core/SpDropListPresenter.class.st index b21394d6d..8c9013d42 100644 --- a/src/Spec2-Core/SpDropListPresenter.class.st +++ b/src/Spec2-Core/SpDropListPresenter.class.st @@ -42,7 +42,8 @@ SpDropListPresenter >> addItemLabeled: aString do: aBlock [ "Add an item to the drop list, along with an action. `aString` is the label of the element. `aBlock` is the action asociated to this element. It receives zero arguments." - + + self deprecated: 'This accessor introduces a wrong way to handle models (since it exposes an internal mechanism to the user. To use correctly this component, you need to follow a different pattent, e.g. what you can find in the examples section in class side of this presenter. Note that you can use SpDropListItem elements as model if you want to replicate the mechanism.'. self addItemLabeled: aString do: aBlock icon: nil. ] @@ -54,12 +55,14 @@ SpDropListPresenter >> addItemLabeled: aString do: aBlock icon: anIcon [ `anIcon` is the icon (an instance of `Form`) to be shown." | item | + self deprecated: 'This accessor introduces a wrong way to handle models (since it exposes an internal mechanism to the user. To use correctly this component, you need to follow a different pattent, e.g. what you can find in the examples section in class side of this presenter. Note that you can use SpDropListItem elements as model if you want to replicate the mechanism.'. + item := SpDropListItem on: aString do: aBlock. item icon: anIcon. model isEmpty ifTrue: [ self setCollection: { item } ] - ifFalse: [self appendCollection: { item } ] + ifFalse: [ self appendCollection: { item } ] ] { #category : 'private' } @@ -231,7 +234,13 @@ SpDropListPresenter >> resetSelection [ self selection unselectAll ] -{ #category : 'api' } +{ #category : 'api - selection' } +SpDropListPresenter >> selectFirst [ + + self selectIndex: 1 +] + +{ #category : 'api - selection' } SpDropListPresenter >> selectIndex: anInteger [ "Select the element at position `anInteger` and executes the action associated with it." @@ -242,7 +251,7 @@ SpDropListPresenter >> selectIndex: anInteger [ self selection selectedItem value ] -{ #category : 'api' } +{ #category : 'api - selection' } SpDropListPresenter >> selectItem: anItem [ "Select the element `anItem` if it is in the list. It executes the action associated with the item if it is defined." @@ -258,7 +267,7 @@ SpDropListPresenter >> selectItem: anItem [ realItem value ] -{ #category : 'api' } +{ #category : 'api - selection' } SpDropListPresenter >> selectedIndex [ "Answer the index of selected item. You usually do not need to use this method but `SpDropListPresenter>>#selectedItem`." @@ -266,7 +275,7 @@ SpDropListPresenter >> selectedIndex [ ^ self getIndex ] -{ #category : 'api' } +{ #category : 'api - selection' } SpDropListPresenter >> selectedItem [ "Answer selected item" @@ -274,7 +283,7 @@ SpDropListPresenter >> selectedItem [ ifNotNil: [ :anItem | anItem model ] ] -{ #category : 'api' } +{ #category : 'api - selection' } SpDropListPresenter >> selection [ "Answer selection model, an instance of `SpSingleSelectionMode`." diff --git a/src/Spec2-Core/SpEditableListPresenter.class.st b/src/Spec2-Core/SpEditableListPresenter.class.st index d124c2a87..208287523 100644 --- a/src/Spec2-Core/SpEditableListPresenter.class.st +++ b/src/Spec2-Core/SpEditableListPresenter.class.st @@ -49,10 +49,10 @@ SpEditableListPresenter class >> layoutWithOrdering: useOrdering [ ifTrue: [ listLayout add: (SpBoxLayout newTopToBottom - 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; + add: #topButton expand: false; + add: #upButton expand: false; + add: #downButton expand: false; + add: #bottomButton expand: false; yourself) expand: false ]. @@ -147,6 +147,7 @@ SpEditableListPresenter >> initializeDialogWindow: aWindow [ { #category : 'initialization' } SpEditableListPresenter >> initializePresenters [ + label := self newLabel. list := self newList. addButton := self newButton. @@ -157,26 +158,32 @@ SpEditableListPresenter >> initializePresenters [ bottomButton := self newButton. addButton addStyle: 'small'; + addStyle: 'flat'; icon: (self iconNamed: #add); help: 'Add a new item to the list'. removeButton addStyle: 'small'; + addStyle: 'flat'; icon: (self iconNamed: #remove); help: 'Remove a item from the list'. upButton addStyle: 'small'; + addStyle: 'flat'; icon: (self iconNamed: #up); help: 'Move this item up from one element'. downButton addStyle: 'small'; + addStyle: 'flat'; icon: (self iconNamed: #down); help: 'Move this item down from one element'. topButton addStyle: 'small'; + addStyle: 'flat'; icon: (self iconNamed: #top); help: 'Move this item on the first position of the list'. bottomButton addStyle: 'small'; + addStyle: 'flat'; icon: (self iconNamed: #bottom); help: 'Move this item on the last position of the list' ] @@ -227,9 +234,9 @@ SpEditableListPresenter >> moveElementAt: index to: newIndex [ SpEditableListPresenter >> newList [ "Default list collection is an Array. As this presenter aims to add / remove items from the list, we need a growable collection" - ^ (self instantiate: SpListPresenter) - items: OrderedCollection new; - yourself + ^ super newList + items: OrderedCollection new; + yourself ] { #category : 'api' } @@ -312,6 +319,6 @@ SpEditableListPresenter >> upButton [ ] { #category : 'api' } -SpEditableListPresenter >> whenSelectionChangedDo: aBlockClosure [ - list whenSelectionChangedDo: aBlockClosure +SpEditableListPresenter >> whenSelectionChangedDo: aBlock [ + list whenSelectionChangedDo: aBlock ] diff --git a/src/Spec2-Core/SpJob.class.st b/src/Spec2-Core/SpJob.class.st index 167fd45a1..13d9e6a19 100644 --- a/src/Spec2-Core/SpJob.class.st +++ b/src/Spec2-Core/SpJob.class.st @@ -344,7 +344,7 @@ SpJob >> value: aNumber [ { #category : 'events' } SpJob >> whenChangedDo: aBlock [ - self announcer when: JobChange do: aBlock + self announcer when: JobChange do: aBlock for: aBlock receiver ] { #category : 'events' } diff --git a/src/Spec2-Core/SpJobListPresenter.class.st b/src/Spec2-Core/SpJobListPresenter.class.st index 079f9d3b0..1cbfebdf4 100644 --- a/src/Spec2-Core/SpJobListPresenter.class.st +++ b/src/Spec2-Core/SpJobListPresenter.class.st @@ -120,7 +120,7 @@ SpJobListPresenter >> jobEnd: ann [ self removeJobPresenter: ann job ] ] -{ #category : 'private' } +{ #category : 'initialization' } SpJobListPresenter >> jobPresenterHeight [ ^ 80 diff --git a/src/Spec2-Core/SpLinkPresenter.class.st b/src/Spec2-Core/SpLinkPresenter.class.st index 069914396..aa3b7a5e5 100644 --- a/src/Spec2-Core/SpLinkPresenter.class.st +++ b/src/Spec2-Core/SpLinkPresenter.class.st @@ -7,6 +7,8 @@ If there is no `label` set, the `url` will be taken as label aswell. Class { #name : 'SpLinkPresenter', #superclass : 'SpAbstractWidgetPresenter', + #traits : 'SpTDecoratedText + SpTContextMenu', + #classTraits : 'SpTDecoratedText classTrait + SpTContextMenu classTrait', #instVars : [ '#label => ObservableSlot', '#action => ObservableSlot' diff --git a/src/Spec2-Core/SpListPresenter.class.st b/src/Spec2-Core/SpListPresenter.class.st index ca2245da4..50f5cfa98 100644 --- a/src/Spec2-Core/SpListPresenter.class.st +++ b/src/Spec2-Core/SpListPresenter.class.st @@ -181,14 +181,14 @@ SpListPresenter >> resetListSelection [ self selectIndex: 0 ] -{ #category : 'scrolling' } +{ #category : 'api' } SpListPresenter >> scrollIndex [ "Answer a representing the receiver's element scroll index" ^ self adapter widget showIndex. ] -{ #category : 'scrolling' } +{ #category : 'api' } SpListPresenter >> scrollToIndex: anIndex [ "Scroll the receiver to the element whose index is anIndex." diff --git a/src/Spec2-Core/SpMenuGroupPresenter.class.st b/src/Spec2-Core/SpMenuGroupPresenter.class.st index 3062236ed..79169ba1c 100644 --- a/src/Spec2-Core/SpMenuGroupPresenter.class.st +++ b/src/Spec2-Core/SpMenuGroupPresenter.class.st @@ -37,6 +37,13 @@ SpMenuGroupPresenter >> add: aName target: targetObject selector: aSelector [ ^ self menuItems last ] +{ #category : 'private' } +SpMenuGroupPresenter >> addGroup: aBlock [ + + "in case we are adding a group to a group" + aBlock value: self +] + { #category : 'api' } SpMenuGroupPresenter >> addItem: aBlock [ | item | diff --git a/src/Spec2-Core/SpMenuPresenter.class.st b/src/Spec2-Core/SpMenuPresenter.class.st index 956cca29a..9a3f63c1e 100644 --- a/src/Spec2-Core/SpMenuPresenter.class.st +++ b/src/Spec2-Core/SpMenuPresenter.class.st @@ -85,7 +85,7 @@ SpMenuPresenter >> addItem: aBlock [ ] { #category : 'api' } -SpMenuPresenter >> addKeybindingsTo: aPresenter [ +SpMenuPresenter >> addKeyBindingsTo: aPresenter [ "bind keybindings (shortcuts) defined in this menu to aPresenter" aPresenter applyKeyBindingsFromMenu: self @@ -129,6 +129,16 @@ SpMenuPresenter >> defaultGroup [ defaultGroup ] ] +{ #category : 'api' } +SpMenuPresenter >> fillWith: anActionGroup [ + "fills this menu with the actions comming from the action group" + + groups removeAll. + SpActionMenuPresenterBuilder new + menuPresenter: self; + visit: anActionGroup +] + { #category : 'api - building' } SpMenuPresenter >> fromSpec: aSpec [ | grps subgroup | diff --git a/src/Spec2-Core/SpPopoverPresenter.class.st b/src/Spec2-Core/SpPopoverPresenter.class.st index 9ab7b446b..ebe19b405 100644 --- a/src/Spec2-Core/SpPopoverPresenter.class.st +++ b/src/Spec2-Core/SpPopoverPresenter.class.st @@ -148,6 +148,15 @@ SpPopoverPresenter >> relativeTo: aPresenter [ relativeTo := aPresenter ] +{ #category : 'private - traversing' } +SpPopoverPresenter >> traversePresentersDo: aBlock excluding: excludes [ + + super traversePresentersDo: aBlock excluding: excludes. + self presenter + traversePresentersDo: aBlock + excluding: excludes +] + { #category : 'api - events' } SpPopoverPresenter >> whenPresenterChangedDo: aBlock [ "Inform when content presenter has changed. diff --git a/src/Spec2-Core/SpPresenter.class.st b/src/Spec2-Core/SpPresenter.class.st index d62b884de..1579a9866 100644 --- a/src/Spec2-Core/SpPresenter.class.st +++ b/src/Spec2-Core/SpPresenter.class.st @@ -322,10 +322,10 @@ SpPresenter >> applyKeyBindingsFromMenu: aMenuPresenter [ aMenuPresenter menuGroups do: [ :group | group menuItems do: [ :item | item shortcut ifNotNil: [ :shortcut | - self - bindKeyCombination: shortcut - toAction: [ item performMenuActionWith: #() ] ]. - item subMenu ifNotNil: [ :subMenu | subMenu addKeybindingsTo: self ] ] ] + self addShortcutWith: [ :action | action + shortcutKey: shortcut; + action: [ item performMenuActionWith: #() ] ] ]. + item subMenu ifNotNil: [ :subMenu | subMenu addKeyBindingsTo: self ] ] ] ] { #category : 'converting' } @@ -369,6 +369,11 @@ SpPresenter >> bindKeyCombination: aShortcut toAction: aBlock [ - `aShortcut` is an instance of `KMKeyCombination` - `aBlock` receive zero arguments." + "self + deprecated: 'Keybindings usege is deprecated in favor of addShortcut: system' + on: '2024/09/11' + in: #Pharo13." + contextKeyBindings ifNil: [ contextKeyBindings := KMCategory new ]. contextKeyBindings addKeymapEntry: (KMKeymap shortcut: aShortcut @@ -424,6 +429,11 @@ SpPresenter >> contextKeyBindings [ SpPresenter >> contextKeyBindings: aKMCategory [ "Set the context keybindings for this presenter." + "self + deprecated: 'contextKeyBindings have been deprecated in favor of actions.' + on: '2024/09/15' + in: #Pharo13." + contextKeyBindings := contextKeyBindings ifNotNil: [ contextKeyBindings, aKMCategory ] ifNil: [ aKMCategory ] @@ -826,6 +836,11 @@ SpPresenter >> rebuildLayout [ SpPresenter >> removeKeyCombination: aShortcut [ "Remove the action associated to `aShortcut`" + "self + deprecated: 'Keybindings usege is deprecated in favor of addShortcut: system' + on: '2024/09/11' + in: #Pharo13." + self contextKeyBindings removeKey: aShortcut ifAbsent: [ ^ self ]. self withAdapterDo: [ :anAdapter | anAdapter removeKeyCombination: aShortcut ] @@ -887,6 +902,14 @@ SpPresenter >> show [ visible := true ] +{ #category : 'private' } +SpPresenter >> showContextMenu [ + "If the presenter is displayed, shows the associated context menu. + WARNING: Not all presenters have an associated context menu" + + self withAdapterDo: [ :anAdapter | anAdapter showContextMenu ] +] + { #category : 'api' } SpPresenter >> styles [ "Answer the collection of styles to be applied to this presenter" diff --git a/src/Spec2-Core/SpPresenterBuilder.class.st b/src/Spec2-Core/SpPresenterBuilder.class.st index 69fef3d12..cabd95861 100644 --- a/src/Spec2-Core/SpPresenterBuilder.class.st +++ b/src/Spec2-Core/SpPresenterBuilder.class.st @@ -14,11 +14,34 @@ Class { #superclass : 'Object', #traits : 'SpTPresenterBuilder', #classTraits : 'SpTPresenterBuilder classTrait', + #instVars : [ + 'application' + ], #category : 'Spec2-Core-Base', #package : 'Spec2-Core', #tag : 'Base' } +{ #category : 'instance creation' } +SpPresenterBuilder class >> newApplication: anApplication [ + + ^ self new + application: anApplication; + yourself +] + +{ #category : 'accessing' } +SpPresenterBuilder >> application [ + + ^ application +] + +{ #category : 'accessing' } +SpPresenterBuilder >> application: anApplication [ + + application := anApplication +] + { #category : 'instance creation' } SpPresenterBuilder >> instantiate: aPresenterClass [ "Instantiate a SpPresenter subclass and set its instance owner" diff --git a/src/Spec2-Core/SpSwitchPresenter.class.st b/src/Spec2-Core/SpSwitchPresenter.class.st new file mode 100644 index 000000000..eedc998db --- /dev/null +++ b/src/Spec2-Core/SpSwitchPresenter.class.st @@ -0,0 +1,35 @@ +" +A Checkbox Button that can be activated/deactivated. + +" +Class { + #name : 'SpSwitchPresenter', + #superclass : 'SpAbstractFormButtonPresenter', + #category : 'Spec2-Core-Widgets', + #package : 'Spec2-Core', + #tag : 'Widgets' +} + +{ #category : 'specs' } +SpSwitchPresenter class >> adapterName [ + + ^ #SwitchAdapter +] + +{ #category : 'documentation' } +SpSwitchPresenter class >> documentFactoryMethodSelector [ + + ^ #newSwitch +] + +{ #category : 'specs' } +SpSwitchPresenter class >> title [ + + ^ 'Switch Button' +] + +{ #category : 'api' } +SpSwitchPresenter >> label: aString [ + + self error: 'Switches can''t have labels' +] diff --git a/src/Spec2-Core/SpTActionContainer.trait.st b/src/Spec2-Core/SpTActionContainer.trait.st index e5acc0ec9..36e8f8564 100644 --- a/src/Spec2-Core/SpTActionContainer.trait.st +++ b/src/Spec2-Core/SpTActionContainer.trait.st @@ -1,7 +1,12 @@ +" +A trait to contain the actions associated to a presenter. +Actions can be **visible** (hence, they will be shown in a context menu) or **not visible** (hence, they will be shortcuts). +" Trait { #name : 'SpTActionContainer', #instVars : [ - 'actionGroup' + '#userActionGroup => ObservableSlot', + '#internalActionGroup' ], #category : 'Spec2-Core-Base', #package : 'Spec2-Core', @@ -9,44 +14,71 @@ Trait { } { #category : 'api - actions' } -SpTActionContainer >> actionGroup [ +SpTActionContainer >> actions [ - ^ actionGroup + ^ userActionGroup ] { #category : 'api - actions' } -SpTActionContainer >> actionGroup: aSpCommandGroup [ +SpTActionContainer >> actions: anActionGroup [ "WARNING. Defining action in presenters that are not able to grab the keyboard focus is mostly useless (because they will never have the focus to answer to). Shortcut actions, however, can be installed and they will be available in children presenters when they are focused." - aSpCommandGroup beRoot. - actionGroup := aSpCommandGroup - + userActionGroup := anActionGroup + name: #userActionGroup; + beRoot ] { #category : 'api - actions' } SpTActionContainer >> actionsWith: aBlock [ + | actionGroup | + + actionGroup := SpActionGroup new beRoot. + aBlock value: actionGroup. + self actions: actionGroup +] + +{ #category : 'api - actions' } +SpTActionContainer >> addAction: aSpCommand [ "WARNING. Defining action in presenters that are not able to grab the keyboard focus is mostly useless (because they will never have the focus to answer to). Shortcut actions, however, can be installed and they will be available in children presenters when they are focused." - actionGroup := nil. - aBlock value: self ensureActionGroup + self ensureActions add: aSpCommand ] { #category : 'api - actions' } -SpTActionContainer >> addAction: aSpCommand [ +SpTActionContainer >> addActionGroup: aCommandGroup [ + "WARNING. Defining action in presenters that are not able to grab the keyboard focus + is mostly useless (because they will never have the focus to answer to). + Shortcut actions, however, can be installed and they will be available in children + presenters when they are focused." + + aCommandGroup beDisplayedAsGroup. + self addAction: aCommandGroup +] + +{ #category : 'api - actions' } +SpTActionContainer >> addActionGroupWith: aBlock [ + "WARNING. Defining action in presenters that are not able to grab the keyboard focus + is mostly useless (because they will never have the focus to answer to). + Shortcut actions, however, can be installed and they will be available in children + presenters when they are focused." + | commandGroup | - self ensureActionGroup add: aSpCommand + commandGroup := SpActionGroup new. + commandGroup beDisplayedAsGroup. + aBlock value: commandGroup. + self actions: commandGroup ] { #category : 'api - actions' } SpTActionContainer >> addActionWith: aBlock [ - self ensureActionGroup addActionWith: aBlock + self ensureActions addActionWith: aBlock ] { #category : 'api - actions' } @@ -56,18 +88,25 @@ SpTActionContainer >> addShortcutWith: aBlock [ Shortcut actions, however, can be installed and they will be available in children presenters when they are focused." - self ensureActionGroup addShortcutWith: aBlock + self ensureActions addShortcutWith: aBlock +] + +{ #category : 'private - actions' } +SpTActionContainer >> ensureActions [ + + ^ userActionGroup ifNil: [ + userActionGroup := SpActionGroup new + name: #userActionGroup; + beRoot ] ] -{ #category : 'private' } -SpTActionContainer >> ensureActionGroup [ +{ #category : 'private - actions' } +SpTActionContainer >> ensureInternalActions [ - self flag: #TODO. "This is a fake break of dependency (dependency is - still there, but hidden). Think about a real fix (like, not using commander for actions." - ^ actionGroup ifNil: [ - | c | - c := self class environment at: #SpActionGroup. - actionGroup := c new beRoot ] + ^ internalActionGroup ifNil: [ + internalActionGroup := SpActionGroup new + name: #internalActionGroup; + beRoot ] ] { #category : 'initialization' } @@ -77,10 +116,27 @@ SpTActionContainer >> initialize [ super initialize. ] -{ #category : 'api - events' } -SpTActionContainer >> whenCommandGroupChangedDo: aBlock [ +{ #category : 'private - actions' } +SpTActionContainer >> internalActions [ + "Internal actions are actions defined internally by a presenter (e.g. meta+t to show + the context menu, or meta+s to trigger the submit action in text fields). + Since this is NOT meant to be shown to the user (for now, at least), all actions + registered here will be considered NOT VISIBLE, and will not popup in menus." + + ^ internalActionGroup +] + +{ #category : 'private - actions' } +SpTActionContainer >> internalActions: anActionGroup [ + "to be used internally by the presenters" + + internalActionGroup := anActionGroup beRoot +] + +{ #category : 'enumerating' } +SpTActionContainer >> whenActionsChangedDo: aBlock [ "Inform when menu definition changed. `aBlock` receives zero arguments." - self property: #actionGroup whenChangedDo: aBlock + self property: #userActionGroup whenChangedDo: aBlock ] diff --git a/src/Spec2-Core/SpTContextMenu.trait.st b/src/Spec2-Core/SpTContextMenu.trait.st index cc182afd8..3acbf0645 100644 --- a/src/Spec2-Core/SpTContextMenu.trait.st +++ b/src/Spec2-Core/SpTContextMenu.trait.st @@ -32,6 +32,11 @@ SpTContextMenu >> contextMenu: aValuableOrMenuPresenter [ If your context menu is defined through a block it means is dynamic, and it will be evaluated each time the context menu is invoked." + "self + deprecated: 'contextMenu has been deprecated in favor of actions.' + on: '2024/09/15' + in: #Pharo13." + contextMenu := aValuableOrMenuPresenter ] diff --git a/src/Spec2-Core/SpTPresenterBuilder.trait.st b/src/Spec2-Core/SpTPresenterBuilder.trait.st index ef41427db..bbfdba9f9 100644 --- a/src/Spec2-Core/SpTPresenterBuilder.trait.st +++ b/src/Spec2-Core/SpTPresenterBuilder.trait.st @@ -67,12 +67,14 @@ SpTPresenterBuilder >> newButtonBar [ { #category : 'scripting - widgets' } SpTPresenterBuilder >> newCheckBox [ + ^ self instantiate: SpCheckBoxPresenter ] { #category : 'scripting - widgets' } SpTPresenterBuilder >> newComponentList [ - ^ self instantiate: SpComponentListPresenter + + ^ self instantiate: self application backend componentListClass ] { #category : 'scripting - widgets' } @@ -82,7 +84,8 @@ SpTPresenterBuilder >> newDiff [ { #category : 'scripting - widgets' } SpTPresenterBuilder >> newDropList [ - ^ self instantiate: SpDropListPresenter + + ^ self instantiate: self application backend dropListClass ] { #category : 'scripting - widgets' } @@ -124,7 +127,8 @@ SpTPresenterBuilder >> newLink [ { #category : 'scripting - widgets' } SpTPresenterBuilder >> newList [ - ^ self instantiate: SpListPresenter + + ^ self instantiate: self application backend listClass ] { #category : 'scripting - widgets' } @@ -251,10 +255,16 @@ SpTPresenterBuilder >> newStatusBar [ ^ self instantiate: SpStatusBarPresenter ] +{ #category : 'scripting - widgets' } +SpTPresenterBuilder >> newSwitch [ + + ^ self instantiate: SpSwitchPresenter +] + { #category : 'scripting - widgets' } SpTPresenterBuilder >> newTable [ - ^ self instantiate: SpTablePresenter + ^ self instantiate: self application backend tableClass ] { #category : 'scripting - widgets' } @@ -306,11 +316,11 @@ SpTPresenterBuilder >> newToolbarToggleButton [ { #category : 'scripting - widgets' } SpTPresenterBuilder >> newTree [ - ^ self instantiate: SpTreePresenter + ^ self instantiate: self application backend treeClass ] { #category : 'scripting - widgets' } SpTPresenterBuilder >> newTreeTable [ - ^ self instantiate: SpTreeTablePresenter + ^ self instantiate: self application backend treeTableClass ] diff --git a/src/Spec2-Core/SpTableColumn.class.st b/src/Spec2-Core/SpTableColumn.class.st index 039e1d4b6..87e49ae36 100644 --- a/src/Spec2-Core/SpTableColumn.class.st +++ b/src/Spec2-Core/SpTableColumn.class.st @@ -111,6 +111,12 @@ SpTableColumn >> evaluation [ ^ evaluation ] +{ #category : 'testing' } +SpTableColumn >> hasFixedWidth [ + + ^ (self width isNil or: [ self width = 0 ]) not +] + { #category : 'initialization' } SpTableColumn >> initialize [ diff --git a/src/Spec2-Core/SpTablePresenter.class.st b/src/Spec2-Core/SpTablePresenter.class.st index d99f684c1..75a04a8a6 100644 --- a/src/Spec2-Core/SpTablePresenter.class.st +++ b/src/Spec2-Core/SpTablePresenter.class.st @@ -99,13 +99,6 @@ SpTablePresenter >> columns: aCollection [ columns := aCollection ] -{ #category : 'accessing' } -SpTablePresenter >> comparisonStrategy: aFullBlockClosure [ - "See comment in SpAbstractSelectionMode >> #comparisonStrategy:" - - self model comparisonStrategy: aFullBlockClosure -] - { #category : 'api' } SpTablePresenter >> hideColumnHeaders [ "Hide the column headers" diff --git a/src/Spec2-Core/SpTextInputFieldPresenter.class.st b/src/Spec2-Core/SpTextInputFieldPresenter.class.st index e75b96448..4d5cf0db4 100644 --- a/src/Spec2-Core/SpTextInputFieldPresenter.class.st +++ b/src/Spec2-Core/SpTextInputFieldPresenter.class.st @@ -61,8 +61,7 @@ SpTextInputFieldPresenter >> initialize [ maxLength := 0. isPassword := false. - self beEditable. - + self beEditable ] { #category : 'testing' } @@ -168,7 +167,8 @@ SpTextInputFieldPresenter >> whenSubmitDo: aBlock [ presses key (this is for historical reasons), and with enter (cr). `aBlock` receives one argument (the submited text)" - self - bindKeyCombination: SpAcceptChangesCommand defaultShortcutKey | Character cr asKeyCombination - toAction: [ aBlock value: self text ] + self ensureInternalActions + addShortcutWith: [ :action | action + shortcutKey: SpAcceptChangesCommand defaultShortcutKey | Character cr asKeyCombination; + action: [ aBlock value: self text ] ] ] diff --git a/src/Spec2-Core/SpTextPresenter.class.st b/src/Spec2-Core/SpTextPresenter.class.st index dcbd925c3..28a0c330c 100644 --- a/src/Spec2-Core/SpTextPresenter.class.st +++ b/src/Spec2-Core/SpTextPresenter.class.st @@ -270,9 +270,10 @@ SpTextPresenter >> whenSubmitDo: aBlock [ presses key (this is for historical reasons) and with enter (cr). `aBlock` receives one argument (the submited text)" - self - bindKeyCombination: SpAcceptChangesCommand defaultShortcutKey - toAction: [ aBlock value: self text ] + self ensureInternalActions + addShortcutWith: [ :action | action + shortcutKey: SpAcceptChangesCommand defaultShortcutKey; + action: [ aBlock value: self text ] ] ] { #category : 'api - events' } diff --git a/src/Spec2-Core/SpToolbarPresenter.class.st b/src/Spec2-Core/SpToolbarPresenter.class.st index 4133566af..57a77823a 100644 --- a/src/Spec2-Core/SpToolbarPresenter.class.st +++ b/src/Spec2-Core/SpToolbarPresenter.class.st @@ -198,6 +198,14 @@ SpToolbarPresenter >> traverseInFocusOrderDo: aBlock excluding: excludes [ each traverseInFocusOrderDo: aBlock excluding: excludes ] ] +{ #category : 'private - traversing' } +SpToolbarPresenter >> traversePresentersDo: aBlock excluding: excludes [ + + super traversePresentersDo: aBlock excluding: excludes. + self presenters do: [ :each | + each traversePresentersDo: aBlock excluding: excludes ] +] + { #category : 'events' } SpToolbarPresenter >> whenItemsChangeDo: aBlockClosure [ diff --git a/src/Spec2-Core/SpTreePresenter.class.st b/src/Spec2-Core/SpTreePresenter.class.st index cd03a6e94..b3ed5ad8a 100644 --- a/src/Spec2-Core/SpTreePresenter.class.st +++ b/src/Spec2-Core/SpTreePresenter.class.st @@ -126,8 +126,7 @@ SpTreePresenter >> initialize [ verticalAlignment := SpVerticalAlignment new. self beSingleSelection. - self activateOnDoubleClick. - self registerEvents + self activateOnDoubleClick ] { #category : 'testing' } diff --git a/src/Spec2-Core/SpTreeSingleSelectionMode.class.st b/src/Spec2-Core/SpTreeSingleSelectionMode.class.st index 2ce3cfafd..215e5d735 100644 --- a/src/Spec2-Core/SpTreeSingleSelectionMode.class.st +++ b/src/Spec2-Core/SpTreeSingleSelectionMode.class.st @@ -20,7 +20,7 @@ SpTreeSingleSelectionMode >> selectPath: aPath [ presenter itemAtPath: aPath ifAbsent: [ ^ self ]. - selection := aPath. + selection := aPath ] diff --git a/src/Spec2-Core/SpTreeTablePresenter.class.st b/src/Spec2-Core/SpTreeTablePresenter.class.st index 1e3e9b8db..df730cc8d 100644 --- a/src/Spec2-Core/SpTreeTablePresenter.class.st +++ b/src/Spec2-Core/SpTreeTablePresenter.class.st @@ -65,7 +65,7 @@ SpTreeTablePresenter >> addColumn: aColumn [ columns := self columns copyWith: aColumn ] -{ #category : 'drawing' } +{ #category : 'api' } SpTreeTablePresenter >> alternateRowsColor [ " Will alternate Rows color for a better reading: one row lighter, the next row darker" self withAdapterPerformOrDefer: [ :tableAdapter | tableAdapter alternateRowsColor ]. @@ -124,10 +124,8 @@ SpTreeTablePresenter >> initialize [ lazilyComputeChildren := false. verticalAlignment := SpVerticalAlignment new. - self beSingleSelection. - self activateOnDoubleClick. - self registerEvents + self activateOnDoubleClick ] { #category : 'testing' } @@ -161,16 +159,6 @@ SpTreeTablePresenter >> lazilyComputeChildren: aBoolean [ lazilyComputeChildren := aBoolean ] -{ #category : 'api' } -SpTreeTablePresenter >> selectionMode [ - "Answer the selection object (an instance of `SpSingleSelectionMode` or `SpMultipleSelectionMode`). - This is not the item selected, but the selection container (it may contain one or many selected - items). - This is the same as `SpAbstractListPresenter>>#selection`" - - ^ selectionMode -] - { #category : 'private' } SpTreeTablePresenter >> shouldLazilyComputeChildren [ ^ lazilyComputeChildren diff --git a/src/Spec2-Core/SpWindowPresenter.class.st b/src/Spec2-Core/SpWindowPresenter.class.st index 97c56e401..f09b6bef8 100644 --- a/src/Spec2-Core/SpWindowPresenter.class.st +++ b/src/Spec2-Core/SpWindowPresenter.class.st @@ -448,6 +448,12 @@ SpWindowPresenter >> moveTo: aPoint [ ] +{ #category : 'private' } +SpWindowPresenter >> nearWindow [ + + ^ self +] + { #category : 'notifying' } SpWindowPresenter >> notify: aSpecNotification [ "Receives a notification and delivers it as required" @@ -536,10 +542,13 @@ SpWindowPresenter >> resize: anExtent [ ] { #category : 'api' } -SpWindowPresenter >> restore [ - "Restore the window" +SpWindowPresenter >> size [ + "Answer current window size. + This message will return 0@0 is window is not opened." - self withAdapterDo: [ :anAdapter | anAdapter restore ] + self withAdapterDo: [ :anAdapter | ^ anAdapter size ]. + + ^ 0@0 ] { #category : 'api' } diff --git a/src/Spec2-Dialogs/SpAbstractMessageDialog.class.st b/src/Spec2-Dialogs/SpAbstractMessageDialog.class.st index 84e430146..a304e415f 100644 --- a/src/Spec2-Dialogs/SpAbstractMessageDialog.class.st +++ b/src/Spec2-Dialogs/SpAbstractMessageDialog.class.st @@ -55,7 +55,7 @@ SpAbstractMessageDialog >> calculateLabelHeightForTextWithoutMargin: aText forEx "We have a minimal height " aText ifEmpty: [ ^ self singleLineDefaultHeight ]. - ^ (aText lineHeightsWrappingAtWidth: anExtent x - 20) sum + ^ (aText asText lineHeightsWrappingAtWidth: anExtent x - 20) sum ] @@ -103,9 +103,7 @@ SpAbstractMessageDialog >> initialize [ SpAbstractMessageDialog >> initializeDialogWindow: aDialogWindowPresenter [ super initializeDialogWindow: aDialogWindowPresenter. - - aDialogWindowPresenter initialExtent: - (self adjustExtentToLabelHeight: self class defaultExtent). + self initializeWindowExtent: aDialogWindowPresenter. self addButtonsTo: aDialogWindowPresenter ] @@ -114,6 +112,7 @@ SpAbstractMessageDialog >> initializePresenters [ image := self newImage image: self defaultIcon. label := self newDialogLabel. + label hide ] { #category : 'initialization' } @@ -124,15 +123,18 @@ SpAbstractMessageDialog >> initializeWindow: aWindowPresenter [ initialExtent: self extent ] -{ #category : 'api' } -SpAbstractMessageDialog >> label [ - ^ label text +{ #category : 'initialization' } +SpAbstractMessageDialog >> initializeWindowExtent: aDialogWindowPresenter [ + + aDialogWindowPresenter initialExtent: + (self adjustExtentToLabelHeight: self class defaultExtent) ] { #category : 'api' } SpAbstractMessageDialog >> label: aString [ - label text: aString asText trim + label text: aString asText trim. + aString ifNotNil: [ label show ] ] { #category : 'private' } diff --git a/src/Spec2-Dialogs/SpApplication.extension.st b/src/Spec2-Dialogs/SpApplication.extension.st index b179a566e..28b9c25e2 100644 --- a/src/Spec2-Dialogs/SpApplication.extension.st +++ b/src/Spec2-Dialogs/SpApplication.extension.st @@ -80,6 +80,12 @@ SpApplication >> newJobList [ ^ SpJobListPresenter newApplication: self ] +{ #category : '*Spec2-Dialogs' } +SpApplication >> newOpenFile [ + + ^ SpFileDialog newApplication: self +] + { #category : '*Spec2-Dialogs' } SpApplication >> newRequest [ @@ -119,11 +125,16 @@ SpApplication >> notify: aString [ { #category : '*Spec2-Dialogs' } SpApplication >> selectDirectoryTitle: aString [ - ^ self backend selectDirectoryTitle: aString + ^ self newOpenFile + title: aString; + beOpenDirectory; + openModal ] { #category : '*Spec2-Dialogs' } SpApplication >> selectFileTitle: aString [ - ^ self backend selectFileTitle: aString + ^ self newOpenFile + title: aString; + openModal ] diff --git a/src/Spec2-Dialogs/SpFileDialog.class.st b/src/Spec2-Dialogs/SpFileDialog.class.st new file mode 100644 index 000000000..f23f5affa --- /dev/null +++ b/src/Spec2-Dialogs/SpFileDialog.class.st @@ -0,0 +1,152 @@ +" +Wrapper to show the select or save file/folder dialogs. +Unlike regular presenters, this object will delegate directly to the system file dialog (when available). + +As main vocabulary, it understands `openModal`, to provide a polymorphic entry point. +" +Class { + #name : 'SpFileDialog', + #superclass : 'Object', + #instVars : [ + 'title', + 'filters', + 'path', + 'application', + 'parentWindow', + 'action' + ], + #category : 'Spec2-Dialogs', + #package : 'Spec2-Dialogs' +} + +{ #category : 'instance creation' } +SpFileDialog class >> newApplication: anApplication [ + + ^ self new + application: anApplication; + yourself +] + +{ #category : 'api' } +SpFileDialog >> addFilter: aString [ + + filters := self filters copyWith: aString +] + +{ #category : 'accessing' } +SpFileDialog >> application [ + + ^ application +] + +{ #category : 'accessing' } +SpFileDialog >> application: anApplication [ + + application := anApplication +] + +{ #category : 'api' } +SpFileDialog >> beOpenDirectory [ + + action := #openDirectory +] + +{ #category : 'api' } +SpFileDialog >> beOpenFile [ + + action := #openFile +] + +{ #category : 'api' } +SpFileDialog >> beSaveFile [ + + action := #saveFile +] + +{ #category : 'api' } +SpFileDialog >> doInteraction [ + + ^ self openModal +] + +{ #category : 'api' } +SpFileDialog >> filters [ + + ^ filters ifNil: [ #() ] +] + +{ #category : 'api' } +SpFileDialog >> filters: aCollectionOfStrings [ + "Receives a collection of file extentions. + e.g. #('jpg' 'png')" + + filters := aCollectionOfStrings +] + +{ #category : 'initialization' } +SpFileDialog >> initialize [ + + super initialize. + self beOpenFile +] + +{ #category : 'testing' } +SpFileDialog >> isOpenDirectory [ + + ^ action = #openDirectory +] + +{ #category : 'testing' } +SpFileDialog >> isOpenFile [ + + ^ action = #openFile +] + +{ #category : 'testing' } +SpFileDialog >> isSaveFile [ + + ^ action = #saveFile +] + +{ #category : 'api - showing' } +SpFileDialog >> openModal [ + + ^ self application backend openFileDialog: self +] + +{ #category : 'accessing' } +SpFileDialog >> parentWindow [ + + ^ parentWindow +] + +{ #category : 'accessing' } +SpFileDialog >> parentWindow: anObject [ + + parentWindow := anObject +] + +{ #category : 'api' } +SpFileDialog >> path [ + + ^ path +] + +{ #category : 'api' } +SpFileDialog >> path: aStringOrFileReference [ + "initial value of the dialog" + + path := aStringOrFileReference asFileReference +] + +{ #category : 'api' } +SpFileDialog >> title [ + + ^ title +] + +{ #category : 'api' } +SpFileDialog >> title: aTitle [ + + title := aTitle +] diff --git a/src/Spec2-Dialogs/SpNotificationCenterPresenter.class.st b/src/Spec2-Dialogs/SpNotificationCenterPresenter.class.st index e28285560..4ca5eb5c5 100644 --- a/src/Spec2-Dialogs/SpNotificationCenterPresenter.class.st +++ b/src/Spec2-Dialogs/SpNotificationCenterPresenter.class.st @@ -83,9 +83,3 @@ SpNotificationCenterPresenter >> modelChanged [ itemList items: announcingObject value items. itemList selectFirst ] - -{ #category : 'updating' } -SpNotificationCenterPresenter >> updatePresenter [ - - self modelChanged -] diff --git a/src/Spec2-Dialogs/SpProgressDialog.class.st b/src/Spec2-Dialogs/SpProgressDialog.class.st index c54791ece..7ca4f580e 100644 --- a/src/Spec2-Dialogs/SpProgressDialog.class.st +++ b/src/Spec2-Dialogs/SpProgressDialog.class.st @@ -83,16 +83,6 @@ SpProgressDialog >> initialize [ maxValue := 1.0 ] -{ #category : 'initialization' } -SpProgressDialog >> initializeDialogWindow: aDialogWindowPresenter [ - - aDialogWindowPresenter whenOpenedDo: [ self afterOpenAction ]. - - self parentWindow - ifNotNil: [ :w | aDialogWindowPresenter centeredRelativeTo: w ] - ifNil: [ aDialogWindowPresenter centered ] -] - { #category : 'initialization' } SpProgressDialog >> initializePresenters [ diff --git a/src/Spec2-Dialogs/SpRequestDialog.class.st b/src/Spec2-Dialogs/SpRequestDialog.class.st index ffe51870e..f7f8fa055 100644 --- a/src/Spec2-Dialogs/SpRequestDialog.class.st +++ b/src/Spec2-Dialogs/SpRequestDialog.class.st @@ -92,12 +92,12 @@ SpRequestDialog >> connectPresenters [ super connectPresenters. textInput - bindKeyCombination: Character cr asKeyCombination - toAction: [ self accept ]; - - bindKeyCombination: Character escape asKeyCombination - toAction: [ self cancel ]. - + addShortcutWith: [ :action | action + shortcutKey: Character cr asKeyCombination; + action: [ self accept ] ]; + addShortcutWith: [ :action | action + shortcutKey: Character escape asKeyCombination; + action: [ self cancel ] ] ] { #category : 'layout' } diff --git a/src/Spec2-Dialogs/SpRequestTextDialog.class.st b/src/Spec2-Dialogs/SpRequestTextDialog.class.st index 9fd0f309a..960a44753 100644 --- a/src/Spec2-Dialogs/SpRequestTextDialog.class.st +++ b/src/Spec2-Dialogs/SpRequestTextDialog.class.st @@ -58,4 +58,6 @@ SpRequestTextDialog >> initializePresenters [ label := self newDialogLabel. textInput := self newTextInput. errorLabel := self newLabel. + + label hide ] diff --git a/src/Spec2-Dialogs/SpSelectDialog.class.st b/src/Spec2-Dialogs/SpSelectDialog.class.st index 5f12e5d0a..8a2e52392 100644 --- a/src/Spec2-Dialogs/SpSelectDialog.class.st +++ b/src/Spec2-Dialogs/SpSelectDialog.class.st @@ -165,25 +165,25 @@ SpSelectDialog >> openModal [ ifFalse: [ nil ] ] -{ #category : 'api' } +{ #category : 'api - selection' } SpSelectDialog >> selectFirst [ list selectFirst ] -{ #category : 'api' } +{ #category : 'api - selection' } SpSelectDialog >> selectIndex: aNumber [ list selectIndex: aNumber ] -{ #category : 'api' } +{ #category : 'api - selection' } SpSelectDialog >> selectItem: anObject [ list selectItem: anObject ] -{ #category : 'api' } +{ #category : 'api - selection' } SpSelectDialog >> selectedItem [ ^ list selectedItem diff --git a/src/Spec2-Examples/SpApplicationWithToolbar.class.st b/src/Spec2-Examples/SpApplicationWithToolbar.class.st index 8742879dc..ef3f9eb77 100644 --- a/src/Spec2-Examples/SpApplicationWithToolbar.class.st +++ b/src/Spec2-Examples/SpApplicationWithToolbar.class.st @@ -99,7 +99,7 @@ SpApplicationWithToolbar >> initializePresenters [ description: 'Add menu item'; icon: (self iconNamed: #add); action: [ self addItemTo: group ] ] ]. - menu addKeybindingsTo: self. + menu addKeyBindingsTo: self. text := self newText. self focusOrder add: text ] diff --git a/src/Spec2-Examples/SpDemo.class.st b/src/Spec2-Examples/SpDemo.class.st index 4dffa09e4..5d2284009 100644 --- a/src/Spec2-Examples/SpDemo.class.st +++ b/src/Spec2-Examples/SpDemo.class.st @@ -121,28 +121,24 @@ SpDemo >> initializePresenters [ yourself. menu := self mainMenu. - menu addKeybindingsTo: self. + menu addKeyBindingsTo: self. list := self newList. list items: self availablePages; display: [ :item | item pageName ]; - contextMenu: (self newMenu - addItem: [ :item | - item - name: 'Browse'; - icon: (self iconNamed: #smallHelp); - action: [ list selectedItem browse ] ]; - addItem: [ :item | - item - name: 'Browse presenter'; - icon: (self iconNamed: #smallHelp); - action: [ list selectedItem new pageClass browse ] ]; - yourself). + addActionWith: [ :item | item + name: 'Browse'; + iconName: #smallHelp; + action: [ list selectedItem browse ] ]; + addActionWith: [ :item | item + name: 'Browse presenter'; + iconName: #smallHelp; + action: [ list selectedItem new pageClass browse ] ]. self focusOrder add: list; - addAll: page presenters + addAll: page presenters ] { #category : 'accessing' } diff --git a/src/Spec2-Examples/SpDemoButtonsPresenter.class.st b/src/Spec2-Examples/SpDemoButtonsPresenter.class.st index ce8f13c5a..a629b0e5b 100644 --- a/src/Spec2-Examples/SpDemoButtonsPresenter.class.st +++ b/src/Spec2-Examples/SpDemoButtonsPresenter.class.st @@ -52,6 +52,7 @@ SpDemoButtonsPresenter >> defaultLayout [ { #category : 'initialization' } SpDemoButtonsPresenter >> initializePresenters [ + buttonNormal := self newButton label: 'normal'. buttonDisabled := self newButton label: 'disabled'; @@ -75,7 +76,7 @@ SpDemoButtonsPresenter >> initializePresenters [ yourself. buttonWithMenu := self newButton label: 'with menu'; - contextMenu: self subMenu; + actions: self subMenuActions; yourself. buttonWithShortcut := self newButton shortcut: $o meta; @@ -90,47 +91,32 @@ a multiline help'; buttonWithDifferentFont := self newButton label: 'different font'; font: StandardFonts codeFont; - yourself. - - self focusOrder - add: buttonNormal; - add: buttonDisabled; - add: buttonWithIcon; - add: buttonWithIconOnly; - add: buttonHighlighted; - add: buttonWithColor; - add: buttonWithMenu; - add: buttonWithShortcut; - add: buttonWithHelp; - add: buttonWithDifferentFont + yourself ] { #category : 'initialization' } -SpDemoButtonsPresenter >> subMenu [ - ^ self newMenu - addItem: [ :item | - item - name: 'Open'; - icon: (self iconNamed: #opens); - shortcut: $o meta; - action: [ self inform: 'Open' ] ]; - addItem: [ :item | - item - name: 'Save'; - icon: (self iconNamed: #smallSave); - shortcut: $s meta; - action: [ self inform: 'Save' ] ]; - addItem: [ :item | - item - name: 'Print'; - shortcut: $p meta; - icon: (self iconNamed: #smallPrint); - action: [ self inform: 'Print' ] ]; - addItem: [ :item | - item - name: 'Kill'; - shortcut: $k meta; - icon: (self iconNamed: #smallCancel); - action: [ self inform: 'Kill' ] ]; +SpDemoButtonsPresenter >> subMenuActions [ + + ^ SpActionGroup new + addActionWith: [ :item | item + name: 'Open'; + iconName: #opens; + shortcut: $o actionModifier; + action: [ self inform: 'Open' ] ]; + addActionWith: [ :item | item + name: 'Save'; + iconName: #smallSave; + shortcut: $s actionModifier; + action: [ self inform: 'Save' ] ]; + addActionWith: [ :item | item + name: 'Print'; + shortcut: $p actionModifier; + iconName: #smallPrint; + action: [ self inform: 'Print' ] ]; + addActionWith: [ :item | item + name: 'Kill'; + shortcut: $k actionModifier; + iconName: #smallCancel; + action: [ self inform: 'Kill' ] ]; yourself ] diff --git a/src/Spec2-Examples/SpDemoListsPresenter.class.st b/src/Spec2-Examples/SpDemoListsPresenter.class.st index d388ddccc..94c99c49e 100644 --- a/src/Spec2-Examples/SpDemoListsPresenter.class.st +++ b/src/Spec2-Examples/SpDemoListsPresenter.class.st @@ -96,7 +96,7 @@ SpDemoListsPresenter >> initializePresenters [ list1 items: self class environment allClasses; - contextMenu: self list1Menu. + actions: self list1MenuActions. list2 items: self class environment allClasses; sortingBlock: [ :a :b | a asString size < b asString size ]; @@ -120,54 +120,41 @@ SpDemoListsPresenter >> list1 [ ] { #category : 'menu' } -SpDemoListsPresenter >> list1Menu [ - ^ self newMenu - title: 'Context menu example'; - addGroup: [ :aGroup | - aGroup - addItem: [ :anItem | - anItem - name: 'Print in transcript'; - shortcut: $p meta; - description: 'Print the selected class on Transcript'; - action: [ list1 selectedItem traceCr ] ]; - addItem: [ :anItem | - anItem - name: 'Browse'; - iconName: #open; - action: [ list1 selectedItem browse ] ]; - addItem: [ :anItem | - anItem - name: 'Print infos'; - subMenu: - (self newMenu - addGroup: [ :aSubGroup | - aSubGroup - addItem: [ :item | - item - name: 'Print number of methods'; - action: [ list1 selectedItem methods size traceCr ] ]; - addItem: [ :item | - item - name: 'Print number of variables'; - action: [ list1 selectedItem instanceVariables size traceCr ] ] ]) ] ]; - addGroup: [ :aGroup | - aGroup - addItem: [ :anItem | - anItem - name: 'Item showing only if item a odd number of letters'; - visibleIf: [ list1 selectedItem printString size odd ]; - action: [ list1 selectedItem traceCr ] ]; - addItem: [ :anItem | - anItem - name: 'Disabled in second group'; - disable; - action: [ list1 selectedItem traceCr ] ]; - addItem: [ :anItem | - anItem - name: 'Disabled if class begins with A'; - enabled: [ list1 selectedItem printString first ~= $A ]; - action: [ list1 selectedItem traceCr ] ] ] +SpDemoListsPresenter >> list1MenuActions [ + + ^ SpActionGroup new + addActionWith: [ :anItem | anItem + name: 'Print in transcript'; + shortcutKey: $p meta; + description: 'Print the selected class on Transcript'; + action: [ list1 selectedItem traceCr ] ]; + addActionWith: [ :anItem | anItem + name: 'Browse'; + iconName: #open; + action: [ list1 selectedItem browse ] ]; + addGroupWith: [ :aGroup | aGroup + name: 'Print infos'; + beDisplayedAsSubMenu; + addActionWith: [ :item | item + name: 'Print number of methods'; + action: [ list1 selectedItem methods size traceCr ] ]; + addActionWith: [ :item | item + name: 'Print number of variables'; + action: [ list1 selectedItem instanceVariables size traceCr ] ] ]; + addGroupWith: [ :aGroup | aGroup + addActionWith: [ :anItem | anItem + name: 'Item showing only if item a odd number of letters'; + actionEnabled: [ list1 selectedItem printString size odd ]; + action: [ list1 selectedItem traceCr ] ]; + addActionWith: [ :anItem | anItem + name: 'Disabled in second group'; + actionEnabled: [ false ]; + action: [ list1 selectedItem traceCr ] ]; + addActionWith: [ :anItem | anItem + name: 'Disabled if class begins with A'; + actionEnabled: [ list1 selectedItem printString first ~= $A ]; + action: [ list1 selectedItem traceCr ] ] ]; + yourself ] { #category : 'accessing' } diff --git a/src/Spec2-Examples/SpDemoTreeTablePresenter.class.st b/src/Spec2-Examples/SpDemoTreeTablePresenter.class.st index d1a54dabc..65420f4d4 100644 --- a/src/Spec2-Examples/SpDemoTreeTablePresenter.class.st +++ b/src/Spec2-Examples/SpDemoTreeTablePresenter.class.st @@ -46,58 +46,47 @@ SpDemoTreeTablePresenter >> initializePresenters [ roots: {Object}; children: [ :aClass | aClass subclasses ]; beResizable; - contextMenu: self menu; + actions: self menuActions; activateOnDoubleClick; whenActivatedDo: [ :selection | selection selectedItem browse ] ] { #category : 'accessing' } -SpDemoTreeTablePresenter >> menu [ - ^ self newMenu - title: 'Context menu example'; - addGroup: [ :aGroup | - aGroup - addItem: [ :anItem | - anItem - name: 'Print in transcript'; - shortcut: $p meta; - description: 'Print the selected class on Transcript'; - action: [ table1 selectedItem traceCr ] ]; - addItem: [ :anItem | - anItem - name: 'Browse'; - iconName: #open; - action: [ table1 selectedItem browse ] ]; - addItem: [ :anItem | - anItem - name: 'Print infos'; - subMenu: - (self newMenu - addGroup: [ :aSubGroup | - aSubGroup - addItem: [ :item | - item - name: 'Print number of methods'; - action: [ table1 selectedItem methods size traceCr ] ]; - addItem: [ :item | - item - name: 'Print number of variables'; - action: [ table1 selectedItem instanceVariables size traceCr ] ] ]) ] ]; - addGroup: [ :aGroup | - aGroup - addItem: [ :anItem | - anItem - name: 'Item showing only if item a odd number of letters'; - visibleIf: [ table1 selectedItem printString size odd ]; - action: [ table1 selectedItem traceCr ] ]; - addItem: [ :anItem | - anItem - name: 'Disabled in second group'; - disable; - action: [ table1 selectedItem traceCr ] ]; - addItem: [ :anItem | - anItem - name: 'Disabled if class begins with A'; - enabled: [ table1 selectedItem printString first ~= $A ]; - action: [ table1 selectedItem traceCr ] ] ] +SpDemoTreeTablePresenter >> menuActions [ + + ^ SpActionGroup new + name: 'Context menu example'; + addGroupWith: [ :aGroup | aGroup + addActionWith: [ :anItem | anItem + name: 'Print in transcript'; + shortcutKey: $p actionModifier; + description: 'Print the selected class on Transcript'; + action: [ table1 selectedItem traceCr ] ]; + addActionWith: [ :anItem | anItem + name: 'Browse'; + iconName: #open; + action: [ table1 selectedItem browse ] ]; + addGroupWith: [ :anItem | anItem + name: 'Print infos'; + beDisplayedAsSubMenu; + addActionWith: [ :item | item + name: 'Print number of methods'; + action: [ table1 selectedItem methods size traceCr ] ]; + addActionWith: [ :item | item + name: 'Print number of variables'; + action: [ table1 selectedItem instanceVariables size traceCr ] ] ] ]; + addGroupWith: [ :aGroup | aGroup + addActionWith: [ :anItem | anItem + name: 'Item showing only if item a odd number of letters'; + actionEnabled: [ table1 selectedItem printString size odd ]; + action: [ table1 selectedItem traceCr ] ]; + addActionWith: [ :anItem | anItem + name: 'Disabled in second group'; + actionEnabled: [ false ]; + action: [ table1 selectedItem traceCr ] ]; + addActionWith: [ :anItem | anItem + name: 'Disabled if class begins with A'; + actionEnabled: [ table1 selectedItem printString first ~= $A ]; + action: [ table1 selectedItem traceCr ] ] ]; + yourself ] diff --git a/src/Spec2-Examples/SpDropListPresenter.extension.st b/src/Spec2-Examples/SpDropListPresenter.extension.st index 634db83f8..e0b376fea 100644 --- a/src/Spec2-Examples/SpDropListPresenter.extension.st +++ b/src/Spec2-Examples/SpDropListPresenter.extension.st @@ -14,20 +14,6 @@ SpDropListPresenter class >> example [ yourself ] -{ #category : '*Spec2-Examples' } -SpDropListPresenter class >> exampleWithActions [ - "This example shows how to add icons to a dropdown list." - - ^ (self new - help: 'Select the presenter.'; - addItemLabeled: 'Action 1' do: [ 'Action 1' crTrace ]; - addItemLabeled: 'Action 2' do: [ 'Action 2' crTrace ]; - addItemLabeled: 'Action 3' do: [ 'Action 3' crTrace ]; - open) - resize: 400 @ 25; - yourself -] - { #category : '*Spec2-Examples' } SpDropListPresenter class >> exampleWithIcons [ "This example shows how to add icons to a dropdown list." diff --git a/src/Spec2-Examples/SpExampleBrowser.class.st b/src/Spec2-Examples/SpExampleBrowser.class.st index 8cb037010..9b3c0bcee 100644 --- a/src/Spec2-Examples/SpExampleBrowser.class.st +++ b/src/Spec2-Examples/SpExampleBrowser.class.st @@ -89,7 +89,7 @@ SpExampleBrowser >> initializePresenters [ display: [ :aNode | aNode name ]; displayIcon: [ :aNode | aNode iconName ifNotNil: [ :aName | self iconNamed: aName ] ]; children: [ :aNode | aNode children ]; - contextMenu: [ self listMenu ]; + actions: self listMenuActions; expandRoots. browseButton := self newButton @@ -120,16 +120,17 @@ SpExampleBrowser >> initializeWindow: aWindow [ ] { #category : 'initialization' } -SpExampleBrowser >> listMenu [ +SpExampleBrowser >> listMenuActions [ - ^ self newMenu - addItem: [ :item | item + ^ SpActionGroup new + addActionWith: [ :item | item name: 'Browse'; action: [ self browseSelectedExample ] ]; - addItem: [ :item | item + addActionWith: [ :item | item name: 'Run'; enabled: runButton isEnabled; - action: [ self runSelectedExample ] ] + action: [ self runSelectedExample ] ]; + yourself ] { #category : 'actions' } diff --git a/src/Spec2-Examples/SpTreePresenter.extension.st b/src/Spec2-Examples/SpTreePresenter.extension.st index fc0ea9c90..e2ca13a8e 100644 --- a/src/Spec2-Examples/SpTreePresenter.extension.st +++ b/src/Spec2-Examples/SpTreePresenter.extension.st @@ -52,12 +52,16 @@ SpTreePresenter class >> exampleSelectPathByItems [ SpTreePresenter class >> exampleWithContextMenu [ | tree | - + + self flag: #TODO. "This contextMenu was better, since it was updating before + execution... I need to be able to reproduce it." + ^ (tree := self new) roots: { Object }; children: [ :aClass | aClass subclasses ]; displayIcon: [ :aClass | self iconNamed: aClass systemIconName ]; display: [ :aClass | aClass name ]; + addActionWith: [ :item | item name: tree selectedItem asString ]; contextMenu: [ SpMenuPresenter new addGroup: [ :group | group diff --git a/src/Spec2-Layout/SpTabLayout.class.st b/src/Spec2-Layout/SpTabLayout.class.st index 53cb81f72..9c6b80d3f 100644 --- a/src/Spec2-Layout/SpTabLayout.class.st +++ b/src/Spec2-Layout/SpTabLayout.class.st @@ -30,7 +30,7 @@ SpTabLayout >> add: aName label: aString [ { #category : 'accessing' } SpTabLayout >> add: aPresenter withConstraints: aBlock [ - + super add: aPresenter withConstraints: aBlock. self announceChildAdded: aPresenter ] diff --git a/src/Spec2-ListView-Tests/SpListViewPresenterTest.class.st b/src/Spec2-ListView-Tests/SpListViewPresenterTest.class.st index f8817a952..74f5c6382 100644 --- a/src/Spec2-ListView-Tests/SpListViewPresenterTest.class.st +++ b/src/Spec2-ListView-Tests/SpListViewPresenterTest.class.st @@ -22,5 +22,6 @@ SpListViewPresenterTest >> initializeTestedInstance [ { #category : 'running' } SpListViewPresenterTest >> tearDown [ - presenter withWindowDo: [ :w | w close ] + presenter withWindowDo: [ :w | w close ]. + super tearDown ] diff --git a/src/Spec2-ListView/SpAbstractEasyListViewPresenter.class.st b/src/Spec2-ListView/SpAbstractEasyListViewPresenter.class.st new file mode 100644 index 000000000..eb6fab7b4 --- /dev/null +++ b/src/Spec2-ListView/SpAbstractEasyListViewPresenter.class.st @@ -0,0 +1,149 @@ +Class { + #name : 'SpAbstractEasyListViewPresenter', + #superclass : 'SpAbstractEasyPresenter', + #classTraits : 'SpTSearchable classTrait', + #category : 'Spec2-ListView-Easy', + #package : 'Spec2-ListView', + #tag : 'Easy' +} + +{ #category : 'api' } +SpAbstractEasyListViewPresenter >> addScrollBarStyle: aStyle [ + + contentView addScrollBarStyle: aStyle +] + +{ #category : 'private' } +SpAbstractEasyListViewPresenter >> findFirst: aString [ + | items | + + items := contentView items. + items isEmptyOrNil ifTrue: [ ^ 0 ]. + + (contentView selection selectedIndex max: 1) to: items size do: [ :index | + (self + performSearch: (items at: index) + matching: aString) + ifTrue: [ ^ index ] ]. + + ^ 0 +] + +{ #category : 'api' } +SpAbstractEasyListViewPresenter >> items [ + + ^ contentView items +] + +{ #category : 'api' } +SpAbstractEasyListViewPresenter >> items: aCollection [ + + contentView items: aCollection +] + +{ #category : 'api' } +SpAbstractEasyListViewPresenter >> listSize [ + + ^ contentView listSize +] + +{ #category : 'api' } +SpAbstractEasyListViewPresenter >> model [ + + ^ contentView model +] + +{ #category : 'api' } +SpAbstractEasyListViewPresenter >> removeScrollBarStyle: aStyle [ + + ^ contentView removeScrollBarStyle: aStyle +] + +{ #category : 'api' } +SpAbstractEasyListViewPresenter >> scrollBarStyles [ + + ^ contentView scrollBarStyles +] + +{ #category : 'selection' } +SpAbstractEasyListViewPresenter >> selectFirst [ + + contentView selectFirst +] + +{ #category : 'private' } +SpAbstractEasyListViewPresenter >> selectFirst: aString [ + | index | + + index := self findFirst: aString. + index = 0 ifTrue: [ ^ self ]. + + contentView selectIndex: index scrollToSelection: true +] + +{ #category : 'api - selection' } +SpAbstractEasyListViewPresenter >> selectIndex: anInteger [ + + contentView selectIndex: anInteger +] + +{ #category : 'api - selection' } +SpAbstractEasyListViewPresenter >> selectItem: anObject [ + + contentView selectItem: anObject +] + +{ #category : 'api - selection' } +SpAbstractEasyListViewPresenter >> selectedIndex [ + + ^ contentView selectedIndex + +] + +{ #category : 'api - selection' } +SpAbstractEasyListViewPresenter >> selectedItem [ + + ^ contentView selectedItem +] + +{ #category : 'api - selection' } +SpAbstractEasyListViewPresenter >> selectedItems [ + + ^ contentView selectedItems +] + +{ #category : 'api - selection' } +SpAbstractEasyListViewPresenter >> selection [ + + ^ contentView selection +] + +{ #category : 'api' } +SpAbstractEasyListViewPresenter >> showColumnHeaders [ + + self flag: #TODO +] + +{ #category : 'api' } +SpAbstractEasyListViewPresenter >> sortingBlock: aBlock [ + + self model sortingBlock: aBlock +] + +{ #category : 'api - events' } +SpAbstractEasyListViewPresenter >> whenModelChangedDo: aBlock [ + + contentView whenModelChangedDo: aBlock +] + +{ #category : 'api' } +SpAbstractEasyListViewPresenter >> withScrollBars [ + + contentView withScrollBars +] + +{ #category : 'api' } +SpAbstractEasyListViewPresenter >> withoutScrollBars [ + + contentView withoutScrollBars +] diff --git a/src/Spec2-ListView/SpAbstractEasyPresenter.class.st b/src/Spec2-ListView/SpAbstractEasyPresenter.class.st new file mode 100644 index 000000000..b3f7a20fc --- /dev/null +++ b/src/Spec2-ListView/SpAbstractEasyPresenter.class.st @@ -0,0 +1,229 @@ +Class { + #name : 'SpAbstractEasyPresenter', + #superclass : 'SpPresenter', + #traits : 'SpTSearchable', + #classTraits : 'SpTSearchable classTrait', + #instVars : [ + '#contentView', + '#searchInput', + '#lastSelectedRow => WeakSlot' + ], + #category : 'Spec2-ListView-Easy', + #package : 'Spec2-ListView', + #tag : 'Easy' +} + +{ #category : 'api - actions' } +SpAbstractEasyPresenter >> actions [ + + ^ contentView actions +] + +{ #category : 'api - actions' } +SpAbstractEasyPresenter >> actions: aSpCommandGroup [ + + contentView actions: aSpCommandGroup +] + +{ #category : 'api' } +SpAbstractEasyPresenter >> activateOnDoubleClick [ + + contentView activateOnDoubleClick +] + +{ #category : 'api' } +SpAbstractEasyPresenter >> activateOnSingleClick [ + + contentView activateOnSingleClick +] + +{ #category : 'private' } +SpAbstractEasyPresenter >> activateSearchWith: aString [ + + lastSelectedRow := contentView selectedItem. + + searchInput text: aString. + searchInput show. + searchInput takeKeyboardFocus. + searchInput unselectAll. + searchInput cursorPositionIndex: aString size +] + +{ #category : 'api' } +SpAbstractEasyPresenter >> alternateRowsColor [ + + contentView alternateRowsColor + +] + +{ #category : 'api' } +SpAbstractEasyPresenter >> beMultipleSelection [ + + contentView beMultipleSelection +] + +{ #category : 'api' } +SpAbstractEasyPresenter >> beSingleSelection [ + + contentView beSingleSelection +] + +{ #category : 'initialization' } +SpAbstractEasyPresenter >> connectPresenters [ + + searchInput + addAction: (SpAction + newShortcutKey: Character escape asKeyCombination + action: [ self deactivateSearch: false ]); + addAction: (SpAction + newShortcutKey: Character cr asKeyCombination + action: [ self deactivateSearch: true ]); + whenTextChangedDo: [ :aString | self selectFirst: aString ]. + + contentView eventHandler + whenKeyDownDo: [ :event | self maybeActivateSearchOn: event ]; + whenFocusReceivedDo: [ :event | searchInput hide ] +] + +{ #category : 'api - actions' } +SpAbstractEasyPresenter >> contextMenuFromCommandsGroup: aValuable [ + + self actions: aValuable value +] + +{ #category : 'private' } +SpAbstractEasyPresenter >> deactivateSearch: acceptSelection [ + | currentSelection | + + currentSelection := contentView selectedItem. + searchInput hide. + contentView selectItem: (acceptSelection + ifTrue: [ currentSelection ] + ifFalse: [ lastSelectedRow ]). + contentView takeKeyboardFocus +] + +{ #category : 'transmission' } +SpAbstractEasyPresenter >> defaultInputPort [ + + ^ self inputItemsPort +] + +{ #category : 'layout' } +SpAbstractEasyPresenter >> defaultLayout [ + + ^ SpOverlayLayout new + child: contentView; + addOverlay: searchInput withConstraints: [ :c | c vAlignStart; hAlignEnd ]; + yourself +] + +{ #category : 'transmission' } +SpAbstractEasyPresenter >> defaultOutputPort [ + + ^ self outputSelectionPort +] + +{ #category : 'api' } +SpAbstractEasyPresenter >> disable [ + + self enabled: false +] + +{ #category : 'api' } +SpAbstractEasyPresenter >> enable [ + + self enabled: true +] + +{ #category : 'private - actions' } +SpAbstractEasyPresenter >> ensureActions [ + + ^ contentView ensureActions +] + +{ #category : 'initialization' } +SpAbstractEasyPresenter >> initialize [ + + super initialize. + self initializeTSearchable. + self registerEvents +] + +{ #category : 'initialization' } +SpAbstractEasyPresenter >> initializePresenters [ + + searchInput := self newTextInput. + searchInput hide +] + +{ #category : 'transmission' } +SpAbstractEasyPresenter >> inputItemsPort [ + + ^ (SpListItemsPort newPresenter: self) + delegateTo: [ contentView ]; + yourself +] + +{ #category : 'testing' } +SpAbstractEasyPresenter >> isActiveOnDoubleClick [ + "Answer true if activation event is triggered on double click" + + ^ contentView isActiveOnDoubleClick +] + +{ #category : 'testing' } +SpAbstractEasyPresenter >> isActiveOnSingleClick [ + "Answer true if activation event is triggered on single click" + + ^ contentView isActiveOnSingleClick +] + +{ #category : 'private' } +SpAbstractEasyPresenter >> maybeActivateSearchOn: event [ + + self isSearchEnabled ifFalse: [ ^ self ]. + "any modifier other than shift?" + (event anyModifierKeyPressed + or: [ (event keyValue between: 32 and: 127) not ]) + ifTrue: [ ^ self ]. + self activateSearchWith: event keyCharacter asString +] + +{ #category : 'transmission' } +SpAbstractEasyPresenter >> outputActivationPort [ + + ^ (SpActivationPort newPresenter: self) + delegateTo: [ contentView ]; + yourself +] + +{ #category : 'transmission' } +SpAbstractEasyPresenter >> outputSelectionPort [ + + ^ (SpSelectionPort newPresenter: self) + delegateTo: [ contentView ]; + yourself +] + +{ #category : 'initialization' } +SpAbstractEasyPresenter >> registerEvents [ +] + +{ #category : 'private' } +SpAbstractEasyPresenter >> selectFirst: aString [ + + self subclassResponsibility +] + +{ #category : 'api - events' } +SpAbstractEasyPresenter >> whenActivatedDo: aBlock [ + + contentView whenActivatedDo: aBlock +] + +{ #category : 'api - events' } +SpAbstractEasyPresenter >> whenSelectionChangedDo: aBlock [ + + contentView whenSelectionChangedDo: aBlock +] diff --git a/src/Spec2-ListView/SpAbstractEasyTreeListViewPresenter.class.st b/src/Spec2-ListView/SpAbstractEasyTreeListViewPresenter.class.st new file mode 100644 index 000000000..4284b0577 --- /dev/null +++ b/src/Spec2-ListView/SpAbstractEasyTreeListViewPresenter.class.st @@ -0,0 +1,314 @@ +" +A base for tree presenters, it defines basic functionality common to all trees. +" +Class { + #name : 'SpAbstractEasyTreeListViewPresenter', + #superclass : 'SpAbstractEasyPresenter', + #classTraits : 'SpTSearchable classTrait', + #category : 'Spec2-ListView-Easy', + #package : 'Spec2-ListView', + #tag : 'Easy' +} + +{ #category : 'testing' } +SpAbstractEasyTreeListViewPresenter class >> isAbstract [ + + ^ super isAbstract or: [ self = SpAbstractTreePresenter ] +] + +{ #category : 'api' } +SpAbstractEasyTreeListViewPresenter >> children: aBlock [ + "Set a block to answer the children of a node when it is expanded. + `aBlock` receives one argument, the node element to expand. + If there are no children to answer, `aBlock` needs to answer an empty collection." + + contentView children: aBlock +] + +{ #category : 'api' } +SpAbstractEasyTreeListViewPresenter >> collapseAll [ + "Collapse all nodes of the tree. " + + contentView collapseAll +] + +{ #category : 'api' } +SpAbstractEasyTreeListViewPresenter >> collapsePath: aPath [ + "Collapse the tree path. + `aPath` is the path to collapse. A path is an array of node indexes (e.g. #(1 2 3))" + + contentView collapsePath: aPath +] + +{ #category : 'transmission' } +SpAbstractEasyTreeListViewPresenter >> defaultInputPort [ + + ^ self inputRootsPort +] + +{ #category : 'api' } +SpAbstractEasyTreeListViewPresenter >> expandAll [ + "Expand all nodes of the tree. + WARNING: If your tree is big, this operation can be slow." + + contentView expandAll +] + +{ #category : 'api' } +SpAbstractEasyTreeListViewPresenter >> expandPath: aPath [ + "Expand the tree path. + `aPath` is the path to expand. A path is an array of node indexes (e.g. #(1 2 3))" + + contentView expandPath: aPath +] + +{ #category : 'api' } +SpAbstractEasyTreeListViewPresenter >> expandRoots [ + "Expand all roots of the tree" + + contentView expandRoots +] + +{ #category : 'initialization' } +SpAbstractEasyTreeListViewPresenter >> initialize [ + + super initialize. + self initializeTSearchable. + self registerEvents +] + +{ #category : 'transmission' } +SpAbstractEasyTreeListViewPresenter >> inputRootsPort [ + + ^ SpRootsPort newPresenter: self +] + +{ #category : 'api' } +SpAbstractEasyTreeListViewPresenter >> items: aCollection [ + "Set the roots of a tree. This is a convenience method, synonym of `SpTreePresenter>>#roots:`" + + self roots: aCollection +] + +{ #category : 'private' } +SpAbstractEasyTreeListViewPresenter >> lazilyComputeChildren: aBoolean [ + + self flag: #TOREMOVE. +] + +{ #category : 'transmission' } +SpAbstractEasyTreeListViewPresenter >> outputActivationPort [ + + ^ SpActivationPort newPresenter: self +] + +{ #category : 'transmission' } +SpAbstractEasyTreeListViewPresenter >> outputSelectionPort [ + + ^ SpSelectionPort newPresenter: self +] + +{ #category : 'api' } +SpAbstractEasyTreeListViewPresenter >> refresh [ + "Forces a refresh of the tree. + This is useful when some model contents has changed, but we do not want to reset the whole list + (and losing selections with it)" + + contentView refresh +] + +{ #category : 'api' } +SpAbstractEasyTreeListViewPresenter >> roots [ + "Answer the roots of the tree" + + ^ contentView roots +] + +{ #category : 'api' } +SpAbstractEasyTreeListViewPresenter >> roots: aCollection [ + "Set the roots of the tree table. + This is the starting point from where the whole tree will be shown." + + contentView roots: aCollection +] + +{ #category : 'api - selection' } +SpAbstractEasyTreeListViewPresenter >> selectItem: anItem [ + "Select `anItem` if it is included in model list. + It does not scrolls to selected element." + + contentView selectItem: anItem +] + +{ #category : 'api - selection' } +SpAbstractEasyTreeListViewPresenter >> selectItems: aListOfItem [ + "Select items included in `aCollection` if they are included in model list. + NOTE: In single selection mode it will select the first element of `aCollection` + It does not scrolls to selected element." + + contentView selectItems: aListOfItem +] + +{ #category : 'api - selection' } +SpAbstractEasyTreeListViewPresenter >> selectPath: aPath [ + "Selects element in `aPath` + `aPath` is the path to select. A path is an array of node indexes (e.g. #(1 2 3)). + It does not scrolls to selected element." + + contentView selectPath: aPath +] + +{ #category : 'api - selection' } +SpAbstractEasyTreeListViewPresenter >> selectPath: aPath scrollToSelection: shouldScrollToSelection [ + "Selects element in `aPath` + `aPath` is the path to select. A path is an array of node indexes (e.g. #(1 2 3)). + If `shouldScrollToSelection` is true, it will scroll to selected element. + IMPORTANT: Scrolling to selection just has sense when the widget is already shown, because before it + is displayed it does not has real bounds. In morphic (and gtk) it has a minimal extent assigned, + but that will change as soon as the widget is inserted in a container and the container applies its + layout." + + contentView + selectPath: aPath + scrollToSelection: shouldScrollToSelection +] + +{ #category : 'api - selection' } +SpAbstractEasyTreeListViewPresenter >> selectPathByItems: pathArray [ + + contentView selectPathByItems: pathArray + +] + +{ #category : 'api - selection' } +SpAbstractEasyTreeListViewPresenter >> selectPathByItems: pathArray scrollToSelection: aBoolean [ + "IMPORTANT: Scrolling to selection just has sense when the widget is already shown, because before it + is displayed it does not has real bounds. In morphic (and gtk) it has a minimal extent assigned, + but that will change as soon as the widget is inserted in a container and the container applies its + layout." + + contentView + selectPathByItems: pathArray + scrollToSelection: aBoolean +] + +{ #category : 'api - selection' } +SpAbstractEasyTreeListViewPresenter >> selectPaths: pathArray [ + "Selects all elements in `pathsArray`` + `pathsArray` is an array of paths. A path is an array of node indexes (e.g. #(1 2 3))" + + contentView selectPaths: pathArray +] + +{ #category : 'api - selection' } +SpAbstractEasyTreeListViewPresenter >> selectedItem [ + "Return selected item." + + ^ contentView selectedItem +] + +{ #category : 'api - selection' } +SpAbstractEasyTreeListViewPresenter >> selectedItems [ + "Return all the selected items in the case of a multiple selection list" + + ^ contentView selectedItems +] + +{ #category : 'api - selection' } +SpAbstractEasyTreeListViewPresenter >> selection [ + "Answer the selection object (an instance of `SpSingleSelectionMode` or `SpMultipleSelectionMode`). + This is not the item selected, but the selection container (it may contain one or many selected + items)" + + ^ contentView selection +] + +{ #category : 'api' } +SpAbstractEasyTreeListViewPresenter >> selectionMode [ + "Answer the selection object (an instance of `SpSingleSelectionMode` or `SpMultipleSelectionMode`). + This is not the item selected, but the selection container (it may contain one or many selected + items). + This is the same as `SpAbstractListPresenter>>#selection`" + + ^ contentView selectionMode +] + +{ #category : 'api - selection' } +SpAbstractEasyTreeListViewPresenter >> unselectAll [ + "Remove all selections" + + self selection unselectAll +] + +{ #category : 'api - selection' } +SpAbstractEasyTreeListViewPresenter >> unselectItem: anItem [ + "Remove selection of element `anItem`" + + self selection unselectItem: anItem +] + +{ #category : 'api - selection' } +SpAbstractEasyTreeListViewPresenter >> unselectPath: aPath [ + "Unselects element in `aPath` + `aPath` is the path to select. A path is an array of node indexes (e.g. #(1 2 3))" + + self selection unselectPath: aPath +] + +{ #category : 'api' } +SpAbstractEasyTreeListViewPresenter >> updateRootsKeepingSelection: aCollection [ + "Update tree roots keeping current selection. + WARNING: aCollection must includes the elements selected." + + contentView updateRootsKeepingSelection: aCollection +] + +{ #category : 'api - events' } +SpAbstractEasyTreeListViewPresenter >> whenMultiSelectionChangedDo: aBlock [ + "Inform when selection mode has changed. + `aBlock` has three optional arguments: + - new value + - old value + - the announcement triggering this action" + + contentView whenMultiSelectionChangedDo: aBlock +] + +{ #category : 'api - events' } +SpAbstractEasyTreeListViewPresenter >> whenRootsChangedDo: aBlock [ + "Inform when roots have changed. + `aBlock` has three optional arguments: + - new value + - old value + - the announcement triggering this action" + + contentView whenRootsChangedDo: aBlock +] + +{ #category : 'api - events' } +SpAbstractEasyTreeListViewPresenter >> whenSelectedIndexChangedDo: aBlock [ + "Inform when selected index has changed. + `aBlock` receives one optional argument (the new element)." + + contentView whenSelectedIndexChangedDo: aBlock +] + +{ #category : 'api - events' } +SpAbstractEasyTreeListViewPresenter >> whenSelectedItemChangedDo: aBlock [ + "Inform when selected index has changed. + `aBlock` receives one optional argument (the new element)." + + contentView whenSelectedItemChangedDo: aBlock + +] + +{ #category : 'api - events' } +SpAbstractEasyTreeListViewPresenter >> whenShowColumnHeadersChangedDo: aBlock [ + "Inform when showColumnHeaders property has changed. + `aBlock` has three optional arguments: + - new value + - old value + - the announcement triggering this action" + + contentView whenShowColumnHeadersChangedDo: aBlock +] diff --git a/src/Spec2-ListView/SpColumnViewColumn.class.st b/src/Spec2-ListView/SpColumnViewColumn.class.st new file mode 100644 index 000000000..2af93177e --- /dev/null +++ b/src/Spec2-ListView/SpColumnViewColumn.class.st @@ -0,0 +1,111 @@ +Class { + #name : 'SpColumnViewColumn', + #superclass : 'Object', + #instVars : [ + 'title', + 'bind', + 'setup', + 'expand', + 'width' + ], + #category : 'Spec2-ListView-Widget', + #package : 'Spec2-ListView', + #tag : 'Widget' +} + +{ #category : 'instance creation' } +SpColumnViewColumn class >> newTitle: aTitle setup: setupBlock bind: bindBlock [ + + ^ self new + title: aTitle; + setup: setupBlock; + bind: bindBlock; + yourself +] + +{ #category : 'accessing' } +SpColumnViewColumn >> beExpandable [ + + self expand: true +] + +{ #category : 'accessing' } +SpColumnViewColumn >> beNotExpandable [ + + self expand: false +] + +{ #category : 'api' } +SpColumnViewColumn >> bind: aBlock [ + + bind := aBlock +] + +{ #category : 'accessing' } +SpColumnViewColumn >> bindAction [ + + ^ bind +] + +{ #category : 'accessing' } +SpColumnViewColumn >> expand: aBoolean [ + + expand := aBoolean +] + +{ #category : 'testing' } +SpColumnViewColumn >> hasFixedWidth [ + + ^ width notNil +] + +{ #category : 'initialization' } +SpColumnViewColumn >> initialize [ + + super initialize. + self beExpandable. + self setup: [ :aPresenter | aPresenter newLabel ]. + self bind: [ :aPresenter :anObject | aPresenter label: anObject asString ] +] + +{ #category : 'testing' } +SpColumnViewColumn >> isExpand [ + + ^ expand +] + +{ #category : 'api' } +SpColumnViewColumn >> setup: aBlock [ + + setup := aBlock +] + +{ #category : 'accessing' } +SpColumnViewColumn >> setupAction [ + + ^ setup +] + +{ #category : 'api' } +SpColumnViewColumn >> title [ + + ^ title +] + +{ #category : 'api' } +SpColumnViewColumn >> title: aString [ + + title := aString +] + +{ #category : 'accessing' } +SpColumnViewColumn >> width [ + + ^ width +] + +{ #category : 'accessing' } +SpColumnViewColumn >> width: aNumber [ + + width := aNumber +] diff --git a/src/Spec2-ListView/SpColumnViewPresenter.class.st b/src/Spec2-ListView/SpColumnViewPresenter.class.st new file mode 100644 index 000000000..7f6560915 --- /dev/null +++ b/src/Spec2-ListView/SpColumnViewPresenter.class.st @@ -0,0 +1,206 @@ +Class { + #name : 'SpColumnViewPresenter', + #superclass : 'SpAbstractListPresenter', + #instVars : [ + '#columns => ObservableSlot', + '#isResizable => ObservableSlot', + '#showColumnHeaders => ObservableSlot' + ], + #category : 'Spec2-ListView-Widget', + #package : 'Spec2-ListView', + #tag : 'Widget' +} + +{ #category : 'specs' } +SpColumnViewPresenter class >> adapterName [ + + ^ #ColumnViewAdapter +] + +{ #category : 'examples' } +SpColumnViewPresenter class >> example [ + + ^ self new + application: (SpApplication new useBackend: #Gtk); + addColumnTitle: 'Class' + setup: [ :aPresenter | aPresenter newLabel ] + bind: [ :aPresenter :aClass | aPresenter label: aClass name ]; + items: Smalltalk allClasses; + open +] + +{ #category : 'examples' } +SpColumnViewPresenter class >> exampleActivateOnDoubleClick [ + + ^ self new + application: (SpApplication new useBackend: #Gtk); + isActiveOnDoubleClick; + addColumnTitle: 'Class' + setup: [ :aPresenter | aPresenter newLabel ] + bind: [ :aPresenter :aClass | aPresenter label: aClass name ]; + items: Smalltalk allClasses; + whenActivatedDo: [ :selection | selection selectedItem crTrace ]; + open +] + +{ #category : 'examples' } +SpColumnViewPresenter class >> exampleResizableColumns [ + + ^ self new + application: (SpApplication new useBackend: #Gtk); + beResizable; + items: Smalltalk allClasses; + addColumnTitle: 'Class' + setup: [ :aPresenter | aPresenter newLabel ] + bind: [ :aPresenter :aClass | aPresenter label: aClass name ]; + addColumnTitle: 'Lines of code' + setup: [ :aPresenter | aPresenter newLabel ] + bind: [ :aPresenter :aClass | aPresenter label: aClass linesOfCode asString ]; + open +] + +{ #category : 'examples' } +SpColumnViewPresenter class >> exampleWithIcons [ + + ^ self new + application: (SpApplication new useBackend: #Gtk); + addColumnTitle: 'Class' + setup: [ :aPresenter | + | presenter | + (presenter := aPresenter newPresenter) + layout: (SpBoxLayout newHorizontal + spacing: 5; + add: presenter newImage expand: false; + add: presenter newLabel; + yourself); + yourself ] + bind: [ :aPresenter :aClass | | icon image label | + icon := Smalltalk ui icons iconNamed: aClass systemIconName. + image := aPresenter layout children first. + image image: icon. + label := aPresenter layout children second. + label label: aClass name ]; + items: Smalltalk allClasses; + open +] + +{ #category : 'api' } +SpColumnViewPresenter >> addColumn: aColumn [ + "Add a column to the table. A column should be an instance of `SpTableColumn`" + + columns := columns copyWith: aColumn +] + +{ #category : 'api' } +SpColumnViewPresenter >> addColumnTitle: aTitle setup: setupBlock bind: bindBlock [ + + ^ self addColumn: (SpColumnViewColumn + newTitle: aTitle + setup: setupBlock + bind: bindBlock) +] + +{ #category : 'api' } +SpColumnViewPresenter >> addColumns: aCollection [ + "Add a list of columns. + `aCollection` is a list of instances of `SpTableColumn`" + + aCollection do: [ :each | self addColumn: each ] +] + +{ #category : 'api' } +SpColumnViewPresenter >> alternateRowsColor [ + "Will alternate Rows color for a better reading: one row lighter, the next row darker. + NOTE: Behavior in different backends may be slightly different." + + self withAdapterPerformOrDefer: [ :anAdapter | + anAdapter alternateRowsColor ] +] + +{ #category : 'api' } +SpColumnViewPresenter >> beNotResizable [ + + self isResizable: false +] + +{ #category : 'api' } +SpColumnViewPresenter >> beResizable [ + + self isResizable: true +] + +{ #category : 'accessing' } +SpColumnViewPresenter >> columns [ + ^ columns +] + +{ #category : 'accessing' } +SpColumnViewPresenter >> columns: aCollection [ + + columns := #(). + aCollection do: [ :each | + self addColumn: each ] +] + +{ #category : 'api' } +SpColumnViewPresenter >> hideColumnHeaders [ + "Hide the column headers" + + showColumnHeaders := false +] + +{ #category : 'initialization' } +SpColumnViewPresenter >> initialize [ + + super initialize. + self showColumnHeaders. + columns := #() +] + +{ #category : 'testing' } +SpColumnViewPresenter >> isResizable [ + + ^ isResizable +] + +{ #category : 'private' } +SpColumnViewPresenter >> isResizable: aBoolean [ + + isResizable := aBoolean +] + +{ #category : 'testing' } +SpColumnViewPresenter >> isShowingColumnHeaders [ + "Answer true if the table is configured to show column headers." + + ^ showColumnHeaders +] + +{ #category : 'api' } +SpColumnViewPresenter >> showColumnHeaders [ + "Show column headers" + + showColumnHeaders := true +] + +{ #category : 'api - events' } +SpColumnViewPresenter >> whenColumnsChangedDo: aBlock [ + "Inform when columns have changed. + `aBlock` has three optional arguments: + - new value + - old value + - the announcement triggering this action" + + self property: #columns whenChangedDo: aBlock +] + +{ #category : 'api - events' } +SpColumnViewPresenter >> whenIsResizableChangedDo: aBlock [ + "Inform when resizable property has changed. + `aBlock` has three optional arguments: + - new value + - old value + - the announcement triggering this action" + + self property: #isResizable whenChangedDo: aBlock +] diff --git a/src/Spec2-ListView/SpDropDownPresenter.class.st b/src/Spec2-ListView/SpDropDownPresenter.class.st index 5f2446b69..28b597880 100644 --- a/src/Spec2-ListView/SpDropDownPresenter.class.st +++ b/src/Spec2-ListView/SpDropDownPresenter.class.st @@ -8,8 +8,9 @@ Class { 'display', 'selection' ], - #category : 'Spec2-ListView', - #package : 'Spec2-ListView' + #category : 'Spec2-ListView-Widget', + #package : 'Spec2-ListView', + #tag : 'Widget' } { #category : 'specs' } @@ -156,6 +157,12 @@ SpDropDownPresenter >> items: aSequenceableCollection [ model collection: aSequenceableCollection ] +{ #category : 'api' } +SpDropDownPresenter >> listSize [ + + ^ self items size +] + { #category : 'api' } SpDropDownPresenter >> model [ "Answer the model for this list. @@ -186,6 +193,12 @@ SpDropDownPresenter >> outputSelectionPort [ ^ SpDropDownSelectionPort newPresenter: self ] +{ #category : 'api - selection' } +SpDropDownPresenter >> resetSelection [ + + self selection unselectAll +] + { #category : 'api - selection' } SpDropDownPresenter >> selectFirst [ "Select first element in list. @@ -245,6 +258,12 @@ SpDropDownPresenter >> setupAction [ ^ setupAction ] +{ #category : 'api' } +SpDropDownPresenter >> sortingBlock: aBlock [ + + self flag: #TODO. +] + { #category : 'api - events' } SpDropDownPresenter >> whenSelectedDo: aBlock [ "Inform when an item was selected (a real object in the items list). diff --git a/src/Spec2-ListView/SpEasyAbstractRowPresenter.class.st b/src/Spec2-ListView/SpEasyAbstractRowPresenter.class.st new file mode 100644 index 000000000..f02d00779 --- /dev/null +++ b/src/Spec2-ListView/SpEasyAbstractRowPresenter.class.st @@ -0,0 +1,24 @@ +Class { + #name : 'SpEasyAbstractRowPresenter', + #superclass : 'SpPresenter', + #traits : 'SpTModel', + #classTraits : 'SpTModel classTrait', + #instVars : [ + 'listView' + ], + #category : 'Spec2-ListView-Widget', + #package : 'Spec2-ListView', + #tag : 'Widget' +} + +{ #category : 'accessing' } +SpEasyAbstractRowPresenter >> listView [ + + ^ listView +] + +{ #category : 'accessing' } +SpEasyAbstractRowPresenter >> listView: aListView [ + + listView := aListView +] diff --git a/src/Spec2-ListView/SpEasyColumnBindBuilder.class.st b/src/Spec2-ListView/SpEasyColumnBindBuilder.class.st new file mode 100644 index 000000000..3c546331a --- /dev/null +++ b/src/Spec2-ListView/SpEasyColumnBindBuilder.class.st @@ -0,0 +1,71 @@ +Class { + #name : 'SpEasyColumnBindBuilder', + #superclass : 'SpEasyColumnVisitor', + #instVars : [ + 'item' + ], + #category : 'Spec2-ListView-Easy', + #package : 'Spec2-ListView', + #tag : 'Easy' +} + +{ #category : 'accessing' } +SpEasyColumnBindBuilder >> item [ + + ^ item +] + +{ #category : 'accessing' } +SpEasyColumnBindBuilder >> item: anObject [ + + item := anObject +] + +{ #category : 'visiting' } +SpEasyColumnBindBuilder >> visitCheckboxColumn: aColumn [ + + self presenter + state: (aColumn readObject: self item); + whenActivatedDo: [ aColumn onActivation value: self item ]; + whenDeactivatedDo: [ aColumn onDeactivation value: self item ] +] + +{ #category : 'visiting' } +SpEasyColumnBindBuilder >> visitCompositeColumn: aColumn [ + | presenters visitor | + + visitor := self class new + item: self item; + yourself. + presenters := self presenter layout presenters. + aColumn columns withIndexDo: [ :each :index | + visitor + presenter: (presenters at: index); + visit: each ] +] + +{ #category : 'visiting' } +SpEasyColumnBindBuilder >> visitImageColumn: aColumn [ + + ^ self presenter image: (aColumn readObject: self item) +] + +{ #category : 'visiting' } +SpEasyColumnBindBuilder >> visitLinkColumn: aColumn [ + + self item ifNil: [ + self presenter label: ''. + ^ self ]. + + self presenter + label: (aColumn readObject: self item) asString; + action: [ aColumn action value: self item ] +] + +{ #category : 'visiting' } +SpEasyColumnBindBuilder >> visitStringColumn: aColumn [ + + ^ self presenter label: (self item + ifNotNil: [ :anObject | (aColumn readObject: anObject) asString ] + ifNil: [ '' ]) +] diff --git a/src/Spec2-ListView/SpEasyColumnSetupBuilder.class.st b/src/Spec2-ListView/SpEasyColumnSetupBuilder.class.st new file mode 100644 index 000000000..08addb5d8 --- /dev/null +++ b/src/Spec2-ListView/SpEasyColumnSetupBuilder.class.st @@ -0,0 +1,55 @@ +" +Used to create the setup presenter for an ""easy"" column. +" +Class { + #name : 'SpEasyColumnSetupBuilder', + #superclass : 'SpEasyColumnVisitor', + #category : 'Spec2-ListView-Easy', + #package : 'Spec2-ListView', + #tag : 'Easy' +} + +{ #category : 'visiting' } +SpEasyColumnSetupBuilder >> visitCheckboxColumn: aColumn [ + + ^ self presenter newSwitch +] + +{ #category : 'visiting' } +SpEasyColumnSetupBuilder >> visitCompositeColumn: aColumn [ + | compositePresenter layout lastColumn | + + compositePresenter := self presenter newPresenter. + compositePresenter addStyle: 'easy_composite_cell'. + layout := SpBoxLayout newLeftToRight. + + lastColumn := aColumn columns last. + aColumn columns do: [ :each | + layout + add: (each acceptColumnVisitor: self) + withConstraints: [ :c | + each hasFixedWidth + ifTrue: [ c width: each width ] + ifFalse: [ c expand: (each isExpandable "or: [ each = lastColumn ]") ] ] ]. + + compositePresenter layout: layout. + ^ compositePresenter +] + +{ #category : 'visiting' } +SpEasyColumnSetupBuilder >> visitImageColumn: aColumn [ + + ^ self presenter newImage +] + +{ #category : 'visiting' } +SpEasyColumnSetupBuilder >> visitLinkColumn: aColumn [ + + ^ self presenter newLink +] + +{ #category : 'visiting' } +SpEasyColumnSetupBuilder >> visitStringColumn: aColumn [ + + ^ self presenter newLabel +] diff --git a/src/Spec2-ListView/SpEasyColumnViewPresenter.class.st b/src/Spec2-ListView/SpEasyColumnViewPresenter.class.st new file mode 100644 index 000000000..e3685cc43 --- /dev/null +++ b/src/Spec2-ListView/SpEasyColumnViewPresenter.class.st @@ -0,0 +1,134 @@ +Class { + #name : 'SpEasyColumnViewPresenter', + #superclass : 'SpAbstractEasyListViewPresenter', + #category : 'Spec2-ListView-Easy', + #package : 'Spec2-ListView', + #tag : 'Easy' +} + +{ #category : 'examples' } +SpEasyColumnViewPresenter class >> example [ + "This example show the simples list view you can make: A list with a label" + + self new + application: (SpApplication new useBackend: #Gtk); + items: self environment allClasses; + addColumn: (SpStringTableColumn new + title: 'Class'; + evaluated: [ :each | each name ]; + yourself); + addColumn: (SpStringTableColumn new + title: 'Lines of code'; + evaluated: [ :each | each linesOfCode ]; + yourself); + open +] + +{ #category : 'examples' } +SpEasyColumnViewPresenter class >> exampleActivateOnDoubleClick [ + "This example show the simples list view you can make: A list with a label" + + self new + application: (SpApplication new useBackend: #Gtk); + items: self environment allClasses; + addColumn: (SpStringTableColumn new + title: 'Class'; + evaluated: [ :each | each name ]; + yourself); + addColumn: (SpStringTableColumn new + title: 'Lines of code'; + evaluated: [ :each | each linesOfCode ]; + yourself); + activateOnDoubleClick; + whenActivatedDo: [ :selection| selection selectedItem crTrace ]; + open +] + +{ #category : 'api' } +SpEasyColumnViewPresenter >> addColumn: aColumn [ + + contentView addColumn: aColumn asColumnViewColumn +] + +{ #category : 'api' } +SpEasyColumnViewPresenter >> beNotResizable [ + + contentView beNotResizable +] + +{ #category : 'api' } +SpEasyColumnViewPresenter >> beResizable [ + + contentView beResizable +] + +{ #category : 'accessing' } +SpEasyColumnViewPresenter >> columns: aCollection [ + + contentView columns: aCollection + +] + +{ #category : 'api' } +SpEasyColumnViewPresenter >> contextMenu: aBlock [ + + self flag: #TODO. "ignored, as this is deprecated" +] + +{ #category : 'private' } +SpEasyColumnViewPresenter >> displayValueFor: aImage [ + + ^ contentView displayValueFor: aImage +] + +{ #category : 'api' } +SpEasyColumnViewPresenter >> hideColumnHeaders [ + + contentView hideColumnHeaders +] + +{ #category : 'initialization' } +SpEasyColumnViewPresenter >> initializePresenters [ + + super initializePresenters. + contentView := self newColumnView. + +] + +{ #category : 'testing' } +SpEasyColumnViewPresenter >> isShowingColumnHeaders [ + "Answer true if the table is configured to show column headers." + + ^ contentView isShowingColumnHeaders +] + +{ #category : 'api' } +SpEasyColumnViewPresenter >> showColumnHeaders [ + + contentView showColumnHeaders +] + +{ #category : 'api - selection' } +SpEasyColumnViewPresenter >> unselectAll [ + + contentView unselectAll +] + +{ #category : 'api - events' } +SpEasyColumnViewPresenter >> whenIsResizableChangedDo: aBlock [ + + contentView whenIsResizableChangedDo: aBlock + +] + +{ #category : 'enumerating' } +SpEasyColumnViewPresenter >> whenSelectedDo: aBlock [ + + contentView whenSelectedDo: aBlock +] + +{ #category : 'enumerating' } +SpEasyColumnViewPresenter >> whenSelectedItemChangedDo: aBlock [ + + contentView whenSelectedItemChangedDo: aBlock +] diff --git a/src/Spec2-ListView/SpEasyColumnVisitor.class.st b/src/Spec2-ListView/SpEasyColumnVisitor.class.st new file mode 100644 index 000000000..22c23ca52 --- /dev/null +++ b/src/Spec2-ListView/SpEasyColumnVisitor.class.st @@ -0,0 +1,74 @@ +" +A visitor for `SpTableColumn`. +This is uset to convert `SpTableColumn` into `SpColumnViewColumn` (needed to adapt the ""easy"" compatibility classes) +" +Class { + #name : 'SpEasyColumnVisitor', + #superclass : 'Object', + #instVars : [ + 'presenter' + ], + #category : 'Spec2-ListView-Easy', + #package : 'Spec2-ListView', + #tag : 'Easy' +} + +{ #category : 'accessing' } +SpEasyColumnVisitor >> presenter [ + + ^ presenter +] + +{ #category : 'accessing' } +SpEasyColumnVisitor >> presenter: aPresenter [ + + presenter := aPresenter +] + +{ #category : 'visiting' } +SpEasyColumnVisitor >> visit: aColumn [ + + ^ aColumn acceptColumnVisitor: self +] + +{ #category : 'visiting' } +SpEasyColumnVisitor >> visitCheckboxColumn: aColumn [ + + ^ self visitStringColumn: aColumn +] + +{ #category : 'visiting' } +SpEasyColumnVisitor >> visitCompositeColumn: aColumn [ + + ^ self visitStringColumn: aColumn +] + +{ #category : 'visiting' } +SpEasyColumnVisitor >> visitDropListColumn: aColumn [ + + ^ self visitStringColumn: aColumn +] + +{ #category : 'visiting' } +SpEasyColumnVisitor >> visitImageColumn: aColumn [ + + ^ self visitStringColumn: aColumn +] + +{ #category : 'visiting' } +SpEasyColumnVisitor >> visitIndexColumn: aColumn [ + + ^ self visitStringColumn: aColumn +] + +{ #category : 'visiting' } +SpEasyColumnVisitor >> visitLinkColumn: aColumn [ + + ^ self visitStringColumn: aColumn +] + +{ #category : 'visiting' } +SpEasyColumnVisitor >> visitStringColumn: aColumn [ + + ^ self subclassResponsibility +] diff --git a/src/Spec2-ListView/SpEasyComponentListPresenter.class.st b/src/Spec2-ListView/SpEasyComponentListPresenter.class.st new file mode 100644 index 000000000..612051439 --- /dev/null +++ b/src/Spec2-ListView/SpEasyComponentListPresenter.class.st @@ -0,0 +1,78 @@ +" +Note: while this list in general has no sense now with the new ListView/ColumnView components, it may still has a small use case for where each presenter is really different. +" +Class { + #name : 'SpEasyComponentListPresenter', + #superclass : 'SpAbstractEasyListViewPresenter', + #category : 'Spec2-ListView-Easy', + #package : 'Spec2-ListView', + #tag : 'Easy' +} + +{ #category : 'examples' } +SpEasyComponentListPresenter class >> example [ + | list | + + list := { + SpLabelPresenter new label: 'Test 1'; yourself. + SpImagePresenter new image: (self iconNamed: #smallOk); yourself. + SpButtonPresenter new label: 'A button'; yourself }. + + ^ self new + presenters: list; + open +] + +{ #category : 'api' } +SpEasyComponentListPresenter >> contextMenu: aBlock [ + + self flag: #TODO. "Ignored, as this should be deprecated" + +] + +{ #category : 'initialization' } +SpEasyComponentListPresenter >> initializePresenters [ + + super initializePresenters. + + contentView := self newListView + setup: [ :aPresenter | + aPresenter newPresenter + layout: SpBoxLayout newVertical; + yourself ]; + bind: [ :aPresenter :childObject | + aPresenter layout + removeAll; + add: childObject; + yourself ]; + yourself +] + +{ #category : 'api' } +SpEasyComponentListPresenter >> presenters [ + + ^ self items +] + +{ #category : 'api' } +SpEasyComponentListPresenter >> presenters: aCollectionOfPresenters [ + + self items: aCollectionOfPresenters +] + +{ #category : 'api' } +SpEasyComponentListPresenter >> updateItemsKeepingSelection: aCollection [ + + contentView updateItemsKeepingSelection: aCollection +] + +{ #category : 'api - events' } +SpEasyComponentListPresenter >> whenPresentersChangedDo: aBlock [ + "Inform when the presenter list changed (See `SpComponentListPresenter>>#presenters:`. + `aBlock` receive 3 optional arguments: + - new value + - old value + - announcement triggered" + + contentView whenModelChangedDo: aBlock +] diff --git a/src/Spec2-ListView/SpEasyListRowPresenter.class.st b/src/Spec2-ListView/SpEasyListRowPresenter.class.st index afd87a74f..364990b82 100644 --- a/src/Spec2-ListView/SpEasyListRowPresenter.class.st +++ b/src/Spec2-ListView/SpEasyListRowPresenter.class.st @@ -1,15 +1,13 @@ Class { #name : 'SpEasyListRowPresenter', - #superclass : 'SpPresenter', - #traits : 'SpTModel', - #classTraits : 'SpTModel classTrait', + #superclass : 'SpEasyAbstractRowPresenter', #instVars : [ - 'listView', 'iconPresenter', 'textPresenter' ], - #category : 'Spec2-ListView', - #package : 'Spec2-ListView' + #category : 'Spec2-ListView-Widget', + #package : 'Spec2-ListView', + #tag : 'Widget' } { #category : 'layout' } @@ -35,17 +33,11 @@ SpEasyListRowPresenter >> initializePresenters [ textPresenter := self newLabel ] -{ #category : 'accessing' } -SpEasyListRowPresenter >> listView [ - - ^ listView -] - { #category : 'accessing' } SpEasyListRowPresenter >> listView: aListView [ - listView := aListView. - listView hasIcons + super listView: aListView. + aListView hasIcons ifTrue: [ self useIconLayout ] ifFalse: [ self useTextLayout ] ] diff --git a/src/Spec2-ListView/SpEasyListViewPresenter.class.st b/src/Spec2-ListView/SpEasyListViewPresenter.class.st index 426559dc4..f4683efaa 100644 --- a/src/Spec2-ListView/SpEasyListViewPresenter.class.st +++ b/src/Spec2-ListView/SpEasyListViewPresenter.class.st @@ -1,24 +1,21 @@ Class { #name : 'SpEasyListViewPresenter', - #superclass : 'SpPresenter', - #traits : 'SpTSearchable', - #classTraits : 'SpTSearchable classTrait', + #superclass : 'SpAbstractEasyListViewPresenter', #instVars : [ '#display => ObservableSlot', '#displayIcon => ObservableSlot', - '#searchInput', - '#listView', '#headerPanel', - '#lastSelectedRow => WeakSlot' + '#rowPresenterClass' ], - #category : 'Spec2-ListView', - #package : 'Spec2-ListView' + #category : 'Spec2-ListView-Easy', + #package : 'Spec2-ListView', + #tag : 'Easy' } -{ #category : 'specs' } -SpEasyListViewPresenter class >> adapterName [ +{ #category : 'accessing' } +SpEasyListViewPresenter class >> defaultRowPresenterClass [ - ^ #EasyListViewAdapter + ^ SpEasyListRowPresenter ] { #category : 'examples' } @@ -26,7 +23,7 @@ SpEasyListViewPresenter class >> example [ "This example show a simple list with all classes, using all the default settings." ^ self new - "application: (SpApplication new useBackend: #Gtk);" + application: (SpApplication new useBackend: #Gtk); items: self environment allClasses; open; yourself @@ -66,99 +63,17 @@ SpEasyListViewPresenter class >> exampleWithIcons [ yourself ] -{ #category : 'api - actions' } -SpEasyListViewPresenter >> actionGroup [ - - ^ listView actionGroup -] - -{ #category : 'api - actions' } -SpEasyListViewPresenter >> actionGroup: aSpCommandGroup [ - - listView actionGroup: aSpCommandGroup -] - -{ #category : 'api' } -SpEasyListViewPresenter >> activateOnDoubleClick [ - - listView activateOnDoubleClick -] - -{ #category : 'api' } -SpEasyListViewPresenter >> activateOnSingleClick [ - - listView activateOnSingleClick -] - -{ #category : 'private' } -SpEasyListViewPresenter >> activateSearchWith: aString [ - - lastSelectedRow := listView selectedItem. - - searchInput text: aString. - searchInput show. - searchInput takeKeyboardFocus. - searchInput unselectAll. - searchInput cursorPositionIndex: aString size -] - -{ #category : 'api - actions' } -SpEasyListViewPresenter >> addAction: aSpCommand [ - - listView addAction: aSpCommand -] - -{ #category : 'api' } -SpEasyListViewPresenter >> addScrollBarStyle: aStyle [ - - listView addScrollBarStyle: aStyle -] - -{ #category : 'api' } -SpEasyListViewPresenter >> beMultipleSelection [ - - listView beMultipleSelection -] - -{ #category : 'api' } -SpEasyListViewPresenter >> beSingleSelection [ - - listView beSingleSelection -] - { #category : 'initialization' } SpEasyListViewPresenter >> connectPresenters [ - searchInput - addAction: (SpAction - newShortcut: Character escape asKeyCombination - action: [ self deactivateSearch: false ]); - addAction: (SpAction - newShortcut: Character cr asKeyCombination - action: [ self deactivateSearch: true ]); - whenTextChangedDo: [ :aString | self selectFirst: aString ]. - - listView eventHandler - whenKeyDownDo: [ :event | self maybeActivateSearchOn: event ]; - whenFocusReceivedDo: [ :event | searchInput hide ] -] - -{ #category : 'private' } -SpEasyListViewPresenter >> deactivateSearch: acceptSelection [ - | currentSelection | - - currentSelection := listView selectedItem. - searchInput hide. - listView selectItem: (acceptSelection - ifTrue: [ currentSelection ] - ifFalse: [ lastSelectedRow ]). - listView takeKeyboardFocus + super connectPresenters ] -{ #category : 'transmission' } -SpEasyListViewPresenter >> defaultInputPort [ - - ^ self inputItemsPort +{ #category : 'api' } +SpEasyListViewPresenter >> contextMenu: aBlock [ + + self flag: #TODO. "Ignored, as this should be deprecated" + ] { #category : 'layout' } @@ -167,24 +82,12 @@ SpEasyListViewPresenter >> defaultLayout [ ^ SpOverlayLayout new child: (SpBoxLayout newVertical add: headerPanel expand: false; - add: listView; + add: contentView; yourself); addOverlay: searchInput withConstraints: [ :c | c vAlignStart; hAlignEnd ]; yourself ] -{ #category : 'transmission' } -SpEasyListViewPresenter >> defaultOutputPort [ - - ^ self outputSelectionPort -] - -{ #category : 'api' } -SpEasyListViewPresenter >> disable [ - - self enabled: false -] - { #category : 'api' } SpEasyListViewPresenter >> display [ "Answer the display block that will transform the objects from `SpAbstractListPresenter>>#model` into a @@ -231,28 +134,6 @@ SpEasyListViewPresenter >> displayValueFor: anObject [ ^ self display value: anObject ] -{ #category : 'api' } -SpEasyListViewPresenter >> enable [ - - self enabled: true -] - -{ #category : 'private' } -SpEasyListViewPresenter >> findFirst: aString [ - | items | - - items := listView items. - items isEmptyOrNil ifTrue: [ ^ 0 ]. - - (listView selection selectedIndex max: 1) to: items size do: [ :index | - (self - performSearch: (items at: index) - matching: aString) - ifTrue: [ ^ index ] ]. - - ^ 0 -] - { #category : 'testing' } SpEasyListViewPresenter >> hasHeaderTitle [ "Answer true if the list has a title (See `SpListPresenter>>#headerTitle:`)." @@ -300,126 +181,55 @@ SpEasyListViewPresenter >> iconFor: anItem [ { #category : 'initialization' } SpEasyListViewPresenter >> initialize [ - + super initialize. - self initializeTSearchable. - display := [ :object | object asString ] + display := [ :anObject | anObject asString ] ] { #category : 'initialization' } SpEasyListViewPresenter >> initializePresenters [ + super initializePresenters. + headerPanel := self newLabel. - listView := self newListView + contentView := self newListView setup: [ :aPresenter | - (aPresenter instantiate: SpEasyListRowPresenter) + (aPresenter instantiate: self rowPresenterClass) listView: self; yourself ]; bind: [ :aPresenter :anObject | aPresenter model: anObject ]; yourself. - searchInput := self newTextInput. - - headerPanel hide. - searchInput hide -] - -{ #category : 'transmission' } -SpEasyListViewPresenter >> inputItemsPort [ - - ^ (SpListItemsPort newPresenter: self) - delegateTo: [ listView ]; - yourself -] - -{ #category : 'api' } -SpEasyListViewPresenter >> items [ - - ^ listView items -] - -{ #category : 'api' } -SpEasyListViewPresenter >> items: anOrderedCollection [ - - listView items: anOrderedCollection -] - -{ #category : 'private' } -SpEasyListViewPresenter >> maybeActivateSearchOn: event [ - self isSearchEnabled ifFalse: [ ^ self ]. - "any modifier other than shift?" - (event anyModifierKeyPressed - or: [ (event keyValue between: 32 and: 127) not ]) - ifTrue: [ ^ self ]. - self activateSearchWith: event keyCharacter asString -] - -{ #category : 'api' } -SpEasyListViewPresenter >> model [ - - ^ listView model -] - -{ #category : 'transmission' } -SpEasyListViewPresenter >> outputActivationPort [ - - ^ (SpActivationPort newPresenter: self) - delegateTo: [ listView ]; - yourself -] - -{ #category : 'transmission' } -SpEasyListViewPresenter >> outputSelectionPort [ - - ^ (SpSelectionPort newPresenter: self) - delegateTo: [ listView ]; - yourself + headerPanel hide ] { #category : 'initialization' } SpEasyListViewPresenter >> registerEvents [ super registerEvents. - - self whenDisplayChangedDo: [ listView refresh ] + self whenDisplayChangedDo: [ contentView refresh ] ] { #category : 'api' } -SpEasyListViewPresenter >> removeScrollBarStyle: aStyle [ - - ^ listView removeScrollBarStyle: aStyle -] - -{ #category : 'api' } -SpEasyListViewPresenter >> scrollBarStyles [ - - ^ listView scrollBarStyles -] - -{ #category : 'private' } -SpEasyListViewPresenter >> selectFirst: aString [ - | index | - - index := self findFirst: aString. - index = 0 ifTrue: [ ^ self ]. +SpEasyListViewPresenter >> rowPresenterClass [ - listView selectIndex: index scrollToSelection: true + ^ rowPresenterClass ifNil: [ rowPresenterClass := self class defaultRowPresenterClass ] ] -{ #category : 'api - selection' } -SpEasyListViewPresenter >> selectedItem [ +{ #category : 'api' } +SpEasyListViewPresenter >> rowPresenterClass: aClass [ - ^ listView selectedItem + rowPresenterClass := aClass ] { #category : 'api' } SpEasyListViewPresenter >> updateItemsKeepingSelection: aCollection [ - listView updateItemsKeepingSelection: aCollection + contentView updateItemsKeepingSelection: aCollection ] -{ #category : 'api - events' } +{ #category : 'private' } SpEasyListViewPresenter >> whenDisplayChangedDo: aBlock [ "Inform when the display block has changed. `aBlock` has three optional arguments: @@ -430,7 +240,7 @@ SpEasyListViewPresenter >> whenDisplayChangedDo: aBlock [ self property: #display whenChangedDo: aBlock ] -{ #category : 'api - events' } +{ #category : 'private' } SpEasyListViewPresenter >> whenIconsChangedDo: aBlock [ "Inform when the icons block has changed. `aBlock` has three optional arguments: @@ -440,15 +250,3 @@ SpEasyListViewPresenter >> whenIconsChangedDo: aBlock [ self property: #displayIcon whenChangedDo: aBlock ] - -{ #category : 'api' } -SpEasyListViewPresenter >> withScrollBars [ - - listView withScrollBars -] - -{ #category : 'api' } -SpEasyListViewPresenter >> withoutScrollBars [ - - listView withoutScrollBars -] diff --git a/src/Spec2-ListView/SpEasyTreeColumnViewPresenter.class.st b/src/Spec2-ListView/SpEasyTreeColumnViewPresenter.class.st new file mode 100644 index 000000000..68b3c7f87 --- /dev/null +++ b/src/Spec2-ListView/SpEasyTreeColumnViewPresenter.class.st @@ -0,0 +1,130 @@ +Class { + #name : 'SpEasyTreeColumnViewPresenter', + #superclass : 'SpAbstractEasyTreeListViewPresenter', + #category : 'Spec2-ListView-Easy', + #package : 'Spec2-ListView', + #tag : 'Easy' +} + +{ #category : 'examples' } +SpEasyTreeColumnViewPresenter class >> example [ + + ^ self new + application: (SpApplication new useBackend: #Gtk); + addColumn: (SpCompositeTableColumn new + title: 'Classes'; + addColumn: (SpImageTableColumn new + evaluated: [ :aClass | self iconNamed: aClass systemIconName]; + width: 50); + addColumn: (SpStringTableColumn evaluated: #name); + yourself); + roots: { Object }; + children: [ :aClass | aClass subclasses ]; + open +] + +{ #category : 'api' } +SpEasyTreeColumnViewPresenter >> addColumn: aColumn [ + "Add a column to the table. A column should be an instance of `SpTableColumn`" + + contentView addColumn: aColumn asColumnViewColumn +] + +{ #category : 'api' } +SpEasyTreeColumnViewPresenter >> beNotResizable [ + "Mark the table as 'not resizable', which means there will be not possibility to resize the + columns of it." + + contentView beNotResizable +] + +{ #category : 'api' } +SpEasyTreeColumnViewPresenter >> beResizable [ + "Mark the table as 'resizable', which means there will be a slider to resize the columns." + + contentView beResizable +] + +{ #category : 'api' } +SpEasyTreeColumnViewPresenter >> columns [ + "Answer the columns composing this table." + + ^ contentView columns +] + +{ #category : 'api' } +SpEasyTreeColumnViewPresenter >> columns: aCollection [ + "Set all columns at once. + `aCollection` is a list of instances of `SpTableColumn`" + + self flag: #TODO +] + +{ #category : 'api' } +SpEasyTreeColumnViewPresenter >> contextMenu: aBlock [ + + "do nothing, this does not work on gtk4" +] + +{ #category : 'api' } +SpEasyTreeColumnViewPresenter >> hideColumnHeaders [ + "Hide the column headers" + + contentView hideColumnHeaders +] + +{ #category : 'initialization' } +SpEasyTreeColumnViewPresenter >> initializePresenters [ + + super initializePresenters. + contentView := self newTreeColumnView +] + +{ #category : 'testing' } +SpEasyTreeColumnViewPresenter >> isResizable [ + "Answer true if table allows resizing of its columns." + + ^ contentView isResizable +] + +{ #category : 'testing' } +SpEasyTreeColumnViewPresenter >> isShowingColumnHeaders [ + "Answer true if the table is configured to show column headers." + + ^ contentView isShowingColumnHeaders +] + +{ #category : 'api' } +SpEasyTreeColumnViewPresenter >> showColumnHeaders [ + "Hide the column headers" + + contentView showColumnHeaders +] + +{ #category : 'api - events' } +SpEasyTreeColumnViewPresenter >> whenColumnsChangedDo: aBlock [ + "Inform when columns have changed. + `aBlock` has three optional arguments: + - new value + - old value + - the announcement triggering this action" + + + contentView whenColumnsChangedDo: aBlock +] + +{ #category : 'api - events' } +SpEasyTreeColumnViewPresenter >> whenIsResizableChangedDo: aBlock [ + "Inform when resizable property has changed. + `aBlock` has three optional arguments: + - new value + - old value + - the announcement triggering this action" + + contentView whenIsResizableChangedDo: aBlock +] + +{ #category : 'private - deferring' } +SpEasyTreeColumnViewPresenter >> withAdapterPerformOrDefer: aFullBlockClosure [ + self shouldBeImplemented. +] diff --git a/src/Spec2-ListView/SpEasyTreeListViewPresenter.class.st b/src/Spec2-ListView/SpEasyTreeListViewPresenter.class.st new file mode 100644 index 000000000..215c826fb --- /dev/null +++ b/src/Spec2-ListView/SpEasyTreeListViewPresenter.class.st @@ -0,0 +1,200 @@ +Class { + #name : 'SpEasyTreeListViewPresenter', + #superclass : 'SpAbstractEasyTreeListViewPresenter', + #instVars : [ + '#headerPanel', + '#display => ObservableSlot', + '#displayIcon => ObservableSlot', + '#rowPresenterClass' + ], + #category : 'Spec2-ListView-Easy', + #package : 'Spec2-ListView', + #tag : 'Easy' +} + +{ #category : 'accessing' } +SpEasyTreeListViewPresenter class >> defaultRowPresenterClass [ + + ^ SpEasyListRowPresenter +] + +{ #category : 'api' } +SpEasyTreeListViewPresenter >> contextMenu: aBlock [ + + self flag: #TODO +] + +{ #category : 'layout' } +SpEasyTreeListViewPresenter >> defaultLayout [ + + ^ SpOverlayLayout new + child: (SpBoxLayout newVertical + add: headerPanel expand: false; + add: contentView; + yourself); + addOverlay: searchInput withConstraints: [ :c | c vAlignStart; hAlignEnd ]; + yourself +] + +{ #category : 'api' } +SpEasyTreeListViewPresenter >> display [ + "Answer the display block that will transform the objects from `SpAbstractListPresenter>>#model` into a + displayable string." + + ^ display +] + +{ #category : 'api' } +SpEasyTreeListViewPresenter >> display: aBlock [ + "Set the block that will be applied on each of the list items. + The result of the block will be used to display the item on the screen. + `aBlock` receives one argument. + Here is the typical example: + + initializePresenters + ... + fontFamilyList := self newTree. + fontFamilyList display: [ :fontFamily | fontFamily familyName ] + ... + " + + display := aBlock +] + +{ #category : 'api' } +SpEasyTreeListViewPresenter >> displayColor: aBlock [ + + self flag: #TODO +] + +{ #category : 'api' } +SpEasyTreeListViewPresenter >> displayIcon [ + "Return the block used to return an icon that will be displayed in the list" + + ^ displayIcon +] + +{ #category : 'api' } +SpEasyTreeListViewPresenter >> displayIcon: aBlock [ + "Set a block which takes an item as argument and returns the icon to display in the list. + `aBlock` receives one argument" + + displayIcon := aBlock +] + +{ #category : 'private' } +SpEasyTreeListViewPresenter >> displayValueFor: anObject [ + + ^ self display value: anObject +] + +{ #category : 'testing' } +SpEasyTreeListViewPresenter >> hasHeaderTitle [ + "Answer true if the list has a title (See `SpListPresenter>>#headerTitle:`)." + + ^ headerPanel isVisible +] + +{ #category : 'testing' } +SpEasyTreeListViewPresenter >> hasIcons [ + "Answer true if the list has an icon provider (See `SpListPresenter>>#icons:`)." + + ^ self displayIcon notNil +] + +{ #category : 'api' } +SpEasyTreeListViewPresenter >> headerTitle [ + "Answer the header title." + + ^ headerPanel label +] + +{ #category : 'api' } +SpEasyTreeListViewPresenter >> headerTitle: aString [ + "Set the header title." + + headerPanel label:( aString ifNil: [ '' ]). + aString isEmptyOrNil + ifTrue: [ headerPanel hide ] + ifFalse: [ headerPanel show ] +] + +{ #category : 'api' } +SpEasyTreeListViewPresenter >> hideHeaderTitle [ + + headerPanel hide +] + +{ #category : 'private' } +SpEasyTreeListViewPresenter >> iconFor: anItem [ + + ^ self displayIcon + cull: anItem + cull: self +] + +{ #category : 'initialization' } +SpEasyTreeListViewPresenter >> initialize [ + + super initialize. + display := [ :object | object asString ] +] + +{ #category : 'initialization' } +SpEasyTreeListViewPresenter >> initializePresenters [ + + super initializePresenters. + + headerPanel := self newLabel. + contentView := self newTreeListView + setup: [ :aPresenter | + (aPresenter instantiate: self rowPresenterClass) + listView: self; + yourself ]; + bind: [ :aPresenter :anObject | + aPresenter model: anObject ]; + yourself. + + headerPanel hide +] + +{ #category : 'initialization' } +SpEasyTreeListViewPresenter >> registerEvents [ + + super registerEvents. + self whenDisplayChangedDo: [ contentView refresh ] +] + +{ #category : 'api' } +SpEasyTreeListViewPresenter >> rowPresenterClass [ + + ^ rowPresenterClass ifNil: [ rowPresenterClass := self class defaultRowPresenterClass ] +] + +{ #category : 'api' } +SpEasyTreeListViewPresenter >> rowPresenterClass: aPresenterClass [ + + rowPresenterClass := aPresenterClass +] + +{ #category : 'api - events' } +SpEasyTreeListViewPresenter >> whenDisplayChangedDo: aBlock [ + "Inform when the display block has changed. + `aBlock` has three optional arguments: + - new value + - old value + - the announcement triggering this action" + + self property: #display whenChangedDo: aBlock +] + +{ #category : 'api - events' } +SpEasyTreeListViewPresenter >> whenIconsChangedDo: aBlock [ + "Inform when the icons block has changed. + `aBlock` has three optional arguments: + - new value + - old value + - the announcement triggering this action" + + self property: #displayIcon whenChangedDo: aBlock +] diff --git a/src/Spec2-ListView/SpLinkTableColumn.extension.st b/src/Spec2-ListView/SpLinkTableColumn.extension.st new file mode 100644 index 000000000..bd4d08336 --- /dev/null +++ b/src/Spec2-ListView/SpLinkTableColumn.extension.st @@ -0,0 +1,13 @@ +Extension { #name : 'SpLinkTableColumn' } + +{ #category : '*Spec2-ListView' } +SpLinkTableColumn >> fillPresenter: aPresenter with: item [ + + item ifNil: [ + aPresenter label: ''. + ^ self ]. + + aPresenter + label: (self readObject: item) asString; + action: self action +] diff --git a/src/Spec2-ListView/SpListViewPresenter.class.st b/src/Spec2-ListView/SpListViewPresenter.class.st index 77a2ed227..5823dd832 100644 --- a/src/Spec2-ListView/SpListViewPresenter.class.st +++ b/src/Spec2-ListView/SpListViewPresenter.class.st @@ -7,8 +7,9 @@ Class { '#bindAction', '#headerTitle => ObservableSlot' ], - #category : 'Spec2-ListView', - #package : 'Spec2-ListView' + #category : 'Spec2-ListView-Widget', + #package : 'Spec2-ListView', + #tag : 'Widget' } { #category : 'specs' } @@ -29,6 +30,20 @@ SpListViewPresenter class >> example [ open ] +{ #category : 'examples' } +SpListViewPresenter class >> exampleActivateOnDoubleClick [ + "This example show the simples list view you can make: A list with a label" + + self new + application: (SpApplication new useBackend: #Gtk); + isActiveOnDoubleClick; + items: self environment allClasses; + setup: [ :aPresenter | aPresenter newLabel ]; + bind: [ :aPresenter :aClass | aPresenter label: aClass name ]; + whenActivatedDo: [ 'OK' crTrace ]; + open +] + { #category : 'examples' } SpListViewPresenter class >> exampleReplaceItems [ "This example shows how to replace dynamically the list of elements." @@ -69,7 +84,7 @@ SpListViewPresenter class >> exampleWithActions [ beDisplayedAsGroup; addActionWith: [ :act | act name: 'Test 1'; - shortcut: $a ctrl; + shortcutKey: $a ctrl; action: [ 'Test 1.1' crTrace ] ]; addActionWith: [ :act | act name: 'Test 2'; @@ -78,7 +93,7 @@ SpListViewPresenter class >> exampleWithActions [ name: 'Group 2'; addActionWith: [ :act | act name: 'Test 1'; - shortcut: $y ctrl; + shortcutKey: $y ctrl; action: [ 'Test 2.1' crTrace ]; actionEnabled: [ false ] ]; addActionWith: [ :act | act @@ -86,11 +101,11 @@ SpListViewPresenter class >> exampleWithActions [ action: [ 'Test 2.2' crTrace ] ] ]; addActionWith: [ :act | act name: 'Test 3'; - shortcut: $a ctrl; + shortcutKey: $a ctrl; action: [ 'Test 3' crTrace ] ]; addActionWith: [ :act | act name: 'Test 4'; - shortcut: Character escape asKeyCombination; + shortcutKey: Character escape asKeyCombination; action: [ 'Test 4' crTrace ] ] ]; open ] @@ -122,6 +137,43 @@ SpListViewPresenter class >> exampleWithIcons [ open ] +{ #category : 'examples' } +SpListViewPresenter class >> exampleWithIconsAndMorph [ + "This example shows how to construct a list with icons. + It shows also the fact you can put any presenter inside, giving a huge power + to your lists." + + ^ self new + application: (SpApplication new useBackend: #Gtk); + items: self environment allClasses; + setup: [ :aPresenter | + | presenter morph | + (presenter := aPresenter newPresenter) + layout: (SpBoxLayout newHorizontal + spacing: 5; + add: presenter newImage expand: false; + add: presenter newLabel; + add: (presenter newMorph + morph: ((morph := SimpleButtonMorph new) + color: Color blue; + target: [ + self inform: 'Clicked: ', morph label ]; + actionSelector: #value; + yourself); + yourself); + yourself); + yourself ]; + bind: [ :aPresenter :aClass | | icon image label morph | + icon := Smalltalk ui icons iconNamed: aClass systemIconName. + image := aPresenter layout children first. + image image: icon. + label := aPresenter layout children second. + label label: aClass name. + morph := aPresenter layout children third. + morph morph label: aClass name ]; + open +] + { #category : 'examples' } SpListViewPresenter class >> exampleWithIconsAndSelectedItem [ "This example shows how to construct a list with icons. @@ -215,9 +267,7 @@ SpListViewPresenter >> headerTitle: aString [ SpListViewPresenter >> initialize [ super initialize. - self registerActions. - self initializeItemFactory. - + self initializeItemFactory ] { #category : 'initialization' } @@ -228,20 +278,10 @@ SpListViewPresenter >> initializeItemFactory [ self bind: [ :aPresenter :anObject | aPresenter label: anObject asString ] ] -{ #category : 'initialization' } -SpListViewPresenter >> registerActions [ - - self addActionWith: [ :action | action - beShortcutOnly; - shortcut: $t ctrl unix | $t ctrl win | $t command mac; - action: [ self showContextMenu ] ] -] - { #category : 'initialization' } SpListViewPresenter >> registerEvents [ super registerEvents. - self property: #headerTitle whenChangedDo: [ @@ -259,10 +299,3 @@ SpListViewPresenter >> setupAction [ ^ setupAction ] - -{ #category : 'api' } -SpListViewPresenter >> showContextMenu [ - "If the presenter is displayed, shows the associated context menu" - - self withAdapterDo: [ :anAdapter | anAdapter showContextMenu ] -] diff --git a/src/Spec2-ListView/SpTPresenterBuilder.extension.st b/src/Spec2-ListView/SpTPresenterBuilder.extension.st index fc1242dcf..39b3c10e5 100644 --- a/src/Spec2-ListView/SpTPresenterBuilder.extension.st +++ b/src/Spec2-ListView/SpTPresenterBuilder.extension.st @@ -1,19 +1,55 @@ Extension { #name : 'SpTPresenterBuilder' } +{ #category : '*Spec2-ListView' } +SpTPresenterBuilder >> newColumnView [ + + ^ self instantiate: SpColumnViewPresenter +] + { #category : '*Spec2-ListView' } SpTPresenterBuilder >> newDropDown [ ^ self instantiate: SpDropDownPresenter ] +{ #category : '*Spec2-ListView' } +SpTPresenterBuilder >> newEasyColumnView [ + + ^ self instantiate: SpEasyColumnViewPresenter +] + { #category : '*Spec2-ListView' } SpTPresenterBuilder >> newEasyListView [ ^ self instantiate: SpEasyListViewPresenter ] +{ #category : '*Spec2-ListView' } +SpTPresenterBuilder >> newEasyTreeColumnView [ + + ^ self instantiate: SpEasyTreeColumnViewPresenter +] + +{ #category : '*Spec2-ListView' } +SpTPresenterBuilder >> newEasyTreeListView [ + + ^ self instantiate: SpEasyTreeListViewPresenter +] + { #category : '*Spec2-ListView' } SpTPresenterBuilder >> newListView [ ^ self instantiate: SpListViewPresenter ] + +{ #category : '*Spec2-ListView' } +SpTPresenterBuilder >> newTreeColumnView [ + + ^ self instantiate: SpTreeColumnViewPresenter +] + +{ #category : '*Spec2-ListView' } +SpTPresenterBuilder >> newTreeListView [ + + ^ self instantiate: SpTreeListViewPresenter +] diff --git a/src/Spec2-ListView/SpTableColumn.extension.st b/src/Spec2-ListView/SpTableColumn.extension.st new file mode 100644 index 000000000..1e12dc155 --- /dev/null +++ b/src/Spec2-ListView/SpTableColumn.extension.st @@ -0,0 +1,20 @@ +Extension { #name : 'SpTableColumn' } + +{ #category : '*Spec2-ListView' } +SpTableColumn >> asColumnViewColumn [ + + ^ SpColumnViewColumn new + title: self title; + expand: (self width isNil and: [ self isExpandable ]); + width: self width; + setup: [ :aPresenter | + SpEasyColumnSetupBuilder new + presenter: aPresenter; + visit: self ]; + bind: [ :aPresenter :item | + SpEasyColumnBindBuilder new + presenter: aPresenter; + item: item; + visit: self ]; + yourself +] diff --git a/src/Spec2-ListView/SpTreeColumnViewPresenter.class.st b/src/Spec2-ListView/SpTreeColumnViewPresenter.class.st new file mode 100644 index 000000000..49090d815 --- /dev/null +++ b/src/Spec2-ListView/SpTreeColumnViewPresenter.class.st @@ -0,0 +1,242 @@ +Class { + #name : 'SpTreeColumnViewPresenter', + #superclass : 'SpAbstractTreePresenter', + #instVars : [ + '#columns => ObservableSlot', + '#isResizable => ObservableSlot', + '#showColumnHeaders => ObservableSlot' + ], + #category : 'Spec2-ListView-Widget', + #package : 'Spec2-ListView', + #tag : 'Widget' +} + +{ #category : 'specs' } +SpTreeColumnViewPresenter class >> adapterName [ + + ^ #TreeColumnViewAdapter +] + +{ #category : 'examples' } +SpTreeColumnViewPresenter class >> example [ + + ^ self new + application: (SpApplication new useBackend: #Gtk); + addColumnTitle: 'Class' + setup: [ :aPresenter | aPresenter newLabel ] + bind: [ :aPresenter :aClass | aPresenter label: aClass name ]; + addColumnTitle: 'Lines of code' + setup: [ :aPresenter | aPresenter newLabel ] + bind: [ :aPresenter :aClass | aPresenter label: aClass linesOfCode asString ]; + items: { Object }; + children: [ :aClass | aClass subclasses ]; + open +] + +{ #category : 'examples' } +SpTreeColumnViewPresenter class >> exampleActivateOnDoubleClick [ + + ^ self new + application: (SpApplication new useBackend: #Gtk); + activateOnDoubleClick; + addColumnTitle: 'Class' + setup: [ :aPresenter | aPresenter newLabel ] + bind: [ :aPresenter :aClass | aPresenter label: aClass name ]; + addColumnTitle: 'Lines of code' + setup: [ :aPresenter | aPresenter newLabel ] + bind: [ :aPresenter :aClass | aPresenter label: aClass linesOfCode asString ]; + items: { Object }; + children: [ :aClass | aClass subclasses ]; + whenActivatedDo: [ :selection | selection selectedItem crTrace ]; + open +] + +{ #category : 'examples' } +SpTreeColumnViewPresenter class >> exampleRefreshList [ + "this example just shows how the tree is refreshed when changing the model" + | presenter button tree | + + presenter := SpPresenter new. + presenter application: (SpApplication new useBackend: #Gtk). + + presenter layout: (SpBoxLayout newHorizontal + add: (button := presenter newButton); + add: (tree := presenter newTreeColumnView); + yourself). + + tree + roots: #(); + children: [ :aClass | aClass subclasses ]. + + tree + addColumnTitle: 'Class' + setup: [ :aPresenter | aPresenter newLabel ] + bind: [ :aPresenter :aClass | aPresenter label: aClass name ]; + addColumnTitle: 'Lines of code' + setup: [ :aPresenter | aPresenter newLabel ] + bind: [ :aPresenter :aClass | aPresenter label: aClass linesOfCode asString ]. + + button + label: 'Click'; + action: [ + | allClasses roots | + allClasses := Smalltalk allClasses. + roots := (1 to: 10) collect: [ :index | allClasses atRandom ]. + tree roots: roots ]. + + presenter open +] + +{ #category : 'examples' } +SpTreeColumnViewPresenter class >> exampleResizableColumns [ + + ^ self new + application: (SpApplication new useBackend: #Gtk); + beResizable; + items: { Object }; + children: [ :aClass | aClass subclasses ]; + addColumnTitle: 'Class' + setup: [ :aPresenter | aPresenter newLabel ] + bind: [ :aPresenter :aClass | aPresenter label: aClass name ]; + addColumnTitle: 'Lines of code' + setup: [ :aPresenter | aPresenter newLabel ] + bind: [ :aPresenter :aClass | aPresenter label: aClass linesOfCode asString ]; + open +] + +{ #category : 'examples' } +SpTreeColumnViewPresenter class >> exampleWithIcons [ + + ^ self new + application: (SpApplication new useBackend: #Gtk); + addColumnTitle: 'Class' + setup: [ :aPresenter | + | presenter | + (presenter := aPresenter newPresenter) + layout: (SpBoxLayout newHorizontal + spacing: 5; + add: presenter newImage expand: false; + add: presenter newLabel; + yourself); + yourself ] + bind: [ :aPresenter :aClass | | icon image label | + icon := Smalltalk ui icons iconNamed: aClass systemIconName. + image := aPresenter layout children first. + image image: icon. + label := aPresenter layout children second. + label label: aClass name ]; + addColumnTitle: 'Lines of code' + setup: [ :aPresenter | aPresenter newLabel ] + bind: [ :aPresenter :aClass | aPresenter label: aClass linesOfCode asString ]; + items: { Object }; + children: [ :aClass | aClass subclasses ]; + open +] + +{ #category : 'api' } +SpTreeColumnViewPresenter >> addColumn: aColumn [ + "Add a column to the table. A column should be an instance of `SpTableColumn`" + + columns := columns copyWith: aColumn +] + +{ #category : 'api' } +SpTreeColumnViewPresenter >> addColumnTitle: aTitle setup: setupBlock bind: bindBlock [ + + ^ self addColumn: (SpColumnViewColumn + newTitle: aTitle + setup: setupBlock + bind: bindBlock) +] + +{ #category : 'api' } +SpTreeColumnViewPresenter >> addColumns: aCollection [ + "Add a list of columns. + `aCollection` is a list of instances of `SpTableColumn`" + + aCollection do: [ :each | self addColumn: each ] +] + +{ #category : 'api' } +SpTreeColumnViewPresenter >> beNotResizable [ + + self isResizable: false +] + +{ #category : 'api' } +SpTreeColumnViewPresenter >> beResizable [ + + self isResizable: true +] + +{ #category : 'accessing' } +SpTreeColumnViewPresenter >> columns [ + ^ columns +] + +{ #category : 'api' } +SpTreeColumnViewPresenter >> hideColumnHeaders [ + "Hide the column headers" + + showColumnHeaders := false +] + +{ #category : 'initialization' } +SpTreeColumnViewPresenter >> initialize [ + + super initialize. + columns := #(). + + self beSingleSelection. + self activateOnDoubleClick. + self beResizable. + self showColumnHeaders +] + +{ #category : 'testing' } +SpTreeColumnViewPresenter >> isResizable [ + + ^ isResizable +] + +{ #category : 'private' } +SpTreeColumnViewPresenter >> isResizable: aBoolean [ + + isResizable := aBoolean +] + +{ #category : 'testing' } +SpTreeColumnViewPresenter >> isShowingColumnHeaders [ + "Answer true if the table is configured to show column headers." + + ^ showColumnHeaders +] + +{ #category : 'api' } +SpTreeColumnViewPresenter >> showColumnHeaders [ + "Show column headers" + + showColumnHeaders := true +] + +{ #category : 'api - events' } +SpTreeColumnViewPresenter >> whenColumnsChangedDo: aBlock [ + "Inform when columns have changed. + `aBlock` has three optional arguments: + - new value + - old value + - the announcement triggering this action" + + self property: #columns whenChangedDo: aBlock +] + +{ #category : 'api - events' } +SpTreeColumnViewPresenter >> whenIsResizableChangedDo: aBlock [ + "Inform when resizable property has changed. + `aBlock` has three optional arguments: + - new value + - old value + - the announcement triggering this action" + + self property: #isResizable whenChangedDo: aBlock +] diff --git a/src/Spec2-ListView/SpTreeListViewPresenter.class.st b/src/Spec2-ListView/SpTreeListViewPresenter.class.st new file mode 100644 index 000000000..a95b2044e --- /dev/null +++ b/src/Spec2-ListView/SpTreeListViewPresenter.class.st @@ -0,0 +1,265 @@ +Class { + #name : 'SpTreeListViewPresenter', + #superclass : 'SpAbstractTreePresenter', + #classTraits : 'SpTActionContainer classTrait', + #instVars : [ + '#setupAction', + '#bindAction', + '#headerTitle => ObservableSlot' + ], + #category : 'Spec2-ListView-Widget', + #package : 'Spec2-ListView', + #tag : 'Widget' +} + +{ #category : 'specs' } +SpTreeListViewPresenter class >> adapterName [ + + ^ #TreeListViewAdapter +] + +{ #category : 'examples' } +SpTreeListViewPresenter class >> example [ + "This example show the simples list view you can make: A list with a label" + + self new + application: (SpApplication new useBackend: #Gtk); + items: { Object }; + children: [ :aClass | aClass subclasses ]; + setup: [ :aPresenter | aPresenter newLabel ]; + bind: [ :aPresenter :aClass | aPresenter label: aClass name ]; + open +] + +{ #category : 'examples' } +SpTreeListViewPresenter class >> exampleActivateOnDoubleClick [ + "This example show the simples list view you can make: A list with a label" + | presenter | + + (presenter := self new) + application: (SpApplication new useBackend: #Gtk); + activateOnDoubleClick; + items: { Object }; + children: [ :aClass | aClass subclasses ]; + setup: [ :aPresenter | aPresenter newLabel ]; + bind: [ :aPresenter :aClass | aPresenter label: aClass name ]; + whenActivatedDo: [ presenter selectedItem crTrace ]; + open +] + +{ #category : 'examples' } +SpTreeListViewPresenter class >> exampleRefreshList [ + "this example just shows how the tree is refreshed when changing the model" + | presenter button tree | + + presenter := SpPresenter new. + presenter application: (SpApplication new useBackend: #Gtk). + + presenter layout: (SpBoxLayout newHorizontal + add: (button := presenter newButton); + add: (tree := presenter newTreeListView); + yourself). + + tree + roots: #(); + children: [ :aClass | aClass subclasses ]. + + button + label: 'Click'; + action: [ + | allClasses roots | + allClasses := Smalltalk allClasses. + roots := (1 to: 10) collect: [ :index | allClasses atRandom ]. + tree roots: roots ]. + + presenter open +] + +{ #category : 'examples' } +SpTreeListViewPresenter class >> exampleWithActions [ + "This example show the simples list view you can make: A list with a label" + + self new + application: (SpApplication new useBackend: #Gtk); + items: { Object }; + children: [ :aClass | aClass subclasses ]; + setup: [ :aPresenter | aPresenter newLabel ]; + bind: [ :aPresenter :aClass | aPresenter label: aClass name ]; + actionsWith: [ :rootGroup | rootGroup + addGroupWith: [ :aGroup | aGroup + name: 'Group 1'; + beDisplayedAsGroup; + addActionWith: [ :act | act + name: 'Test 1'; + shortcutKey: $a ctrl; + action: [ 'Test 1.1' crTrace ] ]; + addActionWith: [ :act | act + name: 'Test 2'; + action: [ 'Test 1.2' crTrace ] ] ]; + addGroupWith: [ :subGroup1 | subGroup1 + name: 'Group 2'; + addActionWith: [ :act | act + name: 'Test 1'; + shortcutKey: $y ctrl; + action: [ 'Test 2.1' crTrace ]; + actionEnabled: [ false ] ]; + addActionWith: [ :act | act + name: 'Test 2'; + action: [ 'Test 2.2' crTrace ] ] ]; + addActionWith: [ :act | act + name: 'Test 3'; + shortcutKey: $a ctrl; + action: [ 'Test 3' crTrace ] ]; + addActionWith: [ :act | act + name: 'Test 4'; + shortcutKey: Character escape asKeyCombination; + action: [ 'Test 4' crTrace ] ] ]; + open +] + +{ #category : 'examples' } +SpTreeListViewPresenter class >> exampleWithIcons [ + "This example shows how to construct a list with icons. + It shows also the fact you can put any presenter inside, giving a huge power + to your lists." + + ^ self new + application: (SpApplication new useBackend: #Gtk); + items: { Object }; + children: [ :aClass | aClass subclasses ]; + setup: [ :aPresenter | + | presenter | + (presenter := aPresenter newPresenter) + layout: (SpBoxLayout newHorizontal + spacing: 5; + add: presenter newImage expand: false; + add: presenter newLabel; + yourself); + yourself ]; + bind: [ :aPresenter :aClass | | icon image label | + icon := Smalltalk ui icons iconNamed: aClass systemIconName. + image := aPresenter layout children first. + image image: icon. + label := aPresenter layout children second. + label label: aClass name ]; + open +] + +{ #category : 'examples' } +SpTreeListViewPresenter class >> exampleWithIconsAndMorph [ + "This example shows how to construct a list with icons. + It shows also the fact you can put any presenter inside, giving a huge power + to your lists." + + ^ self new + application: (SpApplication new useBackend: #Gtk); + items: { Object }; + children: [ :aClass | aClass subclasses ]; + setup: [ :aPresenter | + | presenter | + (presenter := aPresenter newPresenter) + layout: (SpBoxLayout newHorizontal + spacing: 5; + add: presenter newImage expand: false; + add: presenter newLabel; + add: (presenter newMorph + morph: SimpleButtonMorph new; + yourself); + yourself); + yourself ]; + bind: [ :aPresenter :aClass | | icon image label morph | + icon := Smalltalk ui icons iconNamed: aClass systemIconName. + image := aPresenter layout children first. + image image: icon. + label := aPresenter layout children second. + label label: aClass name. + morph := aPresenter layout children third. + morph morph label: aClass name ]; + open +] + +{ #category : 'api' } +SpTreeListViewPresenter >> alternateRowsColor [ + "Will alternate Rows color for a better reading: one row lighter, the next row darker. + NOTE: Behavior in different backends may be slightly different." + + self withAdapterPerformOrDefer: [ :anAdapter | + anAdapter alternateRowsColor ] +] + +{ #category : 'api' } +SpTreeListViewPresenter >> bind: aBlock [ + + bindAction := aBlock +] + +{ #category : 'private' } +SpTreeListViewPresenter >> bindAction [ + + ^ bindAction +] + +{ #category : 'testing' } +SpTreeListViewPresenter >> hasHeaderTitle [ + "Answer true if the list has a title (See `SpListPresenter>>#headerTitle:`)." + + ^ headerTitle isEmptyOrNil not +] + +{ #category : 'api' } +SpTreeListViewPresenter >> headerTitle [ + "Answer the header title." + + ^ headerTitle +] + +{ #category : 'api' } +SpTreeListViewPresenter >> headerTitle: aString [ + "Set the header title." + + headerTitle := aString +] + +{ #category : 'initialization' } +SpTreeListViewPresenter >> initialize [ + + super initialize. + + childrenBlock := [ :item | #() ]. + + self beSingleSelection. + self activateOnDoubleClick. + + self registerActions. + self initializeItemFactory +] + +{ #category : 'initialization' } +SpTreeListViewPresenter >> initializeItemFactory [ + "Just set up the defaults (to ensure we have a working list at any moment)" + + self setup: [ :aPresenter | aPresenter newLabel ]. + self bind: [ :aPresenter :anObject | aPresenter label: anObject asString ] +] + +{ #category : 'initialization' } +SpTreeListViewPresenter >> registerEvents [ + + super registerEvents. + self + property: #headerTitle + whenChangedDo: [ + self withAdapterDo: [ :anAdapter | anAdapter refreshList ] ] +] + +{ #category : 'api' } +SpTreeListViewPresenter >> setup: aBlock [ + + setupAction := aBlock +] + +{ #category : 'private' } +SpTreeListViewPresenter >> setupAction [ + + ^ setupAction +] diff --git a/src/Spec2-Morphic-Examples/SpDropListExample.class.st b/src/Spec2-Morphic-Examples/SpDropListExample.class.st index e9f114eaa..5b758b305 100644 --- a/src/Spec2-Morphic-Examples/SpDropListExample.class.st +++ b/src/Spec2-Morphic-Examples/SpDropListExample.class.st @@ -70,6 +70,7 @@ SpDropListExample >> initializePresenters [ self containerMorph changeTableLayout; listDirection: #bottomToLeft. + uniformDropList items: { morph1. @@ -81,13 +82,24 @@ SpDropListExample >> initializePresenters [ self containerMorph removeAllMorphs; addMorph: m ]. + heterogeneousDropList - addItemLabeled: 'Option one' - do: [ ] - icon: (self iconNamed: #smallOk); - addItemLabeled: 'Inspect current morph' - do: [ self systemNavigation inspect: uniformDropList selectedItem ] - icon: (self iconNamed: #testRed). + display: [ :item | item label ]; + displayIcon: [ :item | item icon ]; + whenSelectedItemChangedDo: [ :item | item value ]; + items: { + SpDropListItem new + action: [ ]; + label: 'Option one'; + icon: (self iconNamed: #smallOk); + yourself. + SpDropListItem new + action: [ + self systemNavigation inspect: uniformDropList selectedItem ]; + label: 'Inspect current morph'; + icon: ((self iconNamed: #testRed)); + yourself. + }. "If this is uncommented, it will fire the action of the first item, which is not what we want: heterogeneousDropList setSelectedIndex: 1. diff --git a/src/Spec2-Tests/SpAbstractTextPresenterTest.class.st b/src/Spec2-Tests/SpAbstractTextPresenterTest.class.st index c02c9bc1a..370269aac 100644 --- a/src/Spec2-Tests/SpAbstractTextPresenterTest.class.st +++ b/src/Spec2-Tests/SpAbstractTextPresenterTest.class.st @@ -21,6 +21,59 @@ SpAbstractTextPresenterTest >> initializationText [ presenter text: 'Text for tests.' ] +{ #category : 'tests - actions' } +SpAbstractTextPresenterTest >> testAddAction [ + + presenter addAction: (SpAction new + name: 'test menu'; + action: [ ]; + yourself). + + self assert: presenter actions notNil. + self assert: presenter actions allCommands isNotEmpty. + self assert: (presenter actions allCommands anySatisfy: [ :each | each name = 'test menu' ]). +] + +{ #category : 'tests - actions' } +SpAbstractTextPresenterTest >> testAddActionWith [ + + presenter addActionWith: [ :action | action + name: 'test menu'; + action: [ ] ]. + + self assert: presenter actions notNil. + self assert: presenter actions allCommands isNotEmpty. + self assert: (presenter actions allCommands anySatisfy: [ :each | each name = 'test menu' ]). +] + +{ #category : 'tests - actions' } +SpAbstractTextPresenterTest >> testAddShortcut [ + + presenter addAction: (SpAction new + beShortcutOnly; + shortcutKey: $x ctrl; + action: [ ]; + yourself). + + self assert: presenter actions notNil. + self assert: presenter actions allCommands isNotEmpty. + self assert: (presenter actions allCommands anySatisfy: [ :each | + each shortcutKey = $x ctrl ]) +] + +{ #category : 'tests - actions' } +SpAbstractTextPresenterTest >> testAddShortcutWith [ + + presenter addShortcutWith: [ :action | action + shortcutKey: $x ctrl; + action: [ ] ]. + + self assert: presenter actions notNil. + self assert: presenter actions allCommands isNotEmpty. + self assert: (presenter actions allCommands anySatisfy: [ :each | + each shortcutKey = $x ctrl ]). +] + { #category : 'tests' } SpAbstractTextPresenterTest >> testClearContent [ self initializationText. diff --git a/src/Spec2-Tests/SpTextInputFieldPresenterTest.class.st b/src/Spec2-Tests/SpTextInputFieldPresenterTest.class.st index 9e6d3093c..1c619e72c 100644 --- a/src/Spec2-Tests/SpTextInputFieldPresenterTest.class.st +++ b/src/Spec2-Tests/SpTextInputFieldPresenterTest.class.st @@ -11,6 +11,12 @@ SpTextInputFieldPresenterTest >> classToTest [ ^ SpTextInputFieldPresenter ] +{ #category : 'tests' } +SpTextInputFieldPresenterTest >> testAddActionWith [ + + super testAddActionWith +] + { #category : 'tests' } SpTextInputFieldPresenterTest >> testBeNotPasswordIsSet [ diff --git a/src/Spec2-Transmission/SpTransmission.class.st b/src/Spec2-Transmission/SpTransmission.class.st index 7223a2c49..4fb0a8a3e 100644 --- a/src/Spec2-Transmission/SpTransmission.class.st +++ b/src/Spec2-Transmission/SpTransmission.class.st @@ -140,7 +140,8 @@ SpTransmission >> from: aPresenter port: aSymbol to: anotherPresenter transform: SpTransmission >> from: aPresenter port: aSymbol to: anotherPresenter transform: aValuable postTransmission: anotherValuable [ self - from: aPresenter port: aSymbol; + from: aPresenter; + fromPort: aSymbol; to: anotherPresenter; transform: aValuable; postTransmission: anotherValuable;