diff --git a/src/BaselineOfSpecCore/BaselineOfSpecCore.class.st b/src/BaselineOfSpecCore/BaselineOfSpecCore.class.st index 1e3aa1c56..fb32cd530 100644 --- a/src/BaselineOfSpecCore/BaselineOfSpecCore.class.st +++ b/src/BaselineOfSpecCore/BaselineOfSpecCore.class.st @@ -55,13 +55,15 @@ BaselineOfSpecCore >> baseline: spec [ 'Spec2-Core' 'Spec2-Dialogs' 'Spec2-CommandLine' - 'Spec2-Adapters-Stub' + 'Spec2-Adapters-Stub' + 'Spec2-Adapters-Morphic-ListView' + '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/SpMorphicListViewDataSource.class.st b/src/Spec2-Adapters-Morphic-ListView/SpMorphicListViewDataSource.class.st index ccc7a6320..c646efe77 100644 --- a/src/Spec2-Adapters-Morphic-ListView/SpMorphicListViewDataSource.class.st +++ b/src/Spec2-Adapters-Morphic-ListView/SpMorphicListViewDataSource.class.st @@ -21,13 +21,3 @@ SpMorphicListViewDataSource >> cellColumn: column row: rowIndex [ ^ cell addMorphBack: contentPresenter build ] - -{ #category : 'accessing' } -SpMorphicListViewDataSource >> headerColumn: column [ - - column id ifNil: [ ^ nil ]. - ^ FTCellMorph new - listCentering: #left; - addMorph: column id asMorph asReadOnlyMorph; - yourself -] 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..6501c9c61 100644 --- a/src/Spec2-Adapters-Morphic/SpMorphicBackend.class.st +++ b/src/Spec2-Adapters-Morphic/SpMorphicBackend.class.st @@ -33,6 +33,41 @@ SpMorphicBackend >> defer: aBlock [ UIManager default defer: aBlock ] +{ #category : 'accessing' } +SpMorphicBackend >> dropListClass [ + + ^ SpDropListPresenter +] + +{ #category : 'private - dialogs' } +SpMorphicBackend >> executeOpenDirectoryDialog: aFileDialog [ + + ^ StOpenDirectoryPresenter new + defaultFolder: (aFileDialog path ifNil: [ StFileSystemModel defaultDirectory ]); + title: (aFileDialog title ifNil: [ 'Choose Directory' translated ]); + openModal; + selectedEntry +] + +{ #category : 'private - dialogs' } +SpMorphicBackend >> executeOpenFileDialog: aFileDialog [ + | dialog | + + dialog := self newFileDialogFor: aFileDialog. + ^ dialog openModal answer + ifNotNil: [ :aString | aString asFileReference ] +] + +{ #category : 'private - dialogs' } +SpMorphicBackend >> executeSaveFileDialog: aFileDialog [ + | dialog | + + dialog := self newFileDialogFor: aFileDialog. + dialog answerSaveFile. + ^ dialog openModal answer + ifNotNil: [ :aString | aString asFileReference ] +] + { #category : 'deferred message' } SpMorphicBackend >> forceDefer: aBlock [ @@ -48,6 +83,29 @@ SpMorphicBackend >> inform: aString [ contents: aString ] +{ #category : 'accessing' } +SpMorphicBackend >> listClass [ + + ^ SpListPresenter +] + +{ #category : 'private - dialogs' } +SpMorphicBackend >> newFileDialogFor: aFileDialog [ + | dialog dialogClass | + + dialogClass := aFileDialog isOpenFile + ifTrue: [ StOpenFilePresenter ] + ifFalse: [ StOpenDirectoryPresenter ]. + dialog := dialogClass for: aFileDialog. + + aFileDialog path ifNotNil: [ :folder | dialog openFolder: folder ]. + aFileDialog filters ifNotEmpty: [ :filters | + dialog fileNavigationSystem + filter: (StCustomExtensionsFilter extensions: { filters }) ]. + + ^ dialog +] + { #category : 'private - notifying' } SpMorphicBackend >> notifyError: aSpecNotification [ @@ -67,18 +125,12 @@ SpMorphicBackend >> notifyInfo: aSpecNotification [ ] { #category : 'ui - dialogs' } -SpMorphicBackend >> selectDirectoryTitle: aString [ - - ^ UIManager default chooseDirectory: aString path: '' -] - -{ #category : 'ui - dialogs' } -SpMorphicBackend >> selectFileTitle: aString [ +SpMorphicBackend >> openFileDialog: aFileDialog [ - ^ UIManager default - chooseExistingFileReference: aString - extensions: nil - path: '' + aFileDialog isOpenFile ifTrue: [ ^ self executeOpenFileDialog: aFileDialog ]. + aFileDialog isOpenDirectory ifTrue: [ ^ self executeOpenDirectoryDialog: aFileDialog ]. + + ^ self executeSaveFileDialog: aFileDialog ] { #category : 'display' } @@ -86,3 +138,21 @@ SpMorphicBackend >> showWaitCursorWhile: aBlock inApplication: anApplication [ Cursor wait showWhile: aBlock ] + +{ #category : 'accessing' } +SpMorphicBackend >> tableClass [ + + ^ SpTablePresenter +] + +{ #category : 'accessing' } +SpMorphicBackend >> treeClass [ + + ^ SpTreePresenter +] + +{ #category : 'accessing' } +SpMorphicBackend >> treeTableClass [ + + ^ SpTreeTablePresenter +] diff --git a/src/Spec2-Adapters-Morphic/SpMorphicButtonAdapter.class.st b/src/Spec2-Adapters-Morphic/SpMorphicButtonAdapter.class.st index f74e44569..16a73b070 100644 --- a/src/Spec2-Adapters-Morphic/SpMorphicButtonAdapter.class.st +++ b/src/Spec2-Adapters-Morphic/SpMorphicButtonAdapter.class.st @@ -147,9 +147,13 @@ 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 ] 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/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/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/SpWindow.class.st b/src/Spec2-Adapters-Morphic/SpWindow.class.st index b34ed7be3..13bf97db0 100644 --- a/src/Spec2-Adapters-Morphic/SpWindow.class.st +++ b/src/Spec2-Adapters-Morphic/SpWindow.class.st @@ -80,12 +80,20 @@ 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 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-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/SpCommand.class.st b/src/Spec2-Commander2/SpCommand.class.st index acee0a9aa..528f03628 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,13 @@ SpCommand >> asButtonPresenter [ ^ self buildPresenter ] +{ #category : 'converting' } +SpCommand >> asToggleButtonPresenter [ + + self configureAsButtonOfClass: SpToggleButtonPresenter. + ^ self buildPresenter +] + { #category : 'presenter building' } SpCommand >> buildPresenter [ ^ presenter := self buildPresenterBlock value: self @@ -44,25 +59,29 @@ SpCommand >> buildPresenterBlock: anObject [ { #category : 'presenter building' } SpCommand >> configureAsButton [ + self configureAsButtonOfClass: SpButtonPresenter ] { #category : 'presenter building' } SpCommand >> configureAsButtonOfClass: aButtonClass [ - self - buildPresenterBlock: [ :specCommand | - aButtonClass new - label: specCommand name; - help: specCommand description; - in: [ :button | - specCommand hasIcon - ifTrue: [ button icon: specCommand icon ] ]; - action: [ specCommand execute ]; - yourself ] + + self buildPresenterBlock: [ :specCommand | + aButtonClass new + label: specCommand name; + help: specCommand description; + in: [ :button | + specCommand hasIcon + ifTrue: [ button icon: specCommand icon ] ]; + action: [ + specCommand canBeExecuted + ifTrue: [ specCommand execute ] ]; + yourself ] ] { #category : 'presenter building' } SpCommand >> configureAsToolBarToggleButton [ + self configureAsButtonOfClass: SpToolbarToggleButtonPresenter ] diff --git a/src/Spec2-Core/SpAbstractFormButtonPresenter.class.st b/src/Spec2-Core/SpAbstractFormButtonPresenter.class.st index 2d241a091..3a086d244 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 1bc84da2c..805cfc5ce 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) @@ -189,8 +190,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' } 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/SpAbstractTreePresenter.class.st b/src/Spec2-Core/SpAbstractTreePresenter.class.st index 6c577241f..1005d9ccf 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,8 @@ SpAbstractTreePresenter >> initialize [ super initialize. self initializeTSearchable. - self initializeTHaveWrappingScrollBars + self initializeTHaveWrappingScrollBars. + self withScrollBars ] { #category : 'testing' } @@ -411,6 +448,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 +511,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..68e3b7ece 100644 --- a/src/Spec2-Core/SpApplicationBackend.class.st +++ b/src/Spec2-Core/SpApplicationBackend.class.st @@ -49,6 +49,12 @@ SpApplicationBackend >> defaultConfigurationFor: anApplication [ ^ self subclassResponsibility ] +{ #category : 'accessing' } +SpApplicationBackend >> dropListClass [ + + self subclassResponsibility +] + { #category : 'ui - dialogs' } SpApplicationBackend >> inform: aString [ @@ -62,6 +68,13 @@ SpApplicationBackend >> initialize [ self resetAdapterBindings ] +{ #category : 'accessing' } +SpApplicationBackend >> listClass [ + + self subclassResponsibility + +] + { #category : 'accessing' } SpApplicationBackend >> name [ @@ -80,20 +93,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/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/SpDropListPresenter.class.st b/src/Spec2-Core/SpDropListPresenter.class.st index b21394d6d..ee5cc92c6 100644 --- a/src/Spec2-Core/SpDropListPresenter.class.st +++ b/src/Spec2-Core/SpDropListPresenter.class.st @@ -231,7 +231,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 +248,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 +264,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 +272,7 @@ SpDropListPresenter >> selectedIndex [ ^ self getIndex ] -{ #category : 'api' } +{ #category : 'api - selection' } SpDropListPresenter >> selectedItem [ "Answer selected item" @@ -274,7 +280,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/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/SpTPresenterBuilder.trait.st b/src/Spec2-Core/SpTPresenterBuilder.trait.st index ef41427db..0d4423013 100644 --- a/src/Spec2-Core/SpTPresenterBuilder.trait.st +++ b/src/Spec2-Core/SpTPresenterBuilder.trait.st @@ -67,6 +67,7 @@ SpTPresenterBuilder >> newButtonBar [ { #category : 'scripting - widgets' } SpTPresenterBuilder >> newCheckBox [ + ^ self instantiate: SpCheckBoxPresenter ] @@ -82,7 +83,8 @@ SpTPresenterBuilder >> newDiff [ { #category : 'scripting - widgets' } SpTPresenterBuilder >> newDropList [ - ^ self instantiate: SpDropListPresenter + + ^ self instantiate: self application backend dropListClass ] { #category : 'scripting - widgets' } @@ -124,7 +126,8 @@ SpTPresenterBuilder >> newLink [ { #category : 'scripting - widgets' } SpTPresenterBuilder >> newList [ - ^ self instantiate: SpListPresenter + + ^ self instantiate: self application backend listClass ] { #category : 'scripting - widgets' } @@ -251,10 +254,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 +315,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/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/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..a3bee84ee 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 ]. @@ -161,16 +161,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..c38ce3b20 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" 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..55ca5bb10 --- /dev/null +++ b/src/Spec2-Dialogs/SpFileDialog.class.st @@ -0,0 +1,146 @@ +" +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 >> 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/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-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..8b1a069b1 --- /dev/null +++ b/src/Spec2-ListView/SpAbstractEasyListViewPresenter.class.st @@ -0,0 +1,136 @@ +Class { + #name : 'SpAbstractEasyListViewPresenter', + #superclass : 'SpAbstractEasyPresenter', + #classTraits : 'SpTSearchable classTrait', + #category : 'Spec2-ListView', + #package : 'Spec2-ListView' +} + +{ #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 >> 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 : 'accessing' } +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 : 'accessing' } +SpAbstractEasyListViewPresenter >> selectedItems [ + + ^ contentView selectedItems +] + +{ #category : 'accessing' } +SpAbstractEasyListViewPresenter >> selection [ + + ^ contentView selection +] + +{ #category : 'api' } +SpAbstractEasyListViewPresenter >> showColumnHeaders [ + + self flag: #TODO +] + +{ #category : 'api' } +SpAbstractEasyListViewPresenter >> sortingBlock: aBlock [ + + self model sortingBlock: 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..a8ad0fea1 --- /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', + #package : 'Spec2-ListView' +} + +{ #category : 'api - actions' } +SpAbstractEasyPresenter >> actionGroup [ + + ^ contentView actionGroup +] + +{ #category : 'api - actions' } +SpAbstractEasyPresenter >> actionGroup: aSpCommandGroup [ + + contentView actionGroup: 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 - actions' } +SpAbstractEasyPresenter >> addAction: aSpCommand [ + + contentView addAction: aSpCommand +] + +{ #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 + newShortcut: Character escape asKeyCombination + action: [ self deactivateSearch: false ]); + addAction: (SpAction + newShortcut: 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 flag: #TODO. + "this is not really to be used... we have now actionGroup: :P" +] + +{ #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 : '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..c8d75ca8a --- /dev/null +++ b/src/Spec2-ListView/SpAbstractEasyTreeListViewPresenter.class.st @@ -0,0 +1,313 @@ +" +A base for tree presenters, it defines basic functionality common to all trees. +" +Class { + #name : 'SpAbstractEasyTreeListViewPresenter', + #superclass : 'SpAbstractEasyPresenter', + #classTraits : 'SpTSearchable classTrait', + #category : 'Spec2-ListView', + #package : 'Spec2-ListView' +} + +{ #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..6ab42d6ea --- /dev/null +++ b/src/Spec2-ListView/SpColumnViewColumn.class.st @@ -0,0 +1,110 @@ +Class { + #name : 'SpColumnViewColumn', + #superclass : 'Object', + #instVars : [ + 'title', + 'bind', + 'setup', + 'expand', + 'width' + ], + #category : 'Spec2-ListView', + #package : 'Spec2-ListView' +} + +{ #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..c737a6676 --- /dev/null +++ b/src/Spec2-ListView/SpColumnViewPresenter.class.st @@ -0,0 +1,205 @@ +Class { + #name : 'SpColumnViewPresenter', + #superclass : 'SpAbstractListPresenter', + #instVars : [ + '#columns => ObservableSlot', + '#isResizable => ObservableSlot', + '#showColumnHeaders => ObservableSlot' + ], + #category : 'Spec2-ListView', + #package : 'Spec2-ListView' +} + +{ #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..62fba21c7 100644 --- a/src/Spec2-ListView/SpDropDownPresenter.class.st +++ b/src/Spec2-ListView/SpDropDownPresenter.class.st @@ -156,6 +156,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 +192,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 +257,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/SpEasyColumnBindBuilder.class.st b/src/Spec2-ListView/SpEasyColumnBindBuilder.class.st new file mode 100644 index 000000000..f924a4743 --- /dev/null +++ b/src/Spec2-ListView/SpEasyColumnBindBuilder.class.st @@ -0,0 +1,61 @@ +Class { + #name : 'SpEasyColumnBindBuilder', + #superclass : 'SpEasyColumnVisitor', + #instVars : [ + 'item' + ], + #category : 'Spec2-ListView', + #package : 'Spec2-ListView' +} + +{ #category : 'accessing' } +SpEasyColumnBindBuilder >> item [ + + ^ item +] + +{ #category : 'accessing' } +SpEasyColumnBindBuilder >> item: anObject [ + + item := anObject +] + +{ #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..eb25e84de --- /dev/null +++ b/src/Spec2-ListView/SpEasyColumnSetupBuilder.class.st @@ -0,0 +1,48 @@ +" +Used to create the setup presenter for an ""easy"" column. +" +Class { + #name : 'SpEasyColumnSetupBuilder', + #superclass : 'SpEasyColumnVisitor', + #category : 'Spec2-ListView', + #package : 'Spec2-ListView' +} + +{ #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..e23929824 --- /dev/null +++ b/src/Spec2-ListView/SpEasyColumnViewPresenter.class.st @@ -0,0 +1,133 @@ +Class { + #name : 'SpEasyColumnViewPresenter', + #superclass : 'SpAbstractEasyListViewPresenter', + #category : 'Spec2-ListView', + #package : 'Spec2-ListView' +} + +{ #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..42d929a16 --- /dev/null +++ b/src/Spec2-ListView/SpEasyColumnVisitor.class.st @@ -0,0 +1,73 @@ +" +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', + #package : 'Spec2-ListView' +} + +{ #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/SpEasyListViewPresenter.class.st b/src/Spec2-ListView/SpEasyListViewPresenter.class.st index 426559dc4..9436f26eb 100644 --- a/src/Spec2-ListView/SpEasyListViewPresenter.class.st +++ b/src/Spec2-ListView/SpEasyListViewPresenter.class.st @@ -1,15 +1,10 @@ Class { #name : 'SpEasyListViewPresenter', - #superclass : 'SpPresenter', - #traits : 'SpTSearchable', - #classTraits : 'SpTSearchable classTrait', + #superclass : 'SpAbstractEasyListViewPresenter', #instVars : [ '#display => ObservableSlot', '#displayIcon => ObservableSlot', - '#searchInput', - '#listView', - '#headerPanel', - '#lastSelectedRow => WeakSlot' + '#headerPanel' ], #category : 'Spec2-ListView', #package : 'Spec2-ListView' @@ -26,7 +21,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 +61,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 +80,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 +132,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:`)." @@ -302,15 +181,16 @@ SpEasyListViewPresenter >> iconFor: anItem [ SpEasyListViewPresenter >> initialize [ super initialize. - self initializeTSearchable. display := [ :object | object asString ] ] { #category : 'initialization' } SpEasyListViewPresenter >> initializePresenters [ + super initializePresenters. + headerPanel := self newLabel. - listView := self newListView + contentView := self newListView setup: [ :aPresenter | (aPresenter instantiate: SpEasyListRowPresenter) listView: self; @@ -318,105 +198,21 @@ SpEasyListViewPresenter >> initializePresenters [ 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 ] -] - -{ #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 ]. - - listView selectIndex: index scrollToSelection: true -] - -{ #category : 'api - selection' } -SpEasyListViewPresenter >> selectedItem [ - - ^ listView selectedItem + self whenDisplayChangedDo: [ contentView refresh ] ] { #category : 'api' } SpEasyListViewPresenter >> updateItemsKeepingSelection: aCollection [ - listView updateItemsKeepingSelection: aCollection + contentView updateItemsKeepingSelection: aCollection ] { #category : 'api - events' } @@ -440,15 +236,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..cbf8940af --- /dev/null +++ b/src/Spec2-ListView/SpEasyTreeColumnViewPresenter.class.st @@ -0,0 +1,129 @@ +Class { + #name : 'SpEasyTreeColumnViewPresenter', + #superclass : 'SpAbstractEasyTreeListViewPresenter', + #category : 'Spec2-ListView', + #package : 'Spec2-ListView' +} + +{ #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..9ef98e4b0 --- /dev/null +++ b/src/Spec2-ListView/SpEasyTreeListViewPresenter.class.st @@ -0,0 +1,180 @@ +Class { + #name : 'SpEasyTreeListViewPresenter', + #superclass : 'SpAbstractEasyTreeListViewPresenter', + #instVars : [ + '#headerPanel', + '#display => ObservableSlot', + '#displayIcon => ObservableSlot' + ], + #category : 'Spec2-ListView', + #package : 'Spec2-ListView' +} + +{ #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: SpEasyListRowPresenter) + listView: self; + yourself ]; + bind: [ :aPresenter :anObject | + aPresenter model: anObject ]; + yourself. + + headerPanel hide +] + +{ #category : 'initialization' } +SpEasyTreeListViewPresenter >> registerEvents [ + + super registerEvents. + self whenDisplayChangedDo: [ contentView refresh ] +] + +{ #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..2c0ce5cc0 100644 --- a/src/Spec2-ListView/SpListViewPresenter.class.st +++ b/src/Spec2-ListView/SpListViewPresenter.class.st @@ -29,6 +29,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." @@ -122,6 +136,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. @@ -241,7 +292,6 @@ SpListViewPresenter >> registerActions [ SpListViewPresenter >> registerEvents [ super registerEvents. - self property: #headerTitle whenChangedDo: [ 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..72ed55fe7 --- /dev/null +++ b/src/Spec2-ListView/SpTreeColumnViewPresenter.class.st @@ -0,0 +1,258 @@ +Class { + #name : 'SpTreeColumnViewPresenter', + #superclass : 'SpAbstractTreePresenter', + #instVars : [ + '#columns => ObservableSlot', + '#isResizable => ObservableSlot', + '#showColumnHeaders => ObservableSlot' + ], + #category : 'Spec2-ListView', + #package : 'Spec2-ListView' +} + +{ #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. + + self registerActions +] + +{ #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 : 'initialization' } +SpTreeColumnViewPresenter >> registerActions [ + + self addActionWith: [ :action | action + beShortcutOnly; + shortcut: $t ctrl unix | $t ctrl win | $t command mac; + action: [ self showContextMenu ] ] +] + +{ #category : 'api' } +SpTreeColumnViewPresenter >> showColumnHeaders [ + "Show column headers" + + showColumnHeaders := true +] + +{ #category : 'private' } +SpTreeColumnViewPresenter >> showContextMenu [ + + self withAdapterDo: [ :anAdapter | anAdapter showContextMenu ] +] + +{ #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..36829a314 --- /dev/null +++ b/src/Spec2-ListView/SpTreeListViewPresenter.class.st @@ -0,0 +1,280 @@ +Class { + #name : 'SpTreeListViewPresenter', + #superclass : 'SpAbstractTreePresenter', + #classTraits : 'SpTActionContainer classTrait', + #instVars : [ + '#setupAction', + '#bindAction', + '#headerTitle => ObservableSlot' + ], + #category : 'Spec2-ListView', + #package : 'Spec2-ListView' +} + +{ #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'; + shortcut: $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'; + shortcut: $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'; + shortcut: $a ctrl; + action: [ 'Test 3' crTrace ] ]; + addActionWith: [ :act | act + name: 'Test 4'; + shortcut: 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 >> registerActions [ + + self addActionWith: [ :action | action + beShortcutOnly; + shortcut: $t ctrl unix | $t ctrl win | $t command mac; + action: [ self showContextMenu ] ] +] + +{ #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 +] + +{ #category : 'api' } +SpTreeListViewPresenter >> showContextMenu [ + "If the presenter is displayed, shows the associated context menu" + + self withAdapterDo: [ :anAdapter | anAdapter showContextMenu ] +] 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;