diff --git a/src/BaselineOfSpec2/BaselineOfSpec2.class.st b/src/BaselineOfSpec2/BaselineOfSpec2.class.st index d9f1742e6..36bd1f21f 100644 --- a/src/BaselineOfSpec2/BaselineOfSpec2.class.st +++ b/src/BaselineOfSpec2/BaselineOfSpec2.class.st @@ -91,7 +91,7 @@ BaselineOfSpec2 >> baseline: spec [ BaselineOfSpec2 >> commander2: spec [ spec baseline: 'Commander2' - with: [ spec repository: 'github://pharo-spec/Commander2:v1.2.0/src' ] + with: [ spec repository: 'github://pharo-spec/Commander2:v2.x.x/src' ] ] { #category : #dependencies } diff --git a/src/Spec2-Adapters-Morphic/SpAbstractMorphicAdapter.class.st b/src/Spec2-Adapters-Morphic/SpAbstractMorphicAdapter.class.st index 20ecc08ad..837fa264e 100644 --- a/src/Spec2-Adapters-Morphic/SpAbstractMorphicAdapter.class.st +++ b/src/Spec2-Adapters-Morphic/SpAbstractMorphicAdapter.class.st @@ -209,6 +209,13 @@ SpAbstractMorphicAdapter >> extent [ ^ self widget extent ] +{ #category : #'api-focus' } +SpAbstractMorphicAdapter >> gtInspectorPreviewIn: composite [ + + + self widgetDo: [ :w | w gtInspectorMorphIn: composite ] +] + { #category : #protocol } SpAbstractMorphicAdapter >> hRigid [ diff --git a/src/Spec2-Adapters-Morphic/SpComponentListFastTableDataSource.class.st b/src/Spec2-Adapters-Morphic/SpComponentListFastTableDataSource.class.st new file mode 100644 index 000000000..f88e28fae --- /dev/null +++ b/src/Spec2-Adapters-Morphic/SpComponentListFastTableDataSource.class.st @@ -0,0 +1,114 @@ +Class { + #name : #SpComponentListFastTableDataSource, + #superclass : #FTDataSource, + #instVars : [ + 'model' + ], + #category : #'Spec2-Adapters-Morphic-ComponentList' +} + +{ #category : #accessing } +SpComponentListFastTableDataSource >> cellColumn: column row: rowIndex [ + | displayValue cell item | + item := self model presenters at: rowIndex. + cell := FTCellMorph new + cellInset: 5; + yourself. + cell addMorphBack: item buildWithSpec. + ^ cell +] + +{ #category : #accessing } +SpComponentListFastTableDataSource >> elementAt: rowIndex [ + + ^ self listModel at: rowIndex +] + +{ #category : #accessing } +SpComponentListFastTableDataSource >> elements [ + + ^ self model items +] + +{ #category : #accessing } +SpComponentListFastTableDataSource >> headerColumn: column [ + column id ifNil: [ ^ nil ]. + ^ FTCellMorph new + listCentering: #center; + addMorph: column id asMorph asReadOnlyMorph; + yourself +] + +{ #category : #accessing } +SpComponentListFastTableDataSource >> listModel [ + ^ model model +] + +{ #category : #accessing } +SpComponentListFastTableDataSource >> menuColumn: column row: rowIndex [ + | menuPresenter | + + menuPresenter := self model contextMenu. + menuPresenter ifNil: [ ^ nil ]. + ^ SpBindings + value: self model application adapterBindings + during: [ + | m | + m := menuPresenter value. + m isMorph + ifTrue: [ m ] + ifFalse: [ m buildWithSpec ] ] +] + +{ #category : #accessing } +SpComponentListFastTableDataSource >> model [ + ^ model +] + +{ #category : #accessing } +SpComponentListFastTableDataSource >> model: anObject [ + model := anObject +] + +{ #category : #accessing } +SpComponentListFastTableDataSource >> newDataSourceMatching: aFTFilter [ + | newElements wrappedItem text newDataSource modelCopy | + + newElements := self elements select: [ :each | + wrappedItem := self model displayValueOf: each. + table columns anySatisfy: [ :column | + text := column transform: wrappedItem. + aFTFilter matches: text]]. + + newDataSource := self copy. + modelCopy := self model copy. + modelCopy prepareForFilteredDataSourceWith: newElements. + newDataSource model: modelCopy. + + ^newDataSource +] + +{ #category : #accessing } +SpComponentListFastTableDataSource >> numberOfRows [ + ^ model + ifNil: [ 0 ] + ifNotNil: [ model presenters size ] +] + +{ #category : #accessing } +SpComponentListFastTableDataSource >> searchText: aString [ + | search text result | + aString isEmptyOrNil ifTrue: [ ^ #() ]. + result := OrderedCollection new. + search := aString trimBoth asLowercase. + 1 to: self numberOfRows do: [ :rowIndex | + text := (self model displayValueAt: rowIndex) contents trimBoth asLowercase. + (text beginsWith: search) + ifTrue: [ result add: rowIndex ] ]. + ^ result asArray +] + +{ #category : #'drag and drop' } +SpComponentListFastTableDataSource >> transferFor: passenger from: aMorph [ + ^(self model transferFor: passenger from: self table) buildWithSpec +] diff --git a/src/Spec2-Adapters-Morphic/SpMorphicActionBarAdapter.class.st b/src/Spec2-Adapters-Morphic/SpMorphicActionBarAdapter.class.st index 0aec6eb75..e6887773c 100644 --- a/src/Spec2-Adapters-Morphic/SpMorphicActionBarAdapter.class.st +++ b/src/Spec2-Adapters-Morphic/SpMorphicActionBarAdapter.class.st @@ -36,7 +36,7 @@ SpMorphicActionBarAdapter >> buildActionButton: aButtonPresenter [ morph := aButtonPresenter buildWithSpec. aButtonPresenter adapter styleName: 'actionButton'; - applyStyle: aButtonPresenter to: morph. + applyStyle: morph. ^ morph ] diff --git a/src/Spec2-Adapters-Morphic/SpMorphicBackend.class.st b/src/Spec2-Adapters-Morphic/SpMorphicBackend.class.st index 9e59c1d48..bd6d09dff 100644 --- a/src/Spec2-Adapters-Morphic/SpMorphicBackend.class.st +++ b/src/Spec2-Adapters-Morphic/SpMorphicBackend.class.st @@ -16,6 +16,11 @@ SpMorphicBackend >> adapterBindingsClass [ ^ SpMorphicAdapterBindings ] +{ #category : #'as yet unclassified' } +SpMorphicBackend >> defer: aBlockClosure [ + UIManager default defer: aBlockClosure. +] + { #category : #'private notifying' } SpMorphicBackend >> notifyError: aSpecNotification [ GrowlMorph diff --git a/src/Spec2-Adapters-Morphic/SpMorphicComponentListAdapter.class.st b/src/Spec2-Adapters-Morphic/SpMorphicComponentListAdapter.class.st new file mode 100644 index 000000000..3569b1d9c --- /dev/null +++ b/src/Spec2-Adapters-Morphic/SpMorphicComponentListAdapter.class.st @@ -0,0 +1,38 @@ +Class { + #name : #SpMorphicComponentListAdapter, + #superclass : #SpAbstractMorphicAdapter, + #category : #'Spec2-Adapters-Morphic-ComponentList' +} + +{ #category : #factory } +SpMorphicComponentListAdapter >> buildWidget [ + + | datasource | + datasource := SpComponentListFastTableDataSource new. + datasource model: self model. + widget := FTTableMorph new + dataSource: datasource; + hideColumnHeaders; + hResizing: #spaceFill; + vResizing: #spaceFill; + setBalloonText: self help; + yourself. + self presenter whenPresentersChangedDo: [ widget refresh ]. + ^ widget +] + +{ #category : #accessing } +SpMorphicComponentListAdapter >> children [ + + ^ self rows collect: [ :row | | cell | + cell := row submorphs first. + cell submorphs first ] +] + +{ #category : #accessing } +SpMorphicComponentListAdapter >> rows [ + + | tableContainer | + tableContainer := self widget submorphs first. + ^ tableContainer submorphs +] diff --git a/src/Spec2-Adapters-Morphic/SpMorphicGridLayout.class.st b/src/Spec2-Adapters-Morphic/SpMorphicGridLayout.class.st index 75f62f17c..13f85d6b9 100644 --- a/src/Spec2-Adapters-Morphic/SpMorphicGridLayout.class.st +++ b/src/Spec2-Adapters-Morphic/SpMorphicGridLayout.class.st @@ -55,20 +55,22 @@ SpMorphicGridLayout >> calculateExtentFor: aMorph constraint: constraint computa { #category : #private } SpMorphicGridLayout >> calculateHeightFor: aMorph base: aNumber [ - self isRowHomogeneous ifTrue: [ ^ aNumber ]. + "self isRowHomogeneous ifTrue: [ ^ aNumber ]. aMorph vResizing = #spaceFill ifTrue: [ ^ aNumber ]. - ^ aMorph height + ^ aMorph height" + ^ aNumber ] { #category : #private } SpMorphicGridLayout >> calculateWidthFor: aMorph base: aNumber [ - self isColumnHomogeneous ifTrue: [ ^ aNumber ]. + "self isColumnHomogeneous ifTrue: [ ^ aNumber ]. aMorph hResizing = #spaceFill ifTrue: [ ^ aNumber ]. - ^ aMorph width + ^ aMorph width" + ^ aNumber ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } SpMorphicGridLayout >> columnConstraintsAt: aNumber [ ^ layout columnConstraintsAt: aNumber diff --git a/src/Spec2-Adapters-Morphic/SpMorphicGridLayoutComputation.class.st b/src/Spec2-Adapters-Morphic/SpMorphicGridLayoutComputation.class.st index 16d653f32..e7381a29f 100644 --- a/src/Spec2-Adapters-Morphic/SpMorphicGridLayoutComputation.class.st +++ b/src/Spec2-Adapters-Morphic/SpMorphicGridLayoutComputation.class.st @@ -79,7 +79,7 @@ SpMorphicGridLayoutComputation >> calculateHomogeneousColumnWidths [ columnWidth := 0. morphs do: [ :each | - columnWidth := columnWidth max: (self styleOf: each) width ]. + columnWidth := columnWidth max: (self minWidthOf: each) ]. ^ Array new: numColumns withAll: (self baseColumnWidth max: columnWidth) ] @@ -95,7 +95,7 @@ SpMorphicGridLayoutComputation >> calculateHomogeneousRowHeights [ rowHeight := 0. morphs do: [ :each | - rowHeight := rowHeight max: (self styleOf: each) height ]. + rowHeight := rowHeight max: (self minHeightOf: each) ]. ^ Array new: numRows withAll: (self baseRowHeight max: rowHeight) ] @@ -113,7 +113,7 @@ SpMorphicGridLayoutComputation >> calculateNotHomogeneousColumnWidths [ "Assign non expandable values" morphs do: [ :each | | column | column := (each valueOfProperty: #gridConstraints) column. - (self isColumnExpandable: column) ifTrue: [ + (self isColumnExpandable: column) ifFalse: [ newColumnWidths at: column put: ((newColumnWidths at: column) max: ((self styleOf: each) width)) ] ]. @@ -135,12 +135,11 @@ SpMorphicGridLayoutComputation >> calculateNotHomogeneousColumnWidths [ ] { #category : #'private computation' } -SpMorphicGridLayoutComputation >> calculateRowHeights [ +SpMorphicGridLayoutComputation >> calculateNotHomogeneousRowHeights [ + "column heights are + - the max height of cells of that row" | newRowHeights | - - layout isRowHomogeneous - ifTrue: [ ^ self calculateHomogeneousRowHeights ]. - + newRowHeights := Array new: numRows withAll: 0. morphs do: [ :each | | row | row := (each valueOfProperty: #gridConstraints) row. @@ -151,6 +150,14 @@ SpMorphicGridLayoutComputation >> calculateRowHeights [ ^ newRowHeights ] +{ #category : #'private computation' } +SpMorphicGridLayoutComputation >> calculateRowHeights [ + + ^ layout isRowHomogeneous + ifTrue: [ self calculateHomogeneousRowHeights ] + ifFalse: [ self calculateNotHomogeneousRowHeights ] +] + { #category : #accessing } SpMorphicGridLayoutComputation >> cellExtentAt: aPoint [ @@ -290,6 +297,18 @@ SpMorphicGridLayoutComputation >> maxWidthOf: aCollection [ ^ (aCollection collect: [ :each | (each valueOfProperty: #style) width ]) max ] +{ #category : #'private computation' } +SpMorphicGridLayoutComputation >> minHeightOf: aMorph [ + + ^ (self styleOf: aMorph) minHeight ifNil: [ 0 ] +] + +{ #category : #'private computation' } +SpMorphicGridLayoutComputation >> minWidthOf: aMorph [ + + ^ (self styleOf: aMorph) minWidth ifNil: [ 0 ] +] + { #category : #private } SpMorphicGridLayoutComputation >> numColumns [ diff --git a/src/Spec2-Adapters-Morphic/SpMorphicLinkAdapter.class.st b/src/Spec2-Adapters-Morphic/SpMorphicLinkAdapter.class.st index b69e00513..931416d2d 100644 --- a/src/Spec2-Adapters-Morphic/SpMorphicLinkAdapter.class.st +++ b/src/Spec2-Adapters-Morphic/SpMorphicLinkAdapter.class.st @@ -10,6 +10,11 @@ Class { #category : #'Spec2-Adapters-Morphic-Base' } +{ #category : #accessing } +SpMorphicLinkAdapter >> action [ + ^ self model action +] + { #category : #factory } SpMorphicLinkAdapter >> buildWidget [ "Since Pharo does not yet have a real morph for URL, I create my own. Maybe later we will have real links in Morphic?" @@ -55,12 +60,7 @@ SpMorphicLinkAdapter >> mouseLeave: anEvent from: aMorph [ { #category : #'event handling' } SpMorphicLinkAdapter >> mouseUp: anEvent from: aMorph [ aMorph color: self urlHoverColor. - WebBrowser openOn: self url -] - -{ #category : #accessing } -SpMorphicLinkAdapter >> url [ - ^ self model url + self action value ] { #category : #'accessing colors' } diff --git a/src/Spec2-Adapters-Morphic/SpMorphicMorphAdapter.class.st b/src/Spec2-Adapters-Morphic/SpMorphicMorphAdapter.class.st index 5dfbab9ea..f705bd7dd 100644 --- a/src/Spec2-Adapters-Morphic/SpMorphicMorphAdapter.class.st +++ b/src/Spec2-Adapters-Morphic/SpMorphicMorphAdapter.class.st @@ -16,8 +16,8 @@ SpMorphicMorphAdapter >> buildWidget [ self presenter whenMorphChangedDo: [ :morph | self applyStyle: morph. currentMorph owner - replaceSubmorph: currentMorph - by: morph ]. + ifNotNil: [ :ownerMorph | + ownerMorph replaceSubmorph: currentMorph by: morph ] ]. ^ currentMorph ] diff --git a/src/Spec2-Adapters-Morphic/SpMorphicTextAdapter.class.st b/src/Spec2-Adapters-Morphic/SpMorphicTextAdapter.class.st index 9f044e682..af30c26af 100644 --- a/src/Spec2-Adapters-Morphic/SpMorphicTextAdapter.class.st +++ b/src/Spec2-Adapters-Morphic/SpMorphicTextAdapter.class.st @@ -6,6 +6,9 @@ Class { #superclass : #SpAbstractMorphicAdapter, #traits : 'TViewModel', #classTraits : 'TViewModel classTrait', + #instVars : [ + 'selection' + ], #category : #'Spec2-Adapters-Morphic-Base' } @@ -136,6 +139,19 @@ SpMorphicTextAdapter >> hasUnacceptedEdits: aBoolean [ self model hasUnacceptedEdits: aBoolean ] +{ #category : #'spec protocol' } +SpMorphicTextAdapter >> insert: aString at: positionIndex [ + | text | + + text := self getText. + text := + (text copyFrom: 1 to: positionIndex), + aString, + (text copyFrom: positionIndex + 1 to: text size). + + self model text: text +] + { #category : #'spec protocol' } SpMorphicTextAdapter >> notify: errorMessage at: position in: sourceCode [ @@ -189,6 +205,20 @@ SpMorphicTextAdapter >> selectFrom: nodeStart to: nodeStop [ self widget selectFrom: nodeStart to: nodeStop ] +{ #category : #'spec protocol' } +SpMorphicTextAdapter >> selectLine [ + + self widgetDo: [ :w | + w textArea editor selectLine ] + +] + +{ #category : #accessing } +SpMorphicTextAdapter >> selection [ + + ^ selection +] + { #category : #'spec protocol' } SpMorphicTextAdapter >> selectionInterval [ ^ self widget selectionInterval @@ -219,13 +249,13 @@ SpMorphicTextAdapter >> setScrollValue: aValue [ { #category : #'widget API' } SpMorphicTextAdapter >> setSelection: interval [ - self model setSelectionInterval: interval + selection := interval ] { #category : #'spec protocol' } SpMorphicTextAdapter >> setSelectionFromModel: aSelection [ - self widget ifNotNil: [:w | w setSelection: aSelection ] + self widget ifNotNil: [ :w | w setSelection: aSelection ] ] { #category : #'widget API' } diff --git a/src/Spec2-Adapters-Morphic/SpMorphicWindowAdapter.class.st b/src/Spec2-Adapters-Morphic/SpMorphicWindowAdapter.class.st index 7614f3ab0..cb960f374 100644 --- a/src/Spec2-Adapters-Morphic/SpMorphicWindowAdapter.class.st +++ b/src/Spec2-Adapters-Morphic/SpMorphicWindowAdapter.class.st @@ -24,7 +24,10 @@ SpMorphicWindowAdapter >> aboutTitle [ { #category : #private } SpMorphicWindowAdapter >> add: containerMorph toWindow: aSpecWindow [ - aSpecWindow addMorph: containerMorph fullFrame: LayoutFrame identity + + aSpecWindow + addMorph: containerMorph + fullFrame: LayoutFrame identity ] { #category : #private } @@ -109,6 +112,11 @@ SpMorphicWindowAdapter >> buildWidget [ ^ SpWindow new model: model; isResizeable: self isResizeable; + in: [ :this | + this announcer + when: SpWindowWillClose + send: #announce: + to: self presenter announcer ]; yourself ] diff --git a/src/Spec2-Adapters-Morphic/SpStyleGeometry.class.st b/src/Spec2-Adapters-Morphic/SpStyleGeometry.class.st index cee53f3f9..cb9ea649a 100644 --- a/src/Spec2-Adapters-Morphic/SpStyleGeometry.class.st +++ b/src/Spec2-Adapters-Morphic/SpStyleGeometry.class.st @@ -107,18 +107,36 @@ SpStyleGeometry >> maxExtent: anObject [ maxExtent := anObject ] +{ #category : #private } +SpStyleGeometry >> maxExtentOrDefault [ + + ^ maxExtent ifNil: [ 0@0 ] +] + { #category : #accessing } SpStyleGeometry >> maxHeight [ ^ self maxExtent ifNotNil: [ :aPoint | aPoint y ] ] +{ #category : #accessing } +SpStyleGeometry >> maxHeight: aNumber [ + + self maxExtent: (self maxExtentOrDefault x@aNumber) +] + { #category : #accessing } SpStyleGeometry >> maxWidth [ ^ self maxExtent ifNotNil: [ :aPoint | aPoint x ] ] +{ #category : #accessing } +SpStyleGeometry >> maxWidth: aNumber [ + + self maxExtent: (aNumber @ self maxExtentOrDefault y) +] + { #category : #accessing } SpStyleGeometry >> minExtent [ ^ minExtent @@ -129,18 +147,36 @@ SpStyleGeometry >> minExtent: anObject [ minExtent := anObject ] +{ #category : #private } +SpStyleGeometry >> minExtentOrDefault [ + + ^ minExtent ifNil: [ 0@0 ] +] + { #category : #accessing } SpStyleGeometry >> minHeight [ ^ self minExtent ifNotNil: [ :aPoint | aPoint y ] ] +{ #category : #accessing } +SpStyleGeometry >> minHeight: aNumber [ + + self minExtent: (self minExtentOrDefault x@aNumber) +] + { #category : #accessing } SpStyleGeometry >> minWidth [ ^ self minExtent ifNotNil: [ :aPoint | aPoint x ] ] +{ #category : #accessing } +SpStyleGeometry >> minWidth: aNumber [ + + self minExtent: (aNumber @ self minExtentOrDefault y) +] + { #category : #private } SpStyleGeometry >> resizingStringFor: expand [ diff --git a/src/Spec2-Adapters-Morphic/SpWindow.class.st b/src/Spec2-Adapters-Morphic/SpWindow.class.st index e65456886..2747abca4 100644 --- a/src/Spec2-Adapters-Morphic/SpWindow.class.st +++ b/src/Spec2-Adapters-Morphic/SpWindow.class.st @@ -24,6 +24,18 @@ SpWindow >> allowedToClose [ ifFalse: [ true ]. ] +{ #category : #'open/close' } +SpWindow >> deleteDiscardingChanges [ + | announcement | + + announcement := SpWindowWillClose new + window: self; + yourself. + self announce: announcement. + self currentWorld announcer announce: announcement. + ^ super deleteDiscardingChanges +] + { #category : #testing } SpWindow >> hasWidget: aMorph [ diff --git a/src/Spec2-Adapters-Morphic/SpWindowWillClose.class.st b/src/Spec2-Adapters-Morphic/SpWindowWillClose.class.st new file mode 100644 index 000000000..2a495874f --- /dev/null +++ b/src/Spec2-Adapters-Morphic/SpWindowWillClose.class.st @@ -0,0 +1,5 @@ +Class { + #name : #SpWindowWillClose, + #superclass : #WindowAnnouncement, + #category : #'Spec2-Adapters-Morphic-Support' +} diff --git a/src/Spec2-Backend-Tests/SpComponentListAdapterTest.class.st b/src/Spec2-Backend-Tests/SpComponentListAdapterTest.class.st new file mode 100644 index 000000000..fcfb46504 --- /dev/null +++ b/src/Spec2-Backend-Tests/SpComponentListAdapterTest.class.st @@ -0,0 +1,29 @@ +Class { + #name : #SpComponentListAdapterTest, + #superclass : #SpAbstractWidgetAdapterTest, + #category : #'Spec2-Backend-Tests' +} + +{ #category : #accessing } +SpComponentListAdapterTest >> classToTest [ + + ^ SpComponentListPresenter +] + +{ #category : #tests } +SpComponentListAdapterTest >> testAddPresenterAddsWidget [ + + | button | + button := SpButtonPresenter new. + presenter addPresenter: button. + + backendForTest waitUntilUIRedrawed. + self assert: self adapter children first equals: button adapter widget +] + +{ #category : #tests } +SpComponentListAdapterTest >> testEmptyPresenterHasEmptyAdapter [ + + backendForTest waitUntilUIRedrawed. + self assertEmpty: self adapter children +] diff --git a/src/Spec2-Commander2-ContactBook-Extensions/SpChangePhoneCommand.class.st b/src/Spec2-Commander2-ContactBook-Extensions/SpChangePhoneCommand.class.st index 601fcca51..c16eef197 100644 --- a/src/Spec2-Commander2-ContactBook-Extensions/SpChangePhoneCommand.class.st +++ b/src/Spec2-Commander2-ContactBook-Extensions/SpChangePhoneCommand.class.st @@ -22,8 +22,8 @@ SpChangePhoneCommand >> execute [ SpChangePhoneCommand >> initialize [ super initialize. self - basicName: 'Change phone'; - basicDescription: 'Change the phone number of the contact.' + name: 'Change phone'; + description: 'Change the phone number of the contact.' ] { #category : #accessing } diff --git a/src/Spec2-Commander2-ContactBook-Extensions/SpContactBookPresenter.extension.st b/src/Spec2-Commander2-ContactBook-Extensions/SpContactBookPresenter.extension.st index d1b3601fa..2ed4e2135 100644 --- a/src/Spec2-Commander2-ContactBook-Extensions/SpContactBookPresenter.extension.st +++ b/src/Spec2-Commander2-ContactBook-Extensions/SpContactBookPresenter.extension.st @@ -11,17 +11,21 @@ SpContactBookPresenter class >> changePhoneCommandWith: presenter forRootGroup: SpContactBookPresenter class >> extraCommandsWith: presenter forRootGroup: aCmCommandsGroup [ aCmCommandsGroup / 'Context Menu' - register: ((CmCommandGroup named: 'Extra') asSpecGroup - basicDescription: 'Extra commands to help during development.'; - "Below is an example of reusing the same command for 2 different purposes." - register: ((SpInspectContactCommand forSpec context: [ presenter selectedContact ]) "Here context is computed at the moment the command is executed." - "The name and description can be adapted for its specific usage." - basicName: 'Inspect contact'; - basicDescription: 'Open an inspector on the selected contact.'; - yourself); - register: ((SpInspectContactCommand forSpec context: [ presenter contactBook ]) - basicName: 'Inspect contact book'; - basicDescription: 'Open an inspector on the contact book.'; - yourself); - yourself) + register: + ((CmCommandGroup named: 'Extra') asSpecGroup + description: 'Extra commands to help during development.'; + "Below is an example of reusing the same command for 2 different purposes." + register: + ((SpInspectContactCommand forSpec + context: [ presenter selectedContact ]) + name: 'Inspect contact'; + description: 'Open an inspector on the selected contact.'; + yourself); + register: + ((SpInspectContactCommand forSpec context: [ presenter contactBook ]) + name: 'Inspect contact book'; + description: 'Open an inspector on the contact book.'; + yourself); + yourself) "Here context is computed at the moment the command is executed." + "The name and description can be adapted for its specific usage." ] diff --git a/src/Spec2-Commander2-ContactBook-Extensions/SpInspectContactCommand.class.st b/src/Spec2-Commander2-ContactBook-Extensions/SpInspectContactCommand.class.st index edb383d34..4765919b5 100644 --- a/src/Spec2-Commander2-ContactBook-Extensions/SpInspectContactCommand.class.st +++ b/src/Spec2-Commander2-ContactBook-Extensions/SpInspectContactCommand.class.st @@ -16,6 +16,6 @@ SpInspectContactCommand >> execute [ SpInspectContactCommand >> initialize [ super initialize. self - basicName: 'Inspect'; - basicDescription: 'Inspect the context of this command.' + name: 'Inspect'; + description: 'Inspect the context of this command.' ] diff --git a/src/Spec2-Commander2-ContactBook/SpAddContactCommand.class.st b/src/Spec2-Commander2-ContactBook/SpAddContactCommand.class.st index 059b53275..cbe97fc19 100644 --- a/src/Spec2-Commander2-ContactBook/SpAddContactCommand.class.st +++ b/src/Spec2-Commander2-ContactBook/SpAddContactCommand.class.st @@ -37,6 +37,7 @@ SpAddContactCommand >> execute [ SpAddContactCommand >> initialize [ super initialize. self - basicName: 'New contact'; "This is the name of the command that will be shown to the user." - basicDescription: 'Creates a new contact and add it to the contact book.' "This is the description of the command that will be shown to the user." + name: 'New contact'; + "This is the name of the command that will be shown to the user." + description: 'Creates a new contact and add it to the contact book.' "This is the description of the command that will be shown to the user." ] diff --git a/src/Spec2-Commander2-ContactBook/SpContactBookPresenter.class.st b/src/Spec2-Commander2-ContactBook/SpContactBookPresenter.class.st index 5bebfa955..24dd87873 100644 --- a/src/Spec2-Commander2-ContactBook/SpContactBookPresenter.class.st +++ b/src/Spec2-Commander2-ContactBook/SpContactBookPresenter.class.st @@ -19,7 +19,7 @@ Class { { #category : #commands } SpContactBookPresenter class >> buildAddingGroupWith: presenterIntance [ ^ (CmCommandGroup named: 'Adding') asSpecGroup - basicDescription: 'Commands related to contact addition.'; + description: 'Commands related to contact addition.'; register: SpAddContactCommand forSpec; beDisplayedAsGroup; yourself @@ -44,7 +44,7 @@ SpContactBookPresenter class >> buildContextualMenuGroupWith: presenterIntance [ { #category : #commands } SpContactBookPresenter class >> buildEditionGroupWith: presenterIntance [ ^ (CmCommandGroup named: 'Edition') asSpecGroup - basicDescription: 'Commands related to contact edition.'; + description: 'Commands related to contact edition.'; register: SpRenameContactCommand forSpec; beDisplayedAsGroup; yourself @@ -60,7 +60,7 @@ SpContactBookPresenter class >> buildMenuBarGroupWith: presenterIntance [ { #category : #commands } SpContactBookPresenter class >> buildRemovingGroupWith: presenterIntance [ ^ (CmCommandGroup named: 'Removing') asSpecGroup - basicDescription: 'Command related to contact removal.'; + description: 'Command related to contact removal.'; register: SpRemoveContactCommand forSpec; beDisplayedAsGroup; yourself diff --git a/src/Spec2-Commander2-ContactBook/SpPrintContactBookInTranscript.class.st b/src/Spec2-Commander2-ContactBook/SpPrintContactBookInTranscript.class.st index 0a9e62f61..81ca4e150 100644 --- a/src/Spec2-Commander2-ContactBook/SpPrintContactBookInTranscript.class.st +++ b/src/Spec2-Commander2-ContactBook/SpPrintContactBookInTranscript.class.st @@ -17,6 +17,7 @@ SpPrintContactBookInTranscript >> execute [ SpPrintContactBookInTranscript >> initialize [ super initialize. self - basicName: 'Print'; "This is the name of the command that will be shown to user." - basicDescription: 'Print the contact book in Transcript.' "This is the description of the command that will be shown to user." + name: 'Print'; + "This is the name of the command that will be shown to user." + description: 'Print the contact book in Transcript.' "This is the description of the command that will be shown to user." ] diff --git a/src/Spec2-Commander2-ContactBook/SpRemoveContactCommand.class.st b/src/Spec2-Commander2-ContactBook/SpRemoveContactCommand.class.st index 6d186f3e2..eaf8977a1 100644 --- a/src/Spec2-Commander2-ContactBook/SpRemoveContactCommand.class.st +++ b/src/Spec2-Commander2-ContactBook/SpRemoveContactCommand.class.st @@ -19,7 +19,7 @@ SpRemoveContactCommand >> asSpecCommand [ ] { #category : #hooks } -SpRemoveContactCommand >> canBeRun [ +SpRemoveContactCommand >> canBeExecuted [ ^ self context isContactSelected ] @@ -33,6 +33,7 @@ SpRemoveContactCommand >> execute [ SpRemoveContactCommand >> initialize [ super initialize. self - basicName: 'Remove'; "This is the name of the command that will be shown to the user." - basicDescription: 'Removes the selected contact from the contact book.' "This is the description of the command that will be shown to the user." + name: 'Remove'; + "This is the name of the command that will be shown to the user." + description: 'Removes the selected contact from the contact book.' "This is the description of the command that will be shown to the user." ] diff --git a/src/Spec2-Commander2-ContactBook/SpRenameContactCommand.class.st b/src/Spec2-Commander2-ContactBook/SpRenameContactCommand.class.st index ee3fff905..bd6eade61 100644 --- a/src/Spec2-Commander2-ContactBook/SpRenameContactCommand.class.st +++ b/src/Spec2-Commander2-ContactBook/SpRenameContactCommand.class.st @@ -18,7 +18,7 @@ SpRenameContactCommand >> asSpecCommand [ ] { #category : #hooks } -SpRenameContactCommand >> canBeRun [ +SpRenameContactCommand >> canBeExecuted [ ^ self context isContactSelected ] @@ -32,6 +32,7 @@ SpRenameContactCommand >> execute [ SpRenameContactCommand >> initialize [ super initialize. self - basicName: 'Rename'; "This is the name of the command that will be shown to the user." - basicDescription: 'Rename the selected contact.'. "This is the description of the command that will be shown to the user." + name: 'Rename'; + "This is the name of the command that will be shown to the user." + description: 'Rename the selected contact.' "This is the description of the command that will be shown to the user." ] diff --git a/src/Spec2-Commander2/SpCommandGroup.class.st b/src/Spec2-Commander2/SpCommandGroup.class.st index 21d9e605e..8a2e033c6 100644 --- a/src/Spec2-Commander2/SpCommandGroup.class.st +++ b/src/Spec2-Commander2/SpCommandGroup.class.st @@ -27,6 +27,14 @@ SpCommandGroup class >> defaultIconName [ ^ #blank ] +{ #category : #converting } +SpCommandGroup >> asKMCategory [ + + ^ SpKMCategoryBuilder new + visit: self; + kmCategory +] + { #category : #converting } SpCommandGroup >> asMenuBarPresenter [ ^ SpMenuBarPresenterBuilder new diff --git a/src/Spec2-Commander2/SpKMCategoryBuilder.class.st b/src/Spec2-Commander2/SpKMCategoryBuilder.class.st new file mode 100644 index 000000000..faa0cd80d --- /dev/null +++ b/src/Spec2-Commander2/SpKMCategoryBuilder.class.st @@ -0,0 +1,36 @@ +Class { + #name : #SpKMCategoryBuilder, + #superclass : #CmVisitor, + #instVars : [ + 'kmCategory' + ], + #category : #'Spec2-Commander2-Visitors' +} + +{ #category : #accessing } +SpKMCategoryBuilder class >> menuPresenterClass [ + ^ SpMenuPresenter +] + +{ #category : #initialization } +SpKMCategoryBuilder >> initialize [ + + super initialize. + kmCategory := KMCategory new +] + +{ #category : #accessing } +SpKMCategoryBuilder >> kmCategory [ + + ^ kmCategory +] + +{ #category : #visiting } +SpKMCategoryBuilder >> visitCommand: aCmCommand [ + + aCmCommand hasShortcutKey ifFalse: [ ^ self ]. + + kmCategory addKeymapEntry: (KMKeymap + shortcut: aCmCommand shortcutKey + action: [ aCmCommand execute ]) +] diff --git a/src/Spec2-Commands/SpCodeBrowseItCommand.class.st b/src/Spec2-Commands/SpCodeBrowseItCommand.class.st new file mode 100644 index 000000000..6f770bdb1 --- /dev/null +++ b/src/Spec2-Commands/SpCodeBrowseItCommand.class.st @@ -0,0 +1,49 @@ +Class { + #name : #SpCodeBrowseItCommand, + #superclass : #SpCodeSelectionCommand, + #category : #'Spec2-Commands-Code' +} + +{ #category : #default } +SpCodeBrowseItCommand class >> defaultName [ + + ^ 'Browse it' +] + +{ #category : #default } +SpCodeBrowseItCommand class >> defaultShortcutKey [ + + ^ $b meta +] + +{ #category : #private } +SpCodeBrowseItCommand >> browseClass: aClass [ + + self flag: #TODO. "this is just browseIt. I'm putting this now to show the flow" + StSystemBrowser openOnClass: aClass +] + +{ #category : #execution } +SpCodeBrowseItCommand >> execute [ + "Treat the current text selection as an expression; evaluate it." + | classToBrowse | + + classToBrowse := self findClassOn: self selectionOrLine trimmed. + classToBrowse ifNil: [ ^ self ]. + + self browseClass: classToBrowse +] + +{ #category : #private } +SpCodeBrowseItCommand >> findClassOn: aString [ + | ast | + + ast := RBParser parseExpression: aString onError: [ ^ nil ]. + ast nodesDo: [ :node | + (node isVariable and: [ node name first isUppercase ]) + ifTrue: [ + (Smalltalk classNamed: node name) + ifNotNil: [ :aClass | ^ aClass ] ] ]. + + ^ nil +] diff --git a/src/Spec2-Commands/SpCodeCommand.class.st b/src/Spec2-Commands/SpCodeCommand.class.st index 8323bba37..98e1e0fa5 100644 --- a/src/Spec2-Commands/SpCodeCommand.class.st +++ b/src/Spec2-Commands/SpCodeCommand.class.st @@ -1,5 +1,33 @@ +" +I'm a base command to be used on code presenter. +My children will define actions that can be executed as part of the Pharo System. +Operations like ""do it"", ""print it"" will be implemented by extending me. +" Class { #name : #SpCodeCommand, - #superclass : #CmdCommand, + #superclass : #CmCommand, #category : #'Spec2-Commands-Code' } + +{ #category : #defaults } +SpCodeCommand class >> defaultShortcutKey [ + + ^ nil +] + +{ #category : #converting } +SpCodeCommand >> asSpecCommand [ + | command | + + command := super asSpecCommand. + self shortcutKey + ifNotNil: [ :key | command shortcutKey: key ]. + + ^ command +] + +{ #category : #accessing } +SpCodeCommand >> shortcutKey [ + + ^ self class defaultShortcutKey +] diff --git a/src/Spec2-Commands/SpCodeContext.class.st b/src/Spec2-Commands/SpCodeContext.class.st deleted file mode 100644 index 687e0c8dc..000000000 --- a/src/Spec2-Commands/SpCodeContext.class.st +++ /dev/null @@ -1,5 +0,0 @@ -Class { - #name : #SpCodeContext, - #superclass : #CmdToolContext, - #category : #'Spec2-Commands-Code' -} diff --git a/src/Spec2-Commands/SpCodeDebugItCommand.class.st b/src/Spec2-Commands/SpCodeDebugItCommand.class.st index a1d06084d..81bb08077 100644 --- a/src/Spec2-Commands/SpCodeDebugItCommand.class.st +++ b/src/Spec2-Commands/SpCodeDebugItCommand.class.st @@ -4,26 +4,16 @@ Class { #category : #'Spec2-Commands-Code' } -{ #category : #activating } -SpCodeDebugItCommand class >> contextMenuActivation [ - - - ^ CmdContextMenuActivation byRootGroupItemOrder: 40 for: SpCodeContext -] +{ #category : #default } +SpCodeDebugItCommand class >> defaultName [ -{ #category : #activating } -SpCodeDebugItCommand class >> shortcutActivation [ - - - ^ CmdShortcutActivation - by: $d shift meta - for: SpCodeContext + ^ 'Debug it' ] -{ #category : #accessing } -SpCodeDebugItCommand >> defaultMenuItemName [ +{ #category : #default } +SpCodeDebugItCommand class >> defaultShortcutKey [ - ^ 'Debug it' + ^ $d shift meta ] { #category : #execution } diff --git a/src/Spec2-Commands/SpCodeDoItCommand.class.st b/src/Spec2-Commands/SpCodeDoItCommand.class.st index 251a4175e..b8070fe6f 100644 --- a/src/Spec2-Commands/SpCodeDoItCommand.class.st +++ b/src/Spec2-Commands/SpCodeDoItCommand.class.st @@ -4,30 +4,21 @@ Class { #category : #'Spec2-Commands-Code' } -{ #category : #activating } -SpCodeDoItCommand class >> contextMenuActivation [ - - - ^ CmdContextMenuActivation byRootGroupItemOrder: 10 for: SpCodeContext -] +{ #category : #default } +SpCodeDoItCommand class >> defaultName [ -{ #category : #activating } -SpCodeDoItCommand class >> shortcutActivation [ - - - ^ CmdShortcutActivation - by: $d meta - for: SpCodeContext + ^ 'Do it' ] -{ #category : #accessing } -SpCodeDoItCommand >> defaultMenuItemName [ +{ #category : #default } +SpCodeDoItCommand class >> defaultShortcutKey [ - ^ 'Do it' + ^ $d meta ] { #category : #execution } SpCodeDoItCommand >> execute [ - - 'OK' crLog + "Treat the current text selection as an expression; evaluate it." + + self evaluateSelectionAndDo: [ :result | ] ] diff --git a/src/Spec2-Commands/SpCodeInspectItCommand.class.st b/src/Spec2-Commands/SpCodeInspectItCommand.class.st index 2e69e6712..ad751eb69 100644 --- a/src/Spec2-Commands/SpCodeInspectItCommand.class.st +++ b/src/Spec2-Commands/SpCodeInspectItCommand.class.st @@ -4,30 +4,30 @@ Class { #category : #'Spec2-Commands-Code' } -{ #category : #activating } -SpCodeInspectItCommand class >> contextMenuActivation [ - - - ^ CmdContextMenuActivation byRootGroupItemOrder: 30 for: SpCodeContext -] +{ #category : #default } +SpCodeInspectItCommand class >> defaultName [ -{ #category : #activating } -SpCodeInspectItCommand class >> shortcutActivation [ - - - ^ CmdShortcutActivation - by: $i meta - for: SpCodeContext + ^ 'Inspect it' ] -{ #category : #accessing } -SpCodeInspectItCommand >> defaultMenuItemName [ +{ #category : #default } +SpCodeInspectItCommand class >> defaultShortcutKey [ - ^ 'Inspect it' + ^ $i meta ] { #category : #execution } SpCodeInspectItCommand >> execute [ + "Treat the current text selection as an expression; evaluate it." + + self evaluateSelectionAndDo: [ :result | + self inspectObject: result ] +] + +{ #category : #execution } +SpCodeInspectItCommand >> inspectObject: anObject [ + + self flag: #TODO. "this is just result inspectIt. I'm putting this now to show the flow" + StInspector openOn: anObject - 'OK' crLog ] diff --git a/src/Spec2-Commands/SpCodePrintItCommand.class.st b/src/Spec2-Commands/SpCodePrintItCommand.class.st index 4b8cfd534..417b89822 100644 --- a/src/Spec2-Commands/SpCodePrintItCommand.class.st +++ b/src/Spec2-Commands/SpCodePrintItCommand.class.st @@ -4,30 +4,48 @@ Class { #category : #'Spec2-Commands-Code' } -{ #category : #activating } -SpCodePrintItCommand class >> contextMenuActivation [ - - - ^ CmdContextMenuActivation byRootGroupItemOrder: 10 for: SpCodeContext -] +{ #category : #default } +SpCodePrintItCommand class >> defaultName [ -{ #category : #activating } -SpCodePrintItCommand class >> shortcutActivation [ - - - ^ CmdShortcutActivation - by: $p meta - for: SpCodeContext + ^ 'Print it' ] -{ #category : #accessing } -SpCodePrintItCommand >> defaultMenuItemName [ +{ #category : #default } +SpCodePrintItCommand class >> defaultShortcutKey [ - ^ 'Print it' + ^ $p command ] { #category : #execution } SpCodePrintItCommand >> execute [ + "Treat the current text selection as an expression; evaluate it. Insert the + description of the result of evaluation after the selection and then make + this description the new text selection." + + self evaluateSelectionAndDo: [ :result | + self printObject: result ] +] + +{ #category : #private } +SpCodePrintItCommand >> printObject: anObject [ + | printString | + + printString := [ anObject printString ] + on: Error + do: [ '' ]. + self afterSelectionInsertAndSelect: (self toPrintableString: printString) +] + +{ #category : #private } +SpCodePrintItCommand >> toPrintableString: printString [ - 'OK' crLog + self flag: #TODO. "This is maybe not the best? + I think I need to add a popover, but that then means I need to + have a special way to handle this special 'insertion' (to transmit the correct insertion + to the presenter's adapter)." + ^ String streamContents: [ :stream | + stream + << ' "' + << printString + << '"' ] ] diff --git a/src/Spec2-Commands/SpCodeProfileItCommand.class.st b/src/Spec2-Commands/SpCodeProfileItCommand.class.st index 73d9d7026..08cfe10f5 100644 --- a/src/Spec2-Commands/SpCodeProfileItCommand.class.st +++ b/src/Spec2-Commands/SpCodeProfileItCommand.class.st @@ -4,15 +4,8 @@ Class { #category : #'Spec2-Commands-Code' } -{ #category : #activating } -SpCodeProfileItCommand class >> contextMenuActivation [ - - - ^ CmdContextMenuActivation byRootGroupItemOrder: 50 for: SpCodeContext -] - -{ #category : #accessing } -SpCodeProfileItCommand >> defaultMenuItemName [ +{ #category : #default } +SpCodeProfileItCommand class >> defaultName [ ^ 'Profile it' ] diff --git a/src/Spec2-Commands/SpCodeSelectionCommand.class.st b/src/Spec2-Commands/SpCodeSelectionCommand.class.st index 3b5f1691e..3b23201a6 100644 --- a/src/Spec2-Commands/SpCodeSelectionCommand.class.st +++ b/src/Spec2-Commands/SpCodeSelectionCommand.class.st @@ -1,5 +1,78 @@ +" +I'm a code presenter command who's actions depends on the selected text. +In case no text is selected, the commands will take the text from cursor position to begining of line as an ""ad hoc"" selection. + +" Class { #name : #SpCodeSelectionCommand, #superclass : #SpCodeCommand, #category : #'Spec2-Commands-Code' } + +{ #category : #private } +SpCodeSelectionCommand >> afterSelectionInsertAndSelect: aString [ + | selection | + + selection := self context selection. + self context + insert: aString + at: selection last + 1. + self context selection: (selection last + 1 to: selection last + aString size) +] + +{ #category : #private } +SpCodeSelectionCommand >> evaluate: aString andDo: aBlock [ + "Treat the current selection as an expression; evaluate it and invoke + aBlock with the result." + | stream result receiver evaluationContext | + + stream := aString readStream. + + receiver := self context doItReceiver. + evaluationContext := self context doItContext. + result := receiver class compiler + source: stream; + context: evaluationContext; + receiver: receiver; + requestor: receiver; + failBlock: [ ^ nil ]; + evaluate. + + ^ aBlock value: result +] + +{ #category : #private } +SpCodeSelectionCommand >> evaluateSelectionAndDo: aBlock [ + "Treat the current selection as an expression; evaluate it and invoke aBlock with the result. + If no selection is present select the current line." + | selection | + + selection := self selectionOrLine. + selection ifEmpty: [ ^ '' ]. + ^ self + evaluate: selection + andDo: aBlock +] + +{ #category : #accessing } +SpCodeSelectionCommand >> selectLine [ + + self context selectLine. + ^ self selection +] + +{ #category : #accessing } +SpCodeSelectionCommand >> selection [ + | selection | + + selection := context selection. + selection ifEmpty: [ ^ '' ]. + context accept. + ^ context text copyFrom: selection first to: selection last +] + +{ #category : #accessing } +SpCodeSelectionCommand >> selectionOrLine [ + + ^ self selection ifEmpty: [ self selectLine ] +] diff --git a/src/Spec2-Core/SpAbstractAdapter.class.st b/src/Spec2-Core/SpAbstractAdapter.class.st index cca8a60e5..e97918f36 100644 --- a/src/Spec2-Core/SpAbstractAdapter.class.st +++ b/src/Spec2-Core/SpAbstractAdapter.class.st @@ -48,6 +48,11 @@ SpAbstractAdapter class >> allAdapters [ ^ self subclassResponsibility ] +{ #category : #testing } +SpAbstractAdapter class >> isAbstract [ + ^ self = SpAbstractAdapter +] + { #category : #accessing } SpAbstractAdapter class >> owner: anOwner [ diff --git a/src/Spec2-Core/SpAbstractFormButtonPresenter.class.st b/src/Spec2-Core/SpAbstractFormButtonPresenter.class.st index d9d5fafed..b210ec2a7 100644 --- a/src/Spec2-Core/SpAbstractFormButtonPresenter.class.st +++ b/src/Spec2-Core/SpAbstractFormButtonPresenter.class.st @@ -27,6 +27,11 @@ Class { #category : #'Spec2-Core-Widgets' } +{ #category : #testing } +SpAbstractFormButtonPresenter class >> isAbstract [ + ^ self = SpAbstractFormButtonPresenter +] + { #category : #api } SpAbstractFormButtonPresenter >> activationAction: aBlock [ "This method is used to set the action to perform when I am activated" diff --git a/src/Spec2-Core/SpAbstractPresenter.class.st b/src/Spec2-Core/SpAbstractPresenter.class.st index 914c080e7..4df9c3cf6 100644 --- a/src/Spec2-Core/SpAbstractPresenter.class.st +++ b/src/Spec2-Core/SpAbstractPresenter.class.st @@ -41,6 +41,11 @@ SpAbstractPresenter class >> inputTextHeight [ ^ self defaultFont height + 12 ] +{ #category : #testing } +SpAbstractPresenter class >> isAbstract [ + ^ self = SpAbstractPresenter +] + { #category : #TOREMOVE } SpAbstractPresenter class >> labelHeight [ diff --git a/src/Spec2-Core/SpAbstractTextPresenter.class.st b/src/Spec2-Core/SpAbstractTextPresenter.class.st index 9160209bb..685019ffc 100644 --- a/src/Spec2-Core/SpAbstractTextPresenter.class.st +++ b/src/Spec2-Core/SpAbstractTextPresenter.class.st @@ -17,6 +17,11 @@ Class { #category : #'Spec2-Core-Widgets' } +{ #category : #testing } +SpAbstractTextPresenter class >> isAbstract [ + ^ self = SpAbstractTextPresenter +] + { #category : #api } SpAbstractTextPresenter >> accept [ "Accep the current pendingtext" @@ -69,6 +74,7 @@ SpAbstractTextPresenter >> acceptText: aString [ { #category : #private } SpAbstractTextPresenter >> actionPerformed [ + actionPerformed := self text ] @@ -103,9 +109,9 @@ SpAbstractTextPresenter >> clearContent [ { #category : #api } SpAbstractTextPresenter >> clearSelection [ - "Remove selection from the text model" + "Remove selection from the text model" - self setSelection: (0 to: 0) + self selection: (0 to: 0) ] { #category : #'undo-redo' } @@ -159,8 +165,13 @@ SpAbstractTextPresenter >> getMenu [ { #category : #api } SpAbstractTextPresenter >> getSelection [ "Get the text selection" - - ^ selection ifNil: [ ^ 1 to: 0 ] + + self + deprecated: 'Use #selection instead.' + transformWith: '`@receiver getSelection' + -> '`@receiver selection'. + + ^ self selection ] { #category : #api } @@ -211,6 +222,15 @@ SpAbstractTextPresenter >> initialize [ self registerEvents ] +{ #category : #api } +SpAbstractTextPresenter >> insert: aString at: positionIndex [ + "inserts aString into the text string. + positionIndex indicates the position index (as in #indexOf) the insertion." + + self withAdapterDo: [ :anAdapter | + anAdapter insert: aString at: positionIndex ] +] + { #category : #api } SpAbstractTextPresenter >> isForSmalltalkCode [ @@ -249,6 +269,11 @@ SpAbstractTextPresenter >> placeholder: aText [ placeholder := aText ] +{ #category : #private } +SpAbstractTextPresenter >> rawSelection: anInterval [ + self property: #selection rawValue: anInterval +] + { #category : #api } SpAbstractTextPresenter >> readSelection [ ^ self readSelectionBlock cull: self text cull: self @@ -285,6 +310,14 @@ SpAbstractTextPresenter >> selectAll [ self changed: #selectAll with: #() ] +{ #category : #api } +SpAbstractTextPresenter >> selectLine [ + + self withAdapterDo: [ :anAdapter | + anAdapter selectLine ]. + ^ self selection +] + { #category : #NOCompletion } SpAbstractTextPresenter >> selectedClassOrMetaClass [ @@ -292,15 +325,31 @@ SpAbstractTextPresenter >> selectedClassOrMetaClass [ ] { #category : #api } -SpAbstractTextPresenter >> setSelection: anInterval [ +SpAbstractTextPresenter >> selection [ + "Get the text selection. + I will update the selection from adapter first" + self withAdapterDo: [ :anAdapter | + self rawSelection: anAdapter selection ]. + ^ selection ifNil: [ ^ 1 to: 0 ] +] + +{ #category : #api } +SpAbstractTextPresenter >> selection: anInterval [ "Set the text selection without changing the readSelectionBlock" selection := anInterval ] { #category : #api } -SpAbstractTextPresenter >> setSelectionInterval: anInterval [ - self property: #selection rawValue: anInterval +SpAbstractTextPresenter >> setSelection: anInterval [ + "Set the text selection without changing the readSelectionBlock" + + self + deprecated: 'Use #selection: instead.' + transformWith: '`@receiver setSelection: `@statement' + -> '`@receiver selection: `@statement'. + + self selection: anInterval ] { #category : #api } @@ -317,6 +366,8 @@ SpAbstractTextPresenter >> text: aText [ { #category : #private } SpAbstractTextPresenter >> textArea [ + + self flag: #REMOVEME. ^ self adapter widget ] diff --git a/src/Spec2-Core/SpAbstractWidgetPresenter.class.st b/src/Spec2-Core/SpAbstractWidgetPresenter.class.st index ec4876c93..7d35b7b3f 100644 --- a/src/Spec2-Core/SpAbstractWidgetPresenter.class.st +++ b/src/Spec2-Core/SpAbstractWidgetPresenter.class.st @@ -55,6 +55,11 @@ SpAbstractWidgetPresenter class >> defaultSpec [ ^ SpAbstractWidgetLayout for: self adapterName ] +{ #category : #testing } +SpAbstractWidgetPresenter class >> isAbstract [ + ^ self = SpAbstractWidgetPresenter +] + { #category : #'drag and drop' } SpAbstractWidgetPresenter >> acceptDropBlock [ ^ acceptDropBlock diff --git a/src/Spec2-Core/SpApplication.class.st b/src/Spec2-Core/SpApplication.class.st index c050a644d..dc00b77f7 100644 --- a/src/Spec2-Core/SpApplication.class.st +++ b/src/Spec2-Core/SpApplication.class.st @@ -48,6 +48,11 @@ SpApplication >> close [ self windows copy do: #close ] +{ #category : #'as yet unclassified' } +SpApplication >> defer: aBlockClosure [ + self backend defer: aBlockClosure. +] + { #category : #windows } SpApplication >> hasWindow: aWindow [ diff --git a/src/Spec2-Core/SpCodePresenter.class.st b/src/Spec2-Core/SpCodePresenter.class.st index e9dbb2327..2f3518109 100644 --- a/src/Spec2-Core/SpCodePresenter.class.st +++ b/src/Spec2-Core/SpCodePresenter.class.st @@ -55,17 +55,42 @@ SpCodePresenter >> behavior: aClass [ { #category : #private } SpCodePresenter >> buildCodeKeyBindings [ - ^ CmdContextMenuActivation buildContextKeyBindingsInContext: (SpCodeContext for: self) + ^ self codeCommandGroup asKMCategory ] { #category : #private } SpCodePresenter >> buildCodeMenu [ - ^ (CmdContextMenuActivation buildMenuInContext: (SpCodeContext for: self)) asSpMenuPresenter + + ^ self codeCommandGroup asMenuPresenter +] + +{ #category : #private } +SpCodePresenter >> codeCommandGroup [ + | group | + + group := CmCommandGroup forSpec + beDisplayedAsGroup; + yourself. + + self flag: #TODO. "This needs to be discoverable (otherwise is not extensible) + ot at least, we need to add a plug for extensions" + { + SpCodeDoItCommand. + SpCodePrintItCommand. + SpCodeInspectItCommand. + SpCodeDebugItCommand. + SpCodeProfileItCommand. + SpCodeBrowseItCommand. + } do: [ :eachClass | + group register: (eachClass forSpecContext: self) ]. + + ^ group ] { #category : #'api-shortcuts' } SpCodePresenter >> contextKeyBindings [ + "contextKeyBindings stores a KMCategory with keybindings for this presenter" ^ contextKeyBindings ] diff --git a/src/Spec2-Core/SpComponentListPresenter.class.st b/src/Spec2-Core/SpComponentListPresenter.class.st index 269fe1d7a..77f2d5aca 100644 --- a/src/Spec2-Core/SpComponentListPresenter.class.st +++ b/src/Spec2-Core/SpComponentListPresenter.class.st @@ -5,7 +5,8 @@ Class { #name : #SpComponentListPresenter, #superclass : #SpAbstractWidgetPresenter, #instVars : [ - '#presenters => SpObservableSlot' + '#presenters => SpObservableSlot', + '#presentersChangedBlock' ], #category : #'Spec2-Core-Widgets' } @@ -23,6 +24,11 @@ SpComponentListPresenter >> addPresenter: aPresenter [ self notifyPropertyChanged: #presenters ] +{ #category : #testing } +SpComponentListPresenter >> includes: aPresenter [ + ^ presenters includes: aPresenter +] + { #category : #initialization } SpComponentListPresenter >> initialize [ @@ -30,6 +36,11 @@ SpComponentListPresenter >> initialize [ presenters := OrderedCollection new ] +{ #category : #testing } +SpComponentListPresenter >> isEmpty [ + ^ presenters isEmpty +] + { #category : #accessor } SpComponentListPresenter >> presenters [ ^ presenters @@ -41,3 +52,9 @@ SpComponentListPresenter >> presenters: aCollection [ aCollection do: [ :each | each owner: self ]. presenters := aCollection ] + +{ #category : #event } +SpComponentListPresenter >> whenPresentersChangedDo: aBlockClosure [ + + self property: #presenters whenChangedDo: aBlockClosure +] diff --git a/src/Spec2-Core/SpEditableList.class.st b/src/Spec2-Core/SpEditableList.class.st index 78392a250..c4fb67954 100644 --- a/src/Spec2-Core/SpEditableList.class.st +++ b/src/Spec2-Core/SpEditableList.class.st @@ -30,25 +30,29 @@ Class { { #category : #spec } SpEditableList class >> defaultSpec [ - ^ SpLayout composed - newColumn: - [ :column | - column - newRow: [ :menuRow | - menuRow - add: #addButton; - add: #removeButton ] - height: 25; - newRow: [ :listRow | - listRow - newColumn: [ :c1 | c1 add: #list ]; - newColumn: [ :c2 | - c2 - add: #topButton; - add: #upButton; - add: #downButton; - add: #bottomButton ] - width: 24 ] ] + ^ SpBoxLayout newVertical + add: + (SpBoxLayout newHorizontal + add: #addButton; + add: #removeButton; + yourself) + expand: false + fill: false + padding: 0; + add: + (SpBoxLayout newHorizontal + add: #list; + add: + (SpBoxLayout newVertical + add: #topButton; + add: #upButton; + add: #downButton; + add: #bottomButton; + yourself) + expand: false + fill: false + padding: 0; + yourself); yourself ] diff --git a/src/Spec2-Core/SpLabelledContainer.class.st b/src/Spec2-Core/SpLabelledContainer.class.st index 3834d3945..5cc0b4a09 100644 --- a/src/Spec2-Core/SpLabelledContainer.class.st +++ b/src/Spec2-Core/SpLabelledContainer.class.st @@ -27,44 +27,48 @@ SpLabelledContainer class >> defaultSpec [ { #category : #specs } SpLabelledContainer class >> labelBottom [ - ^ SpLayout composed - newColumn: [ :column | - column - add: #subwidget origin: 0 @ 0 corner: 1 @ 0.9; - add: #label origin: 0 @ 0.9 corner: 1 @ 1 ]; + ^ SpBoxLayout newVertical + add: #subwidget; + add: #label + expand: false + fill: false + padding: 0; yourself ] { #category : #specs } SpLabelledContainer class >> labelLeft [ - ^ SpLayout composed - newRow: [ :row | - row - add: #label origin: 0 @ 0 corner: 0.2 @ 1; - add: #subwidget origin: 0.2 @ 0 corner: 1 @ 1 ]; + ^ SpBoxLayout newHorizontal + add: #label + expand: false + fill: false + padding: 0; + add: #subwidget; yourself ] { #category : #specs } SpLabelledContainer class >> labelRight [ - ^ SpLayout composed - newRow: [ :row | - row - add: #subwidget origin: 0 @ 0 corner: 0.8 @ 1; - add: #label origin: 0.8 @ 0 corner: 1 @ 1 ]; + ^ SpBoxLayout newHorizontal + add: #subwidget; + add: #label + expand: false + fill: false + padding: 0; yourself ] { #category : #specs } SpLabelledContainer class >> labelTop [ - ^ SpLayout composed - newColumn: [ :column | - column - add: #label origin: 0 @ 0 corner: 1 @ 0.1; - add: #subwidget origin: 0 @ 0.1 corner: 1 @ 1 ]; + ^ SpBoxLayout newVertical + add: #label + expand: false + fill: false + padding: 0; + add: #subwidget; yourself ] diff --git a/src/Spec2-Core/SpLinkPresenter.class.st b/src/Spec2-Core/SpLinkPresenter.class.st index 62d5f5a88..99ca97242 100644 --- a/src/Spec2-Core/SpLinkPresenter.class.st +++ b/src/Spec2-Core/SpLinkPresenter.class.st @@ -34,7 +34,7 @@ Class { #superclass : #SpAbstractWidgetPresenter, #instVars : [ '#label => SpObservableSlot', - '#url => SpObservableSlot' + '#action => SpObservableSlot' ], #category : #'Spec2-Core-Widgets' } @@ -44,6 +44,16 @@ SpLinkPresenter class >> adapterName [ ^ #LinkAdapter ] +{ #category : #api } +SpLinkPresenter >> action [ + ^ action +] + +{ #category : #api } +SpLinkPresenter >> action: aBlock [ + action := aBlock +] + { #category : #initialization } SpLinkPresenter >> defaultColor [ ^ nil @@ -58,7 +68,7 @@ SpLinkPresenter >> initialize [ { #category : #api } SpLinkPresenter >> label [ - ^ label ifNil: [ self url ] + ^ label ] { #category : #api } @@ -67,13 +77,14 @@ SpLinkPresenter >> label: aString [ ] { #category : #api } -SpLinkPresenter >> url [ - ^ url +SpLinkPresenter >> url: aString [ + self action: [ WebBrowser openOn: aString ]. + self label ifNil: [ self label: aString ] ] -{ #category : #api } -SpLinkPresenter >> url: aString [ - url := aString +{ #category : #enumerating } +SpLinkPresenter >> whenActionChangedDo: aBlock [ + self property: #action whenChangedDo: aBlock ] { #category : #enumerating } diff --git a/src/Spec2-Core/SpPresenter.class.st b/src/Spec2-Core/SpPresenter.class.st index dd7162573..bb88d09ce 100644 --- a/src/Spec2-Core/SpPresenter.class.st +++ b/src/Spec2-Core/SpPresenter.class.st @@ -120,6 +120,11 @@ SpPresenter class >> iconWidth [ ^ 24 ] +{ #category : #testing } +SpPresenter class >> isAbstract [ + ^ self = SpPresenter +] + { #category : #'labelled-presenters' } SpPresenter class >> labelWidth [ ^ 100 @@ -370,6 +375,11 @@ SpPresenter >> defaultWindowPresenterClass [ ^ SpWindowPresenter ] +{ #category : #'as yet unclassified' } +SpPresenter >> defer: aBlockClosure [ + self application defer: aBlockClosure +] + { #category : #private } SpPresenter >> delete [ @@ -476,6 +486,23 @@ SpPresenter >> giveFocusToPreviousFrom: aModel [ true ] ] +{ #category : #'api-focus' } +SpPresenter >> gtInspectorPreviewIn: composite [ + + self adapter ifNotNil: [ :w | w gtInspectorPreviewIn: composite ] +] + +{ #category : #'api-focus' } +SpPresenter >> gtInspectorSubPresentersIn: composite [ + + composite tree + title: 'Sub presenters'; + rootsExpanded; + display: [ :each | {each} ]; + children: [ :each | each presenters ]; + when: [ :each | each presenters isNotEmpty ] +] + { #category : #'private-focus' } SpPresenter >> handlesKeyboard: evt [ @@ -801,6 +828,12 @@ SpPresenter >> newSlider [ ^ self instantiate: SpSliderPresenter ] +{ #category : #widgets } +SpPresenter >> newStatusBar [ + + ^ self instantiate: SpStatusBarPresenter +] + { #category : #widgets } SpPresenter >> newTable [ diff --git a/src/Spec2-Core/SpWindowPresenter.class.st b/src/Spec2-Core/SpWindowPresenter.class.st index eb3b71966..45d468cd1 100644 --- a/src/Spec2-Core/SpWindowPresenter.class.st +++ b/src/Spec2-Core/SpWindowPresenter.class.st @@ -438,12 +438,26 @@ SpWindowPresenter >> updateTitle [ { #category : #'api-events' } SpWindowPresenter >> whenClosedDo: aBlock [ - self property: #isClosed whenChangedDo: [ :value | value ifTrue: [ aBlock value ] ] + + self + property: #isClosed + whenChangedDo: [ :value | value ifTrue: [ aBlock value ] ] ] { #category : #'api-events' } SpWindowPresenter >> whenOpenedDo: aBlock [ - self property: #isClosed whenChangedDo: [ :value | value ifFalse: [ aBlock value ] ] + + self + property: #isClosed + whenChangedDo: [ :value | value ifFalse: [ aBlock value ] ] +] + +{ #category : #'api-events' } +SpWindowPresenter >> whenWillCloseDo: aBlock [ + + self announcer + when: SpWindowWillClose + do: aBlock ] { #category : #accessing } diff --git a/src/Spec2-Core/SpInputTextDropList.class.st b/src/Spec2-Deprecated/SpInputTextDropList.class.st similarity index 85% rename from src/Spec2-Core/SpInputTextDropList.class.st rename to src/Spec2-Deprecated/SpInputTextDropList.class.st index ab54796fd..edbbfe179 100644 --- a/src/Spec2-Core/SpInputTextDropList.class.st +++ b/src/Spec2-Deprecated/SpInputTextDropList.class.st @@ -12,7 +12,7 @@ Class { 'dropList', 'input' ], - #category : #'Spec2-Core-Widgets' + #category : #'Spec2-Deprecated' } { #category : #specs } @@ -26,6 +26,13 @@ SpInputTextDropList class >> defaultSpec [ yourself ] +{ #category : #testing } +SpInputTextDropList class >> isDeprecated [ + "This presenter does not add enough value to Spec to be kept in it. If you are using it, please copy the code in your own application." + + ^ true +] + { #category : #'api-shortcuts' } SpInputTextDropList >> acceptOnCR: aBoolean [ self input acceptOnCR: aBoolean @@ -73,6 +80,12 @@ SpInputTextDropList >> entryCompletion: anEntryCompletion [ self input entryCompletion: anEntryCompletion ] +{ #category : #'as yet unclassified' } +SpInputTextDropList >> ghostText: aText [ + self deprecated: 'This API is too tight to Morph. Use #placeholder: instead.' transformWith: '`@receiver ghostText: `@statement' -> '`@receiver placeholder: `@statement'. + self placeholder: aText +] + { #category : #initialization } SpInputTextDropList >> initializeWidgets [ input := self instantiate: SpTextInputFieldPresenter. diff --git a/src/Spec2-Deprecated/SpInputTextDropList.extension.st b/src/Spec2-Deprecated/SpInputTextDropList.extension.st deleted file mode 100644 index 32661d496..000000000 --- a/src/Spec2-Deprecated/SpInputTextDropList.extension.st +++ /dev/null @@ -1,7 +0,0 @@ -Extension { #name : #SpInputTextDropList } - -{ #category : #'*Spec2-Deprecated' } -SpInputTextDropList >> ghostText: aText [ - self deprecated: 'This API is too tight to Morph. Use #placeholder: instead.' transformWith: '`@receiver ghostText: `@statement' -> '`@receiver placeholder: `@statement'. - self placeholder: aText -] diff --git a/src/Spec2-Tests/SpInputTextDropListTest.class.st b/src/Spec2-Deprecated/SpInputTextDropListTest.class.st similarity index 80% rename from src/Spec2-Tests/SpInputTextDropListTest.class.st rename to src/Spec2-Deprecated/SpInputTextDropListTest.class.st index 4271ef75c..1766582a3 100644 --- a/src/Spec2-Tests/SpInputTextDropListTest.class.st +++ b/src/Spec2-Deprecated/SpInputTextDropListTest.class.st @@ -1,7 +1,7 @@ Class { #name : #SpInputTextDropListTest, #superclass : #SpSmokeTest, - #category : #'Spec2-Tests-Core-Widgets' + #category : #'Spec2-Deprecated' } { #category : #running } diff --git a/src/Spec2-Deprecated/SpMorphicGenericAdapter.class.st b/src/Spec2-Deprecated/SpMorphicGenericAdapter.class.st index 69772d14b..ab0277b0c 100644 --- a/src/Spec2-Deprecated/SpMorphicGenericAdapter.class.st +++ b/src/Spec2-Deprecated/SpMorphicGenericAdapter.class.st @@ -6,7 +6,7 @@ Be aware that when you use this, you broke Spec plateform independency and force Class { #name : #SpMorphicGenericAdapter, #superclass : #SpAbstractMorphicAdapter, - #category : #'Spec2-Deprecated' + #category : #'Spec2-Deprecated-Adapters' } { #category : #deprecation } diff --git a/src/Spec2-Examples/SpDemoLinksPresenter.class.st b/src/Spec2-Examples/SpDemoLinksPresenter.class.st index bf42d35a6..a97b31881 100644 --- a/src/Spec2-Examples/SpDemoLinksPresenter.class.st +++ b/src/Spec2-Examples/SpDemoLinksPresenter.class.st @@ -10,7 +10,8 @@ Class { #instVars : [ 'link1', 'link2', - 'link3' + 'link3', + 'link4' ], #category : #'Spec2-Examples-Demo-Other' } @@ -21,6 +22,7 @@ SpDemoLinksPresenter class >> defaultSpec [ add: #link1; add: #link2; add: #link3; + add: #link4; yourself ] @@ -35,6 +37,7 @@ SpDemoLinksPresenter >> initializeWidgets [ link1 := self newLink. link2 := self newLink. link3 := self newLink. + link4 := self newLink. link1 url: 'https://pharo.org'. @@ -45,20 +48,9 @@ SpDemoLinksPresenter >> initializeWidgets [ link3 url: 'https://pharo.org'; label: 'Pharo website'; - color: Color purple -] - -{ #category : #accessing } -SpDemoLinksPresenter >> link1 [ - ^ link1 -] - -{ #category : #accessing } -SpDemoLinksPresenter >> link2 [ - ^ link2 -] + color: Color purple. -{ #category : #accessing } -SpDemoLinksPresenter >> link3 [ - ^ link3 + link4 + action: [ Object browse ]; + label: 'Browse Object' ] diff --git a/src/Spec2-Examples/SpDemoStandaloneFormPresenter.class.st b/src/Spec2-Examples/SpDemoStandaloneFormPresenter.class.st index b658d6b29..6e8f7a58b 100644 --- a/src/Spec2-Examples/SpDemoStandaloneFormPresenter.class.st +++ b/src/Spec2-Examples/SpDemoStandaloneFormPresenter.class.st @@ -36,9 +36,41 @@ Class { { #category : #specs } SpDemoStandaloneFormPresenter class >> defaultSpec [ - - - + "SpBoxLayout newVertical + add: + (SpGridLayout new + add: 'Name:' at: 1 @ 1; + add: #nameTextInput at: 2 @ 1; + add: 'Surname:' at: 1 @ 2; + add: #surnameTextInput at: 2 @ 2; + add: 'Number 1:' at: 1 @ 3; + add: #number1Input at: 2 @ 3; + add: 'Number 2:' at: 1 @ 4; + add: #number2Input at: 2 @ 4; + add: 'Scale:' at: 1 @ 5; + add: #scaleInput at: 2 @ 5; + add: 'Password:' at: 1 @ 6; + add: #passwordInput at: 2 @ 6; + add: 'Remember me:' at: 1 @ 7; + add: #checkboxInput at: 2 @ 7; + add: 'Date:' at: 1 @ 8; + add: #dateInput at: 2 @ 8; + add: 'Gender:' at: 1 @ 9; + add: + (SpBoxLayout newHorizontal + add: #maleButton; + add: #femaleButton; + yourself) + at: 2 @ 9; + add: 'Items:' at: 1 @ 10; + add: #itemsInput at: 2 @ 10; + yourself); + add: + (SpBoxLayout newHorizontal + add: #submitButton; + add: #restoreButton; + yourself); + yourself" | fontWidth labelsWidth rowHeight checkboxWidth | fontWidth := (StandardFonts defaultFont widthOfString: 'M'). labelsWidth := fontWidth * 8. diff --git a/src/Spec2-Examples/SpDemoTextInputPresenter.class.st b/src/Spec2-Examples/SpDemoTextInputPresenter.class.st index 8fecf46e1..1af0e5e81 100644 --- a/src/Spec2-Examples/SpDemoTextInputPresenter.class.st +++ b/src/Spec2-Examples/SpDemoTextInputPresenter.class.st @@ -5,14 +5,10 @@ Class { #name : #SpDemoTextInputPresenter, #superclass : #SpPresenter, #instVars : [ - 'labelNormal', 'fieldNormal', - 'labelDisabled', 'fieldDisabled', - 'labelEncrypted', 'fieldEncrypted', - 'fieldPlaceholderText', - 'labelPlaceholderText' + 'fieldPlaceholderText' ], #category : #'Spec2-Examples-Demo-TextInput' } @@ -21,13 +17,13 @@ Class { SpDemoTextInputPresenter class >> defaultSpec [ ^ SpGridLayout new beColumnNotHomogeneous; - add: #labelNormal at: 1 @ 1; + add: 'Normal:' at: 1 @ 1; add: #fieldNormal at: 2 @ 1; - add: #labelDisabled at: 1 @ 2; + add: 'Disabled:' at: 1 @ 2; add: #fieldDisabled at: 2 @ 2; - add: #labelPlaceholderText at: 1 @ 3; + add: 'Placeholder:' at: 1 @ 3; add: #fieldPlaceholderText at: 2 @ 3; - add: #labelEncrypted at: 1 @ 4; + add: 'Password:' at: 1 @ 4; add: #fieldEncrypted at: 2 @ 4; yourself ] @@ -74,57 +70,13 @@ SpDemoTextInputPresenter >> fieldPlaceholderText: anObject [ { #category : #initialization } SpDemoTextInputPresenter >> initializeWidgets [ - labelNormal := self newLabel label: 'Normal:'. fieldNormal := self newTextInput. - labelDisabled := self newLabel label: 'Disabled:'. fieldDisabled := self newTextInput enabled: false. - labelPlaceholderText := self newLabel label: 'Placeholder:'. fieldPlaceholderText := self newTextInput placeholder: 'Placeholder text'. - labelEncrypted := self newLabel label: 'Password:'. fieldEncrypted := self newTextInput text: 'Password'; bePassword ] - -{ #category : #accessing } -SpDemoTextInputPresenter >> labelDisabled [ - ^ labelDisabled -] - -{ #category : #accessing } -SpDemoTextInputPresenter >> labelDisabled: anObject [ - labelDisabled := anObject -] - -{ #category : #accessing } -SpDemoTextInputPresenter >> labelEncrypted [ - ^ labelEncrypted -] - -{ #category : #accessing } -SpDemoTextInputPresenter >> labelEncrypted: anObject [ - labelEncrypted := anObject -] - -{ #category : #accessing } -SpDemoTextInputPresenter >> labelNormal [ - ^ labelNormal -] - -{ #category : #accessing } -SpDemoTextInputPresenter >> labelNormal: anObject [ - labelNormal := anObject -] - -{ #category : #accessing } -SpDemoTextInputPresenter >> labelPlaceholderText [ - ^ labelPlaceholderText -] - -{ #category : #accessing } -SpDemoTextInputPresenter >> labelPlaceholderText: anObject [ - labelPlaceholderText := anObject -] diff --git a/src/Spec2-Examples/SpDemoTreeTablePresenter.class.st b/src/Spec2-Examples/SpDemoTreeTablePresenter.class.st index 353c0b6a3..a357f4edf 100644 --- a/src/Spec2-Examples/SpDemoTreeTablePresenter.class.st +++ b/src/Spec2-Examples/SpDemoTreeTablePresenter.class.st @@ -15,10 +15,12 @@ Class { { #category : #specs } SpDemoTreeTablePresenter class >> defaultSpec [ - ^ SpBoxLayout newVertical add: #table1; - add: 'Double click to browse.' height: self labelHeight; + add: 'Double click to browse.' + expand: false + fill: false + padding: 0; yourself ] diff --git a/src/Spec2-Examples/SpEditableList.extension.st b/src/Spec2-Examples/SpEditableList.extension.st index 69d67c101..edfeb7094 100644 --- a/src/Spec2-Examples/SpEditableList.extension.st +++ b/src/Spec2-Examples/SpEditableList.extension.st @@ -3,9 +3,13 @@ Extension { #name : #SpEditableList } { #category : #'*Spec2-Examples' } SpEditableList class >> example [ - ^self new - - title: 'Selectors list'; + | presenter | + presenter := self new list: self selectors; - openWithSpec + openWithSpec; + yourself. + + presenter withWindowDo: [ :w | w title: 'Selectors list' ]. + + ^ presenter ] diff --git a/src/Spec2-Examples/SpInputTextDropList.extension.st b/src/Spec2-Examples/SpInputTextDropList.extension.st index 389dab347..fae4afd4a 100644 --- a/src/Spec2-Examples/SpInputTextDropList.extension.st +++ b/src/Spec2-Examples/SpInputTextDropList.extension.st @@ -1,7 +1,7 @@ Extension { #name : #SpInputTextDropList } { #category : #'*Spec2-Examples' } -SpInputTextDropList class >> example [ +SpInputTextDropList classSide >> example [ | example | example := self new diff --git a/src/Spec2-Morphic-Backend-Tests/SpMorphicGridLayoutTest.class.st b/src/Spec2-Morphic-Backend-Tests/SpMorphicGridLayoutTest.class.st index d42310ad8..9addc5c84 100644 --- a/src/Spec2-Morphic-Backend-Tests/SpMorphicGridLayoutTest.class.st +++ b/src/Spec2-Morphic-Backend-Tests/SpMorphicGridLayoutTest.class.st @@ -76,6 +76,17 @@ SpMorphicGridLayoutTest >> styleExtent: aPoint [ ^ SpMorphStyle newStyles: rootStyle flattenClasses ] +{ #category : #private } +SpMorphicGridLayoutTest >> styleMinExtent: aPoint [ + | rootStyle | + + rootStyle := (SpStyleSTONReader fromString: (' +.application [ Geometry \{ #minWidth: {1}, #minHeight: {2} \} ]' + format: { aPoint x. aPoint y })). + + ^ SpMorphStyle newStyles: rootStyle flattenClasses +] + { #category : #tests } SpMorphicGridLayoutTest >> testBasicLayout [ " @@ -102,15 +113,47 @@ SpMorphicGridLayoutTest >> testBasicLayout [ ] { #category : #tests } -SpMorphicGridLayoutTest >> testBorderWidth [ +SpMorphicGridLayoutTest >> testBorderWidthHomogeneous [ " - --------------- + +---+----+----+---+ + | 5 | 5 | 5 | 5 | + +---+----+----+---+ + | 5 | 45 | 45 | 5 | + +---+----+----+---+ + | 5 | 45 | 45 | 5 | + +---+----+----+---+ + | 5 | 5 | 5 | 5 | + +---+----+----+---+ + " + | layout | + + self place: label1 at: 1@1. + self place: morph1 at: 2@1. + self place: label2 at: 1@2. + self place: morph2 at: 2@2. + + (layout := self newLayout) layout + beColumnHomogeneous; + beRowHomogeneous; + borderWidth: 5. + layout layout: panel in: (0@0 corner: 100@100). + + self assert: label1 bounds equals: (5@5 corner: 50@50). + self assert: morph1 bounds equals: (50@5 corner: 95@50). + self assert: label2 bounds equals: (5@50 corner: 50@95). + self assert: morph2 bounds equals: (50@50 corner: 95@95) +] + +{ #category : #tests } +SpMorphicGridLayoutTest >> testBorderWidthNotHomogeneous [ + " + +---+----+----+ | 5 | 5 | 5 | - --------------- - | 5 | 50 | 50 | - --------------- + +---+----+----+ | 5 | 50 | 50 | - --------------- + +---+----+----+ + | 5 | 50 | 50 | + +---+----+----+ " | layout | @@ -119,7 +162,10 @@ SpMorphicGridLayoutTest >> testBorderWidth [ self place: label2 at: 1@2. self place: morph2 at: 2@2. - (layout := self newLayout) layout borderWidth: 5. + (layout := self newLayout) layout + beRowNotHomogeneous; + beColumnNotHomogeneous; + borderWidth: 5. layout layout: panel in: (0@0 corner: 100@100). self assert: label1 bounds equals: (5@5 corner: 55@25). @@ -150,9 +196,9 @@ SpMorphicGridLayoutTest >> testColumnHomogeneousDiferentRowsAndColumns [ self place: morph2 at: 4@4. layout := self newLayout. - layout layout columnHomogeneous: true. - "make one column width to 100 (it should force all columns to 100, instead 50)" - (self styleExtent: 100@20) applyTo: label2. + layout layout beColumnHomogeneous. + "make one column width to 100 (it should force all columns to 100, instead 25)" + (self styleMinExtent: 100@20) applyTo: label2. layout layout: panel in: (0@0 corner: 100@100). @@ -185,12 +231,12 @@ SpMorphicGridLayoutTest >> testColumnNotHomogeneousDiferentRowsAndColumns [ self place: morph2 at: 4@4. layout := self newLayout. - layout layout columnHomogeneous: false. + layout layout beColumnNotHomogeneous. "make columns differ, to make each column different" - label1 width: 30. - morph1 width: 40. - label2 width: 50. - morph2 width: 60. + (self styleExtent: 30@20) applyTo: label1. + (self styleExtent: 40@20) applyTo: morph1. + (self styleExtent: 50@20) applyTo: label2. + (self styleExtent: 60@20) applyTo: morph2. layout layout: panel in: (0@0 corner: 100@100). @@ -203,7 +249,7 @@ SpMorphicGridLayoutTest >> testColumnNotHomogeneousDiferentRowsAndColumns [ { #category : #tests } SpMorphicGridLayoutTest >> testColumnNotHomogeneousPairedRowsAndColumns [ - "Paired elements in a rows and columns + "Paired elements in rows and columns ----------- | 50 | 60 | @@ -220,19 +266,19 @@ SpMorphicGridLayoutTest >> testColumnNotHomogeneousPairedRowsAndColumns [ self place: morph2 at: 2@2. layout := self newLayout. - layout layout columnHomogeneous: false. + layout layout beColumnNotHomogeneous. "make columns differ, to make each column different" - label1 width: 30. - morph1 width: 40. - label2 width: 50. - morph2 width: 60. + (self styleExtent: 30@20) applyTo: label1. + (self styleExtent: 50@20) applyTo: morph1. + (self styleExtent: 40@20) applyTo: label2. + (self styleExtent: 60@20) applyTo: morph2. layout layout: panel in: (0@0 corner: 100@100). - self assert: label1 bounds equals: (0@0 corner: 50@20). - self assert: morph1 bounds equals: (50@0 corner: 110@20). - self assert: label2 bounds equals: (0@20 corner: 50@40). - self assert: morph2 bounds equals: (50@20 corner: 110@40) + self assert: label1 bounds equals: (0@0 corner: 40@20). + self assert: morph1 bounds equals: (40@0 corner: 100@20). + self assert: label2 bounds equals: (0@20 corner: 40@40). + self assert: morph2 bounds equals: (40@20 corner: 100@40) ] diff --git a/src/Spec2-Tests/SpAbstractTextPresenterTest.class.st b/src/Spec2-Tests/SpAbstractTextPresenterTest.class.st index 4656c9902..9afbce7fb 100644 --- a/src/Spec2-Tests/SpAbstractTextPresenterTest.class.st +++ b/src/Spec2-Tests/SpAbstractTextPresenterTest.class.st @@ -36,10 +36,10 @@ SpAbstractTextPresenterTest >> testClearContent [ SpAbstractTextPresenterTest >> testClearSelection [ self initializationText. self openInstance. - presenter setSelection: (1 to: 10). - self assert: presenter getSelection equals: (1 to: 10). + presenter selection: (1 to: 10). + self assert: presenter selection equals: (1 to: 10). presenter clearSelection. - self assert: presenter getSelection isEmpty + self assert: presenter selection isEmpty ] { #category : #tests } @@ -69,5 +69,5 @@ SpAbstractTextPresenterTest >> testSelectAll [ self initializationText. self openInstance. presenter selectAll. - self assert: presenter getSelection equals: (1 to: 15) + self assert: presenter selection equals: (1 to: 15) ] diff --git a/src/Spec2-Tests/SpCodeBrowseItCommandTest.class.st b/src/Spec2-Tests/SpCodeBrowseItCommandTest.class.st new file mode 100644 index 000000000..6d6466aca --- /dev/null +++ b/src/Spec2-Tests/SpCodeBrowseItCommandTest.class.st @@ -0,0 +1,28 @@ +Class { + #name : #SpCodeBrowseItCommandTest, + #superclass : #SpCodeCommandTest, + #category : #'Spec2-Tests-Commands' +} + +{ #category : #accessing } +SpCodeBrowseItCommandTest >> commandClass [ + + ^ SpCodeBrowseItCommand +] + +{ #category : #tests } +SpCodeBrowseItCommandTest >> testFindClassOn [ + | command | + + command := self commandToTest. + + self assert: (command findClassOn: '') equals: nil. + self assert: (command findClassOn: 'Object') equals: Object. + self assert: (command findClassOn: 'Object.') equals: Object. + self assert: (command findClassOn: '.Object.') equals: Object. + self assert: (command findClassOn: 'somethingBefore := 42.Object') equals: Object. + self + assert: (command findClassOn: 'somethingBefore := 42.Object. somethingAfter := 11') + equals: Object. + self assert: (command findClassOn: 'NonExistingClass.Object.') equals: Object. +] diff --git a/src/Spec2-Tests/SpCodeCommandContextMock.class.st b/src/Spec2-Tests/SpCodeCommandContextMock.class.st new file mode 100644 index 000000000..58d0f8610 --- /dev/null +++ b/src/Spec2-Tests/SpCodeCommandContextMock.class.st @@ -0,0 +1,20 @@ +Class { + #name : #SpCodeCommandContextMock, + #superclass : #Object, + #instVars : [ + 'selection' + ], + #category : #'Spec2-Tests-Commands' +} + +{ #category : #accessing } +SpCodeCommandContextMock >> selection [ + + ^ selection +] + +{ #category : #accessing } +SpCodeCommandContextMock >> selection: anObject [ + + selection := anObject +] diff --git a/src/Spec2-Tests/SpCodeCommandTest.class.st b/src/Spec2-Tests/SpCodeCommandTest.class.st new file mode 100644 index 000000000..4ce9bff9b --- /dev/null +++ b/src/Spec2-Tests/SpCodeCommandTest.class.st @@ -0,0 +1,43 @@ +Class { + #name : #SpCodeCommandTest, + #superclass : #TestCase, + #category : #'Spec2-Tests-Commands' +} + +{ #category : #testing } +SpCodeCommandTest class >> isAbstract [ + + ^ self = SpCodeCommandTest +] + +{ #category : #testing } +SpCodeCommandTest class >> shouldInheritSelectors [ + + ^ true +] + +{ #category : #accessing } +SpCodeCommandTest >> commandClass [ + + ^ self subclassResponsibility +] + +{ #category : #accessing } +SpCodeCommandTest >> commandToTest [ + + ^ self commandClass new + context: self newMockContext; + yourself +] + +{ #category : #private } +SpCodeCommandTest >> newMockContext [ + + ^ SpCodeCommandContextMock new +] + +{ #category : #tests } +SpCodeCommandTest >> testExecute [ + + self flag: #TODO. "How to intercept messages to prevent execution?" +] diff --git a/src/Spec2-Tests/SpCodePresenterTest.class.st b/src/Spec2-Tests/SpCodePresenterTest.class.st index db12bf70f..125e7a127 100644 --- a/src/Spec2-Tests/SpCodePresenterTest.class.st +++ b/src/Spec2-Tests/SpCodePresenterTest.class.st @@ -12,8 +12,12 @@ SpCodePresenterTest >> classToTest [ { #category : #tests } SpCodePresenterTest >> testContextKeyBindings [ - - self assert: presenter contextKeyBindings notNil + | contextKeyBindings | + + contextKeyBindings := presenter contextKeyBindings. + self assert: contextKeyBindings notNil. + self assert: (contextKeyBindings isKindOf: KMCategory). + ] { #category : #tests } diff --git a/src/Spec2-Tests/SpComponentListPresenterTest.class.st b/src/Spec2-Tests/SpComponentListPresenterTest.class.st new file mode 100644 index 000000000..5e9a09754 --- /dev/null +++ b/src/Spec2-Tests/SpComponentListPresenterTest.class.st @@ -0,0 +1,63 @@ +Class { + #name : #SpComponentListPresenterTest, + #superclass : #SpTest, + #category : #'Spec2-Tests-Core-Widgets' +} + +{ #category : #running } +SpComponentListPresenterTest >> classToTest [ + ^ SpComponentListPresenter +] + +{ #category : #tests } +SpComponentListPresenterTest >> testAddNoPresenterToComponentListDoesNotRaiseEvent [ + | raised | + raised := false. + presenter whenPresentersChangedDo: [ raised := true ]. + + + self deny: raised +] + +{ #category : #tests } +SpComponentListPresenterTest >> testAddPresenterToComponentListIsInPresenterCollection [ + | button | + button := SpButtonPresenter new. + presenter addPresenter: button. + self assert: (presenter includes: button) +] + +{ #category : #tests } +SpComponentListPresenterTest >> testAddPresenterToComponentListRaisesEvent [ + | button raised | + raised := false. + button := SpButtonPresenter new. + presenter whenPresentersChangedDo: [ raised := true ]. + + presenter addPresenter: button. + + self assert: raised +] + +{ #category : #tests } +SpComponentListPresenterTest >> testAddPresenterToComponentListRaisesSingleEvent [ + | button raised | + raised := 0. + button := SpButtonPresenter new. + presenter whenPresentersChangedDo: [ raised := raised + 1 ]. + + presenter addPresenter: button. + + self assert: raised equals: 1 +] + +{ #category : #tests } +SpComponentListPresenterTest >> testAddPresenterToComponentListShouldNotBeEmpty [ + presenter addPresenter: SpButtonPresenter new. + self deny: presenter isEmpty +] + +{ #category : #tests } +SpComponentListPresenterTest >> testNewComponentListIsEmpty [ + self assertEmpty: presenter +] diff --git a/src/Spec2-Tests/SpLinkPresenterTest.class.st b/src/Spec2-Tests/SpLinkPresenterTest.class.st index d00a1db6e..f60530493 100644 --- a/src/Spec2-Tests/SpLinkPresenterTest.class.st +++ b/src/Spec2-Tests/SpLinkPresenterTest.class.st @@ -12,37 +12,35 @@ SpLinkPresenterTest >> classToTest [ { #category : #tests } SpLinkPresenterTest >> testLabelIsUrlByDefault [ self assert: presenter label isNil. - self assert: presenter url isNil. presenter url: 'Test'. - self assert: presenter url equals: 'Test'. self assert: presenter label equals: 'Test'. presenter label: 'Label'. - self assert: presenter url equals: 'Test'. self assert: presenter label equals: 'Label' ] { #category : #tests } -SpLinkPresenterTest >> testWhenLabelChangedDo [ +SpLinkPresenterTest >> testWhenActionChangedDo [ | count result | count := 0. presenter - whenLabelChangedDo: [ :label | + whenActionChangedDo: [ :block | count := count + 1. - result := label ]. - presenter label: 'Test'. - self assert: result equals: 'Test'. + result := block ]. + presenter action: [ 'Test' ]. + self assert: result isBlock. + self assert: result value equals: 'Test'. self assert: count equals: 1 ] { #category : #tests } -SpLinkPresenterTest >> testWhenUrlChangedDo [ +SpLinkPresenterTest >> testWhenLabelChangedDo [ | count result | count := 0. presenter - whenUrlChangedDo: [ :label | + whenLabelChangedDo: [ :label | count := count + 1. result := label ]. - presenter url: 'Test'. + presenter label: 'Test'. self assert: result equals: 'Test'. self assert: count equals: 1 ] diff --git a/src/Spec2-Tests/SpTextPresenterTest.class.st b/src/Spec2-Tests/SpTextPresenterTest.class.st index 78082dfcf..23b248378 100644 --- a/src/Spec2-Tests/SpTextPresenterTest.class.st +++ b/src/Spec2-Tests/SpTextPresenterTest.class.st @@ -8,3 +8,21 @@ Class { SpTextPresenterTest >> classToTest [ ^ SpTextPresenter ] + +{ #category : #tests } +SpTextPresenterTest >> testInsertAt [ + + self initializationText. + self openInstance. + presenter insert: 'insertion ' at: 9. + self assert: presenter text equals: 'Text for insertion tests.' +] + +{ #category : #tests } +SpTextPresenterTest >> testSelectLine [ + + self initializationText. + self openInstance. + presenter selectLine. + self assert: presenter selection equals: (1 to: 15) +] diff --git a/src/Spec2-Tests/SpWindowPresenterTest.class.st b/src/Spec2-Tests/SpWindowPresenterTest.class.st index 8225e5a58..68f1ec17d 100644 --- a/src/Spec2-Tests/SpWindowPresenterTest.class.st +++ b/src/Spec2-Tests/SpWindowPresenterTest.class.st @@ -56,3 +56,18 @@ SpWindowPresenterTest >> testWhenOpenedDo [ self assert: opened ] + +{ #category : #tests } +SpWindowPresenterTest >> testWhenWillCloseDo [ + | willClose closed | + + willClose := false. + closed := false. + presenter presenter: SpLabelPresenter new. + presenter whenWillCloseDo: [ willClose := true ]. + presenter whenClosedDo: [ closed := willClose ]. + window := presenter openWithSpecLayout: SpLabelPresenter defaultSpec. + presenter close. + self assert: willClose. + self assert: closed +] diff --git a/src/Spec2-Tools/ChangeSorterPresenter.class.st b/src/Spec2-Tools/ChangeSorterPresenter.class.st index 297a30f77..73075ad42 100644 --- a/src/Spec2-Tools/ChangeSorterPresenter.class.st +++ b/src/Spec2-Tools/ChangeSorterPresenter.class.st @@ -93,7 +93,7 @@ ChangeSorterPresenter >> changeSetMenu [ "Set up aMenu to hold commands for the change-set-list pane. This could be for a single or double changeSorter" ^ self newMenu - addTitle: 'Change Set'; + title: 'Change Set'; addGroup: [ :aGroup | aGroup addItem: [ :anItem | @@ -188,7 +188,7 @@ ChangeSorterPresenter >> classMenu [ "Fill aMenu with items appropriate for the class list" ^ self newMenu - addTitle: 'Class list'; + title: 'Class list'; addGroup: [ :aGroup | aGroup addItem: [ :anItem | @@ -388,19 +388,15 @@ ChangeSorterPresenter >> initializeWidgets [ classesListPresenter := self newList. changesListPresenter := self newList. textPresenter := self newCode. - self setFocus. - methodsListPresenter contextMenu: self messageMenu. changesListPresenter contextMenu: self changeSetMenu. classesListPresenter contextMenu: self classMenu. - methodsListPresenter enableItemSubstringFilter. classesListPresenter enableItemSubstringFilter. changesListPresenter enableItemSubstringFilter. - changesListPresenter items: self model allChanges. - changesListPresenter displayBlock: [ :item | item name ]. + changesListPresenter display: [ :item | item name ]. classesListPresenter sortingBlock: [ :a :b | a name < b name ] ] @@ -416,7 +412,7 @@ ChangeSorterPresenter >> messageMenu [ "Build a menu with items appropriate for the message list; could be for a single or double changeSorter" ^ self newMenu - addTitle: 'Message list'; + title: 'Message list'; addGroup: [ :group | group addItem: [ :anItem | diff --git a/src/Spec2-Transmission/SpTransmissionExample.class.st b/src/Spec2-Transmission/SpTransmissionExample.class.st index 68eed63e8..4b155008f 100644 --- a/src/Spec2-Transmission/SpTransmissionExample.class.st +++ b/src/Spec2-Transmission/SpTransmissionExample.class.st @@ -43,35 +43,35 @@ SpTransmissionExample >> classTemplateFor: aPackage [ { #category : #initialization } SpTransmissionExample >> initializeWidgets [ - - packages := self newList displayBlock: #name. - classes := self newList displayBlock: #name. - protocols := self newList displayBlock: [ :aPair | aPair value name ]. - methods := self newList displayBlock: #selector. + packages := self newList display: #name. + classes := self newList display: #name. + protocols := self newList display: [ :aPair | aPair value name ]. + methods := self newList display: #selector. code := self newCode. - - packages transmitTo: classes transform: [ :aPackage | aPackage definedClasses asArray ]. - packages transmitTo: code transform: [ :aPackage | self classTemplateFor: aPackage ]. - - classes - transmitTo: protocols - transform: [ :aClass | - aClass organization allProtocols + packages + transmitTo: classes + transform: [ :aPackage | aPackage definedClasses asArray ]. + packages + transmitTo: code + transform: [ :aPackage | self classTemplateFor: aPackage ]. + classes + transmitTo: protocols + transform: [ :aClass | + aClass organization allProtocols collect: [ :each | aClass -> each ] as: OrderedCollection ] postTransmission: [ :destination :origin | destination selectIndex: 1 ]. classes transmitTo: code transform: #definitionWithSlots. - - protocols - transmitTo: methods + protocols + transmitTo: methods transform: [ :aPair | - aPair value methods + aPair value methods collect: [ :each | aPair key >> each ] as: OrderedCollection ]. - protocols transmitTo: code transform: [ :aPair | aPair key sourceCodeTemplate ]. - + protocols + transmitTo: code + transform: [ :aPair | aPair key sourceCodeTemplate ]. methods transmitTo: code transform: #sourceCode. - packages items: RPackageOrganizer default packages ]