diff --git a/src/Spec-BackendTests/CodeAdapterTest.class.st b/src/Spec-BackendTests/CodeAdapterTest.class.st index f5e77b8c6ff..b3f7ca3ada0 100644 --- a/src/Spec-BackendTests/CodeAdapterTest.class.st +++ b/src/Spec-BackendTests/CodeAdapterTest.class.st @@ -81,3 +81,15 @@ CodeAdapterTest >> testTextWithStyle [ self assertText: text atInterval: "test" (6 to: 11) isStyle: #comment. self assertText: text atInterval: "42" (13 to: 14) isStyle: #number. ] + +{ #category : #tests } +CodeAdapterTest >> testWithSyntaxHighlight [ + presenter withSyntaxHighlight. + self assert: self adapter hasSyntaxHighlightEnabled +] + +{ #category : #tests } +CodeAdapterTest >> testWithoutSyntaxHighlight [ + presenter withoutSyntaxHighlight. + self deny: self adapter hasSyntaxHighlightEnabled +] diff --git a/src/Spec-BackendTests/ListCommonPropertiestTest.class.st b/src/Spec-BackendTests/ListCommonPropertiestTest.class.st index 60b6ddd7227..188a971f57c 100644 --- a/src/Spec-BackendTests/ListCommonPropertiestTest.class.st +++ b/src/Spec-BackendTests/ListCommonPropertiestTest.class.st @@ -9,6 +9,31 @@ ListCommonPropertiestTest >> classToTest [ ^ ListPresenter ] +{ #category : #running } +ListCommonPropertiestTest >> testChangingFromMultipleToSingleSelection [ + presenter beMultipleSelection. + self assert: presenter isMultipleSelection. + presenter beSingleSelection. + self deny: presenter isMultipleSelection +] + +{ #category : #running } +ListCommonPropertiestTest >> testChangingFromSingleToMultipleSelection [ + presenter beSingleSelection. + self deny: presenter isMultipleSelection. + presenter beMultipleSelection. + self assert: presenter isMultipleSelection +] + +{ #category : #running } +ListCommonPropertiestTest >> testEnablingFilteringUpdateOpenedList [ + self deny: self adapter hasFilter. + presenter enableItemSubstringFilter. + self assert: self adapter hasFilter. + presenter itemFilterBlock: nil. + self deny: self adapter hasFilter +] + { #category : #running } ListCommonPropertiestTest >> testRemoveHeaderTitleInPresenterRemovesColumnHeaderMorph [ SystemVersion current major = 7 ifTrue: [ "Test failing in Pharo7 due to a bug in FastTable" ^ self skip ]. diff --git a/src/Spec-BackendTests/MockDynamicPresenter.class.st b/src/Spec-BackendTests/MockDynamicPresenter.class.st index 246b1da247f..b04a94ea506 100644 --- a/src/Spec-BackendTests/MockDynamicPresenter.class.st +++ b/src/Spec-BackendTests/MockDynamicPresenter.class.st @@ -55,5 +55,5 @@ MockDynamicPresenter >> label [ { #category : #action } MockDynamicPresenter >> selectFirstElement [ - list selectedIndex: 1 + list selectIndex: 1 ] diff --git a/src/Spec-BackendTests/MorphicCodeAdapter.extension.st b/src/Spec-BackendTests/MorphicCodeAdapter.extension.st new file mode 100644 index 00000000000..dc47d481895 --- /dev/null +++ b/src/Spec-BackendTests/MorphicCodeAdapter.extension.st @@ -0,0 +1,6 @@ +Extension { #name : #MorphicCodeAdapter } + +{ #category : #'*Spec-BackendTests' } +MorphicCodeAdapter >> hasSyntaxHighlightEnabled [ + ^ (self widget textArea editingMode isKindOf: RubPlainTextMode) not +] diff --git a/src/Spec-Core/AbstractListPresenter.class.st b/src/Spec-Core/AbstractListPresenter.class.st index d84593313df..73ce20aa6d6 100644 --- a/src/Spec-Core/AbstractListPresenter.class.st +++ b/src/Spec-Core/AbstractListPresenter.class.st @@ -123,21 +123,6 @@ AbstractListPresenter >> enableItemSubstringFilter [ self itemFilterBlock: [ :each :pattern | each asLowercase includesSubstring: pattern asLowercase ] ] -{ #category : #api } -AbstractListPresenter >> filteringBlock [ - "" - "Return the filtering of the items" - - ^ filteringBlockHolder value -] - -{ #category : #api } -AbstractListPresenter >> filteringBlock: aBlock [ - "To set the filtering of the items. This filter will be used to filter the visible elements." - - filteringBlockHolder value: aBlock -] - { #category : #initialization } AbstractListPresenter >> initialize [ @@ -157,7 +142,6 @@ AbstractListPresenter >> initialize [ { #category : #initialization } AbstractListPresenter >> initializeValueHolders [ - filteringBlockHolder := self defaultFilteringBlock asValueHolder. itemFilterBlockHolder := nil asValueHolder. doubleClickActionHolder := [ ] asValueHolder. contextMenuHolder := nil asValueHolder. @@ -208,7 +192,7 @@ AbstractListPresenter >> items: aCollection [ AbstractListPresenter >> listElementAt: anIndex [ "Return the item at index _anIndex_" - ^ self model shownItems at: anIndex ifAbsent: [ nil ] + ^ self model at: anIndex ifAbsent: [ nil ] ] { #category : #private } @@ -224,7 +208,7 @@ AbstractListPresenter >> listSize [ "Return the size of the list" - ^ self model shownItems size + ^ self model size ] { #category : #accessing } @@ -369,6 +353,11 @@ AbstractListPresenter >> whenActivatedDo: aBlockClosure [ activationBlock := aBlockClosure. ] +{ #category : #'api-events' } +AbstractListPresenter >> whenItemFilterBlockChangedDo: aBlock [ + itemFilterBlockHolder whenChangedDo: aBlock +] + { #category : #'api-events' } AbstractListPresenter >> whenMenuChangedDo: aBlock [ "Set a block to value when the menu block has changed" diff --git a/src/Spec-Core/AbstractTextPresenter.class.st b/src/Spec-Core/AbstractTextPresenter.class.st index 7039abadfb7..726cfbaa3ee 100644 --- a/src/Spec-Core/AbstractTextPresenter.class.st +++ b/src/Spec-Core/AbstractTextPresenter.class.st @@ -21,10 +21,10 @@ AbstractTextPresenter >> aboutToStyle: aBoolean [ "" "Set if the text zone must be styled" - "self + self deprecated: 'This has been moved to specific presenters' on: '2019-04-15' - in: #Pharo8" + in: #Pharo8 ] { #category : #'api-shout' } @@ -331,16 +331,6 @@ AbstractTextPresenter >> initialize [ self registerEvents ] -{ #category : #'api-shout' } -AbstractTextPresenter >> isAboutToStyle [ - "Return if the text zone is shouted or not" - - self - deprecated: 'This has been moved to specific presenters' - on: '2019-04-15' - in: #Pharo8 -] - { #category : #NOCompletion } AbstractTextPresenter >> isCodeCompletionAllowed [ "Return if code completion is allowed" diff --git a/src/Spec-Core/AbstractTreeSingleSelectionMode.class.st b/src/Spec-Core/AbstractTreeSingleSelectionMode.class.st index 07c9d88b76d..61ac5e75264 100644 --- a/src/Spec-Core/AbstractTreeSingleSelectionMode.class.st +++ b/src/Spec-Core/AbstractTreeSingleSelectionMode.class.st @@ -45,11 +45,16 @@ AbstractTreeSingleSelectionMode >> replaceOtherSelectionMode: anotherSelection [ ] { #category : #selection } -AbstractTreeSingleSelectionMode >> selectPath: pathArray [ +AbstractTreeSingleSelectionMode >> selectPath: aPath [ self subclassResponsibility ] +{ #category : #selection } +AbstractTreeSingleSelectionMode >> selectPaths: pathArray [ + self subclassResponsibility +] + { #category : #selecting } AbstractTreeSingleSelectionMode >> unselectAll [ diff --git a/src/Spec-Core/CodePresenter.class.st b/src/Spec-Core/CodePresenter.class.st index ebf6e2ce0ba..085bd5aff72 100644 --- a/src/Spec-Core/CodePresenter.class.st +++ b/src/Spec-Core/CodePresenter.class.st @@ -9,7 +9,7 @@ Class { '#doItContext => SpecObservableSlot', '#doItReceiver => SpecObservableSlot', '#behavior => SpecObservableSlot', - '#syntaxHighlight', + '#syntaxHighlight => SpecObservableSlot', '#contextKeyBindings' ], #category : #'Spec-Core-Widgets' @@ -129,6 +129,11 @@ CodePresenter >> selectedBehavior [ ^ self behavior ] +{ #category : #accessing } +CodePresenter >> syntaxHighlight: aBoolean [ + syntaxHighlight := aBoolean +] + { #category : #'api-events' } CodePresenter >> whenBehaviorChangedDo: aBlock [ "Set a block to perform when the behavior class changed" @@ -138,14 +143,19 @@ CodePresenter >> whenBehaviorChangedDo: aBlock [ whenChangedDo: aBlock ] -{ #category : #accessing } -CodePresenter >> withSyntaxHighlight [ +{ #category : #'api-events' } +CodePresenter >> whenSyntaxHighlightChangedDo: aBlock [ + "Set a block to perform when the syntax highlight is enabled/disabled" - syntaxHighlight := true + self property: #syntaxHighlight whenChangedDo: aBlock ] -{ #category : #accessing } -CodePresenter >> withoutSyntaxHighlight [ +{ #category : #api } +CodePresenter >> withSyntaxHighlight [ + self syntaxHighlight: true +] - syntaxHighlight := false +{ #category : #api } +CodePresenter >> withoutSyntaxHighlight [ + self syntaxHighlight: false ] diff --git a/src/Spec-Core/ComposablePresenter.class.st b/src/Spec-Core/ComposablePresenter.class.st index 7cf80514de5..88ee0c53ade 100644 --- a/src/Spec-Core/ComposablePresenter.class.st +++ b/src/Spec-Core/ComposablePresenter.class.st @@ -193,16 +193,17 @@ ComposablePresenter class >> title [ ^ 'Untitled window' ] -{ #category : #'api-window' } +{ #category : #TOREMOVE } ComposablePresenter >> aboutText [ + "DO NOT USE + With Spec 2, ComposablePresenter was refactored to move all window management to WindowPresenter. + From now on, if you want to interact with a window you need to: + - Implement #initializeWindow: method (#initializeDialog: for dialogs) to manage window elements before the presenter is opened + - Use the method #window or #withWindowDo: to interact with windows after it has been opened. + + This method cannot be deprecated because during a transition phase we keep this mecanism. " - ^ aboutText value ifNil: [ aboutText value: 'The about text for this window has not been set.'; value] -] - -{ #category : #'api-window' } -ComposablePresenter >> aboutText: aString [ - - aboutText value: aString + ^ aboutText value ] { #category : #private } @@ -298,19 +299,19 @@ ComposablePresenter >> asPresenter [ ^ self ] -{ #category : #'api-window' } +{ #category : #TOREMOVE } ComposablePresenter >> askOkToClose [ + "DO NOT USE + With Spec 2, ComposablePresenter was refactored to move all window management to WindowPresenter. + From now on, if you want to interact with a window you need to: + - Implement #initializeWindow: method (#initializeDialog: for dialogs) to manage window elements before the presenter is opened + - Use the method #window or #withWindowDo: to interact with windows after it has been opened. + + This method cannot be deprecated because during a transition phase we keep this mecanism. " ^ askOkToClose value ] -{ #category : #'api-window' } -ComposablePresenter >> askOkToClose: aBoolean [ - self flag: #TODO. "Move this to WindowPresenter (it should be added in - #initializeWindow:" - askOkToClose value: aBoolean -] - { #category : #'api-shortcuts' } ComposablePresenter >> bindKeyCombination: aShortcut toAction: aBlock [ @@ -493,9 +494,16 @@ ComposablePresenter >> iconNamed: aSymbol [ ^ self class iconNamed: aSymbol ] -{ #category : #'api-window' } +{ #category : #TOREMOVE } ComposablePresenter >> initialExtent [ - + + "DO NOT USE + With Spec 2, ComposablePresenter was refactored to move all window management to WindowPresenter. + From now on, if you want to interact with a window you need to: + - Implement #initializeWindow: method (#initializeDialog: for dialogs) to manage window elements before the presenter is opened + - Use the method #window or #withWindowDo: to interact with windows after it has been opened. + + This method cannot be deprecated because during a transition phase we keep this mecanism. " ^ nil ] @@ -573,8 +581,12 @@ ComposablePresenter >> initializeWidgets [ ComposablePresenter >> initializeWindow: aWindowPresenter [ "override this to set window values before opening. You may want to add a menu, a toolbar or a statusbar" - - aWindowPresenter + + "IMPORTANT: Please ovirride this method and set yourself the informations you want in your window. + The content of this method is here to help the transition between Spec 1 and 2. + In the next Spec version the content of this method will be removed and it will do nothing by default because the goal is to remove the management of all of those informations from Composable to put them in WindowPresenter." + + aWindowPresenter title: self title; initialExtent: self initialExtent; windowIcon: self windowIcon; @@ -822,17 +834,6 @@ ComposablePresenter >> okToChange [ ifFalse: [ true ] ] -{ #category : #'api-shortcuts' } -ComposablePresenter >> on: aShortcut do: aBlock [ - - self - deprecated: 'Use #bindKeyCombination:toAction: instead.' - transformWith: '`@receiver on: `@statements1 do: `@statements2' - -> '`@receiver bindKeyCombination: `@statements1 toAction: `@statements2'. - - self bindKeyCombination: aShortcut toAction: aBlock -] - { #category : #'api-announcements' } ComposablePresenter >> on: anAnnouncement send: aSelector to: aTarget [ @@ -935,17 +936,6 @@ ComposablePresenter >> setExtentAndBindingTo: widget [ self ensureKeyBindingsFor: widget ] -{ #category : #'api-showing' } -ComposablePresenter >> setModal: aWindow [ - - self - deprecated: 'Do not use this directly. Use #openModalWithSpec (and family) instead.' - on: '2019-02-26' - in: #Pharo8. - - self changed: #setModal: with: { aWindow } -] - { #category : #'accessing model' } ComposablePresenter >> setModel: aDomainObject [ @@ -985,19 +975,19 @@ ComposablePresenter >> takeLastKeyboardFocus [ ifNotEmpty: [:focus | focus last takeKeyboardFocus ]. ] -{ #category : #'api-window' } +{ #category : #TOREMOVE } ComposablePresenter >> title [ - "Return the window's title" + "DO NOT USE + With Spec 2, ComposablePresenter was refactored to move all window management to WindowPresenter. + From now on, if you want to interact with a window you need to: + - Implement #initializeWindow: method (#initializeDialog: for dialogs) to manage window elements before the presenter is opened + - Use the method #window or #withWindowDo: to interact with windows after it has been opened. + + This method cannot be deprecated because during a transition phase we keep this mecanism. " ^ titleHolder value ] -{ #category : #'api-window' } -ComposablePresenter >> title: aString [ - - titleHolder value: aString -] - { #category : #TOREMOVE } ComposablePresenter >> toolName [ @@ -1065,24 +1055,15 @@ ComposablePresenter >> whenWindowChanged: aBlock [ do: [ :ann | aBlock cull: ann model ] ] -{ #category : #accessing } -ComposablePresenter >> widget [ - "I return the adapter responsible of building my widget" - - self deprecated: 'Should use #adapter instead' - transformWith: '`@receiver widget' -> '`@receiver adapter'. - - ^ self spec -] - -{ #category : #api } +{ #category : #TOREMOVE } ComposablePresenter >> windowIcon [ + "DO NOT USE + With Spec 2, ComposablePresenter was refactored to move all window management to WindowPresenter. + From now on, if you want to interact with a window you need to: + - Implement #initializeWindow: method (#initializeDialog: for dialogs) to manage window elements before the presenter is opened + - Use the method #window or #withWindowDo: to interact with windows after it has been opened. + + This method cannot be deprecated because during a transition phase we keep this mecanism. " ^ windowIcon value ] - -{ #category : #api } -ComposablePresenter >> windowIcon: aForm [ - - windowIcon value: aForm -] diff --git a/src/Spec-Core/DropListPresenter.class.st b/src/Spec-Core/DropListPresenter.class.st index 631eafe63d5..6326f9c9a67 100644 --- a/src/Spec-Core/DropListPresenter.class.st +++ b/src/Spec-Core/DropListPresenter.class.st @@ -159,7 +159,6 @@ DropListPresenter >> initialize [ iconHolder := [ Name already defined -> :model :item | item icon ] asValueHolder. " - ] { #category : #api } diff --git a/src/Spec-Core/MorphPresenter.class.st b/src/Spec-Core/MorphPresenter.class.st new file mode 100644 index 00000000000..c05be5abbc5 --- /dev/null +++ b/src/Spec-Core/MorphPresenter.class.st @@ -0,0 +1,43 @@ +Class { + #name : #MorphPresenter, + #superclass : #AbstractWidgetPresenter, + #instVars : [ + '#morph => SpecObservableSlot' + ], + #category : #'Spec-Core-Morphic' +} + +{ #category : #specs } +MorphPresenter class >> adapterName [ + + ^ #MorphAdapter +] + +{ #category : #initialization } +MorphPresenter >> defineInputPorts [ + + ^ { SpecMorphPort new } +] + +{ #category : #initialization } +MorphPresenter >> initialize [ + + super initialize. +] + +{ #category : #accessing } +MorphPresenter >> morph [ + ^ morph +] + +{ #category : #accessing } +MorphPresenter >> morph: aMorph [ + + morph := aMorph +] + +{ #category : #'api-events' } +MorphPresenter >> whenMorphChangedDo: aBlock [ + + self property: #morph whenChangedDo: aBlock +] diff --git a/src/Spec-Core/SpecCollectionListModel.class.st b/src/Spec-Core/SpecCollectionListModel.class.st index 5cc7fc0b63a..58cd861ac0f 100644 --- a/src/Spec-Core/SpecCollectionListModel.class.st +++ b/src/Spec-Core/SpecCollectionListModel.class.st @@ -4,9 +4,6 @@ Class { #instVars : [ 'announcer', 'collection', - 'filter', - 'shownCollection', - 'changedBlock', 'sortingBlockHolder' ], #category : #'Spec-Core-Widgets-Table' @@ -66,13 +63,6 @@ SpecCollectionListModel >> collection: anObject [ newValue: collection) ] -{ #category : #accessing } -SpecCollectionListModel >> filterWith: aBlockClosure [ - - filter := aBlockClosure. - self refreshList. -] - { #category : #accessing } SpecCollectionListModel >> indexOf: anIndex ifAbsent: aBlock [ @@ -81,9 +71,7 @@ SpecCollectionListModel >> indexOf: anIndex ifAbsent: aBlock [ { #category : #initialization } SpecCollectionListModel >> initialize [ - super initialize. - filter := [ true ]. sortingBlockHolder := nil asValueHolder ] @@ -95,8 +83,7 @@ SpecCollectionListModel >> items [ { #category : #refreshing } SpecCollectionListModel >> refreshList [ - self sortingBlock ifNotNil: [ :aSortFunction | collection sort: aSortFunction ]. - shownCollection := collection select: [ :elem | filter cull: elem cull: collection ]. + self sortingBlock ifNotNil: [ :aSortFunction | collection sort: aSortFunction ] ] { #category : #collection } @@ -109,12 +96,6 @@ SpecCollectionListModel >> removeAll [ ] -{ #category : #accessing } -SpecCollectionListModel >> shownItems [ - - ^ shownCollection -] - { #category : #accessing } SpecCollectionListModel >> size [ diff --git a/src/Spec-Core/SpecMultipleSelectionMode.class.st b/src/Spec-Core/SpecMultipleSelectionMode.class.st index 27a3a16529d..8936ed98032 100644 --- a/src/Spec-Core/SpecMultipleSelectionMode.class.st +++ b/src/Spec-Core/SpecMultipleSelectionMode.class.st @@ -102,7 +102,7 @@ SpecMultipleSelectionMode >> selectedItems [ { #category : #accessing } SpecMultipleSelectionMode >> subscriptions [ - ^ selectedIndexesValueHolder announcer subscriptions + ^ selectedIndexesValueHolder announcer subscriptions subscriptions ] { #category : #selecting } diff --git a/src/Spec-Core/SpecVersatileDialogPresenter.class.st b/src/Spec-Core/SpecVersatileDialogPresenter.class.st index cd5a8a8dce0..7d4c36c6ea3 100644 --- a/src/Spec-Core/SpecVersatileDialogPresenter.class.st +++ b/src/Spec-Core/SpecVersatileDialogPresenter.class.st @@ -253,11 +253,6 @@ SpecVersatileDialogPresenter >> footnoteIcon: aForm [ footnoteIcon := aForm. ] -{ #category : #'api-window' } -SpecVersatileDialogPresenter >> initialExtent [ - ^ 400@200 -] - { #category : #initialization } SpecVersatileDialogPresenter >> initialize [ @@ -271,6 +266,7 @@ SpecVersatileDialogPresenter >> initialize [ { #category : #initialization } SpecVersatileDialogPresenter >> initializeDialogWindow: aDialogWindowPresenter [ + aDialogWindowPresenter initialExtent: 400 @ 200 ] { #category : #initialization } diff --git a/src/Spec-Core/TreeMultipleSelectionMode.class.st b/src/Spec-Core/TreeMultipleSelectionMode.class.st index d6cbf3c3e06..3b8ca874203 100644 --- a/src/Spec-Core/TreeMultipleSelectionMode.class.st +++ b/src/Spec-Core/TreeMultipleSelectionMode.class.st @@ -38,6 +38,13 @@ TreeMultipleSelectionMode >> selectPath: aPath [ selection := selection copyWith: aPath. ] +{ #category : #selection } +TreeMultipleSelectionMode >> selectPaths: pathArray [ + pathArray + do: [ :path | presenter itemAtPath: path ifAbsent: [ ^ self ] ]. + selection := pathArray +] + { #category : #accessing } TreeMultipleSelectionMode >> selectedItem [ self shouldBeImplemented. diff --git a/src/Spec-Core/TreeSingleSelectionMode.class.st b/src/Spec-Core/TreeSingleSelectionMode.class.st index a7d284c0048..7019a949bdd 100644 --- a/src/Spec-Core/TreeSingleSelectionMode.class.st +++ b/src/Spec-Core/TreeSingleSelectionMode.class.st @@ -24,6 +24,11 @@ TreeSingleSelectionMode >> selectPath: aPath [ ] +{ #category : #accessing } +TreeSingleSelectionMode >> selectPaths: pathArray [ + self selectPath: pathArray last. +] + { #category : #accessing } TreeSingleSelectionMode >> selectedItem [ diff --git a/src/Spec-Core/TreeTablePresenter.class.st b/src/Spec-Core/TreeTablePresenter.class.st index 757b6e45870..766538f700e 100644 --- a/src/Spec-Core/TreeTablePresenter.class.st +++ b/src/Spec-Core/TreeTablePresenter.class.st @@ -212,6 +212,11 @@ TreeTablePresenter >> selectPath: aPath [ self selection selectPath: aPath ] +{ #category : #api } +TreeTablePresenter >> selectPaths: pathArray [ + self selection selectPaths: pathArray +] + { #category : #api } TreeTablePresenter >> selectedItem [ diff --git a/src/Spec-Core/WindowPresenter.class.st b/src/Spec-Core/WindowPresenter.class.st index 78a39b56e06..0f1c9624f3a 100644 --- a/src/Spec-Core/WindowPresenter.class.st +++ b/src/Spec-Core/WindowPresenter.class.st @@ -46,12 +46,14 @@ WindowPresenter class >> presenter: aPresenter [ { #category : #api } WindowPresenter >> aboutText [ - "if my aboutText has not been set the fallback is: - - if I do have a model, use its' about text - - else use the behavior defined in super - " + ^ aboutText value + ifNil: [ self aboutText: 'The about text for this window has not been set.'. + aboutText value ] +] - ^ aboutText value ifNil: [ self presenter ifNil: [ super aboutText ] ifNotNil: #aboutText ] ifNotNil: [ aboutText value ] +{ #category : #api } +WindowPresenter >> aboutText: aString [ + aboutText value: aString ] { #category : #api } @@ -322,7 +324,8 @@ WindowPresenter >> menu [ { #category : #api } WindowPresenter >> menu: aMenuPresenter [ - aMenuPresenter owner: self. + aMenuPresenter ifNotNil: [ + aMenuPresenter owner: self ]. ^ menuHolder value: aMenuPresenter ] @@ -414,9 +417,11 @@ WindowPresenter >> statusBar: aStatusbarPresenter [ { #category : #api } WindowPresenter >> taskbarIcon [ - ^ self presenter - ifNil: [ super taskbarIcon ] - ifNotNil: [ :pres | pres windowIcon ifNil: [ pres taskbarIcon ] ] + ^ self windowIcon + ifNil: [ + self presenter + ifNil: [ super taskbarIcon ] + ifNotNil: #taskbarIcon ] ] { #category : #private } @@ -440,7 +445,8 @@ WindowPresenter >> toolBar [ { #category : #api } WindowPresenter >> toolBar: aToolbarPresenter [ - aToolbarPresenter owner: self. + aToolbarPresenter ifNotNil: [ + aToolbarPresenter owner: self ]. ^ toolBarHolder value: aToolbarPresenter ] @@ -487,6 +493,16 @@ WindowPresenter >> window: aWindow [ windowHolder value: aWindow ] +{ #category : #private } +WindowPresenter >> windowIcon [ + ^ windowIcon value +] + +{ #category : #private } +WindowPresenter >> windowIcon: aForm [ + windowIcon value: aForm +] + { #category : #updating } WindowPresenter >> windowIsClosing [ diff --git a/src/Spec-Deprecated80/AbstractListPresenter.extension.st b/src/Spec-Deprecated80/AbstractListPresenter.extension.st index 387bdb1c39c..b41130ed0a5 100644 --- a/src/Spec-Deprecated80/AbstractListPresenter.extension.st +++ b/src/Spec-Deprecated80/AbstractListPresenter.extension.st @@ -11,6 +11,19 @@ AbstractListPresenter >> doubleClickAction: aBlockClosure [ self whenActivatedDo: [ :sel | aBlockClosure value: sel selectedItem] ] +{ #category : #'*Spec-Deprecated80' } +AbstractListPresenter >> filteringBlock [ + self + deprecated: 'This feature is now removed from Spec 2. If the visible elements of the list need to be changed, it''s the users of the lists that should manage it and update the list of items of the list.'. + ^ nil +] + +{ #category : #'*Spec-Deprecated80' } +AbstractListPresenter >> filteringBlock: aBlock [ + self + deprecated: 'This feature is now removed from Spec 2. If the visible elements of the list need to be changed, it''s the users of the lists that should manage it and update the list of items of the list.' +] + { #category : #'*Spec-Deprecated80' } AbstractListPresenter >> getSelectionStateFor: anIndex [ self deprecated: 'This method from the old API will be removed.' transformWith: '`@receiver getSelectionStateFor: `@statements' -> '`@receiver selection selectedIndexes includes: `@statements'. @@ -36,8 +49,8 @@ AbstractListPresenter >> listItems [ self deprecated: 'Please use the #model instead' transformWith: '`@receiver listItems' - -> '`@receiver model shownItems'. - ^ self model shownItems + -> '`@receiver model items'. + ^ self model items ] { #category : #'*Spec-Deprecated80' } diff --git a/src/Spec-Deprecated80/AbstractTextPresenter.extension.st b/src/Spec-Deprecated80/AbstractTextPresenter.extension.st index fb62bc70872..3be9688201a 100644 --- a/src/Spec-Deprecated80/AbstractTextPresenter.extension.st +++ b/src/Spec-Deprecated80/AbstractTextPresenter.extension.st @@ -1,5 +1,15 @@ Extension { #name : #AbstractTextPresenter } +{ #category : #'*Spec-Deprecated80' } +AbstractTextPresenter >> isAboutToStyle [ + "Return if the text zone is shouted or not" + + self + deprecated: 'This has been moved to specific presenters' + on: '2019-04-15' + in: #Pharo8 +] + { #category : #'*Spec-Deprecated80' } AbstractTextPresenter >> whenAboutToStyleBlockChanged: aBlock [ self deprecated: 'Use #whenAboutToStyleBlockChangedDo: instead.' transformWith: '`@receiver whenAboutToStyleBlockChanged: `@statements' -> '`@receiver whenAboutToStyleBlockChangedDo: `@statements'. diff --git a/src/Spec-Deprecated80/AbstractTwoButtons.class.st b/src/Spec-Deprecated80/AbstractTwoButtons.class.st index 9841a22ce48..137863aecd3 100644 --- a/src/Spec-Deprecated80/AbstractTwoButtons.class.st +++ b/src/Spec-Deprecated80/AbstractTwoButtons.class.st @@ -20,12 +20,7 @@ Class { { #category : #deprecation } AbstractTwoButtons class >> abstractExample [ - | example | - example := self new. - example - title: self name asString , ' example'; - extent: 100 @ 100. - ^ example + ^ self new ] { #category : #specs } diff --git a/src/Spec-Deprecated80/CodePresenter.extension.st b/src/Spec-Deprecated80/CodePresenter.extension.st new file mode 100644 index 00000000000..9891e49a954 --- /dev/null +++ b/src/Spec-Deprecated80/CodePresenter.extension.st @@ -0,0 +1,7 @@ +Extension { #name : #CodePresenter } + +{ #category : #'*Spec-Deprecated80' } +CodePresenter >> aboutToStyle: aBoolean [ + self deprecated: 'Use #withSyntaxHighlight, #withoutSyntaxHighlight or #syntaxHighlight: instead.' transformWith: '`@receiver aboutToStyle: `@argument' -> '`@receiver syntaxHighlight: `@argument'. + self syntaxHighlight: aBoolean +] diff --git a/src/Spec-Deprecated80/ComposablePresenter.extension.st b/src/Spec-Deprecated80/ComposablePresenter.extension.st index ae1be832a89..3205cba9ecd 100644 --- a/src/Spec-Deprecated80/ComposablePresenter.extension.st +++ b/src/Spec-Deprecated80/ComposablePresenter.extension.st @@ -1,5 +1,27 @@ Extension { #name : #ComposablePresenter } +{ #category : #'*Spec-Deprecated80' } +ComposablePresenter >> aboutText: aString [ + self + deprecated: + 'With Spec 2, ComposablePresenter was refactored to move all window management to WindowPresenter. + From now on, if you want to interact with a window you need to: + - Implement #initializeWindow: method (#initializeDialog: for dialogs) to manage window elements before the presenter is opened + - Use the method #window or #withWindowDo: to interact with windows after it has been opened.'. + self window ifNil: [ aboutText value: aString ] ifNotNil: [ :window | window aboutText: aString ] +] + +{ #category : #'*Spec-Deprecated80' } +ComposablePresenter >> askOkToClose: aBoolean [ + self + deprecated: + 'With Spec 2, ComposablePresenter was refactored to move all window management to WindowPresenter. + From now on, if you want to interact with a window you need to: + - Implement #initializeWindow: method (#initializeDialog: for dialogs) to manage window elements before the presenter is opened + - Use the method #window or #withWindowDo: to interact with windows after it has been opened.'. + self window ifNil: [ askOkToClose value: aBoolean ] ifNotNil: [ :window | window askOkToClose: aBoolean ] +] + { #category : #'*Spec-Deprecated80' } ComposablePresenter >> defaultWindowModelClass [ self deprecated: 'Use #defaultWindowPresenterClass instead' transformWith: '`@receiver defaultWindowModelClass' -> '`@receiver defaultWindowPresenterClass'. @@ -62,3 +84,57 @@ ComposablePresenter >> newTree [ ^ self instantiate: TreePresenter ] + +{ #category : #'*Spec-Deprecated80' } +ComposablePresenter >> on: aShortcut do: aBlock [ + + self + deprecated: 'Use #bindKeyCombination:toAction: instead.' + transformWith: '`@receiver on: `@statements1 do: `@statements2' + -> '`@receiver bindKeyCombination: `@statements1 toAction: `@statements2'. + + self bindKeyCombination: aShortcut toAction: aBlock +] + +{ #category : #'*Spec-Deprecated80' } +ComposablePresenter >> setModal: aWindow [ + + self + deprecated: 'Do not use this directly. Use #openModalWithSpec (and family) instead.' + on: '2019-02-26' + in: #Pharo8. + + self changed: #setModal: with: { aWindow } +] + +{ #category : #'*Spec-Deprecated80' } +ComposablePresenter >> title: aString [ + self + deprecated: + 'With Spec 2, ComposablePresenter was refactored to move all window management to WindowPresenter. + From now on, if you want to interact with a window you need to: + - Implement #initializeWindow: method (#initializeDialog: for dialogs) to manage window elements before the presenter is opened + - Use the method #window or #withWindowDo: to interact with windows after it has been opened.'. + self window ifNil: [ titleHolder value: aString ] ifNotNil: [ :window | window title: aString ] +] + +{ #category : #'*Spec-Deprecated80' } +ComposablePresenter >> widget [ + "I return the adapter responsible of building my widget" + + self deprecated: 'Should use #adapter instead' + transformWith: '`@receiver widget' -> '`@receiver adapter'. + + ^ self spec +] + +{ #category : #'*Spec-Deprecated80' } +ComposablePresenter >> windowIcon: aForm [ + self + deprecated: + 'With Spec 2, ComposablePresenter was refactored to move all window management to WindowPresenter. + From now on, if you want to interact with a window you need to: + - Implement #initializeWindow: method (#initializeDialog: for dialogs) to manage window elements before the presenter is opened + - Use the method #window or #withWindowDo: to interact with windows after it has been opened.'. + self window ifNil: [ windowIcon value: aForm ] ifNotNil: [ :window | window windowIcon: aForm ] +] diff --git a/src/Spec-Deprecated80/DiffPresenter.extension.st b/src/Spec-Deprecated80/DiffPresenter.extension.st new file mode 100644 index 00000000000..9fdab0389ca --- /dev/null +++ b/src/Spec-Deprecated80/DiffPresenter.extension.st @@ -0,0 +1,51 @@ +Extension { #name : #DiffPresenter } + +{ #category : #'*Spec-Deprecated80' } +DiffPresenter >> aboutToStyle: aBoolean [ + self + deprecated: + 'This method is an horrible hack because the VersionBrowser was using Code or Diff presenter but was only using the API of the Code presenter... This method and other methods from the CodePresenter API will be removed.' +] + +{ #category : #'*Spec-Deprecated80' } +DiffPresenter >> behavior [ + self + deprecated: + 'This method is an horrible hack because the VersionBrowser was using Code or Diff presenter but was only using the API of the Code presenter... This method and other methods from the CodePresenter API will be removed.'. + ^ self contextClass +] + +{ #category : #'*Spec-Deprecated80' } +DiffPresenter >> behavior: aClass [ + self + deprecated: + 'This method is an horrible hack because the VersionBrowser was using Code or Diff presenter but was only using the API of the Code presenter... This method and other methods from the CodePresenter API will be removed.'. + self contextClass: aClass +] + +{ #category : #'*Spec-Deprecated80' } +DiffPresenter >> doItReceiver: aReceiver [ + self + deprecated: + 'This method is an horrible hack because the VersionBrowser was using Code or Diff presenter but was only using the API of the Code presenter... This method and other methods from the CodePresenter API will be removed.' +] + +{ #category : #'*Spec-Deprecated80' } +DiffPresenter >> getText [ + self + deprecated: + 'This method is an horrible hack because the VersionBrowser was using Code or Diff presenter but was only using the API of the Code presenter... This method and other methods from the CodePresenter API will be removed.'. + ^ self rightText +] + +{ #category : #'*Spec-Deprecated80' } +DiffPresenter >> text: aPairOfString [ + self + deprecated: + 'This method is an horrible hack because the VersionBrowser was using Code or Diff presenter but was only using the API of the Code presenter... This method and other methods from the CodePresenter API will be removed.'. + (aPairOfString isText or: [ aPairOfString isString ]) + ifTrue: [ self leftText: ''. + self rightText: aPairOfString ] + ifFalse: [ self leftText: aPairOfString first. + self rightText: aPairOfString second ] +] diff --git a/src/Spec-Deprecated80/DropListButton.class.st b/src/Spec-Deprecated80/DropListButton.class.st index 9612554c267..820a31a4303 100644 --- a/src/Spec-Deprecated80/DropListButton.class.st +++ b/src/Spec-Deprecated80/DropListButton.class.st @@ -30,15 +30,14 @@ DropListButton class >> defaultSpec [ DropListButton class >> example [ | example | - example := self new. example displayBlock: [ :item | item asString ]; items: {'Swordian' . 'Gardian' . 'Wizard' . 'Sniper'}; label: 'Add'; extent: 300 @ 70; - title: 'DropListButton example'; openWithSpec. + example withWindowDo: [ :window | window title: 'DropListButton example' ]. ^ example ] diff --git a/src/Spec-Deprecated80/LabelledList.extension.st b/src/Spec-Deprecated80/LabelledList.extension.st new file mode 100644 index 00000000000..c6aa7ef7ceb --- /dev/null +++ b/src/Spec-Deprecated80/LabelledList.extension.st @@ -0,0 +1,7 @@ +Extension { #name : #LabelledList } + +{ #category : #'*Spec-Deprecated80' } +LabelledList >> filteringBlock: aBlock [ + self + deprecated: 'This feature is now removed from Spec 2. If the visible elements of the list need to be changed, it''s the users of the lists that should manage it and update the list of items of the list.' +] diff --git a/src/Spec-Deprecated80/MessageBrowser.extension.st b/src/Spec-Deprecated80/MessageBrowser.extension.st new file mode 100644 index 00000000000..4c10edf52bf --- /dev/null +++ b/src/Spec-Deprecated80/MessageBrowser.extension.st @@ -0,0 +1,54 @@ +Extension { #name : #MessageBrowser } + +{ #category : #'*Spec-Deprecated80' } +MessageBrowser >> browseClass [ + self deprecated: 'This method seems never called.'. + self currentMethod ifNotNil: [ :method | method methodClass browse ] +] + +{ #category : #'*Spec-Deprecated80' } +MessageBrowser >> currentMethod [ + self deprecated: 'Use #selectedMessage instead' transformWith: '`@receiver currentMethod' -> '`@receiver selectedMessage'. + ^ self selectedMessage +] + +{ #category : #'*Spec-Deprecated80' } +MessageBrowser >> listModel [ + self deprecated: 'It is not wise to allow external user access the content of a sub presenter. If this is accessed directly, the behavior should probably be moved to the MessageBrowser.'. + ^ messageList listModel +] + +{ #category : #'*Spec-Deprecated80' } +MessageBrowser >> model [ + self deprecated: 'User should not use model directly.'. + ^ messageList model +] + +{ #category : #'*Spec-Deprecated80' } +MessageBrowser >> resetSelection [ + self deprecated: 'I have the impression this method is not use. If it end up been call, please open an issue on pharo-spec/Spec' +] + +{ #category : #'*Spec-Deprecated80' } +MessageBrowser >> selectedItem [ + self deprecated: 'Use #selectedMessage instead' transformWith: '`@receiver selectedItem' -> '`@receiver selectedMessage'. + ^ self selectedMessage +] + +{ #category : #'*Spec-Deprecated80' } +MessageBrowser >> selectedMethods [ + self deprecated: 'I have the impression this method is not use. If it end up been call, please open an issue on pharo-spec/Spec'. + ^ {self selectedMessage} asOrderedCollection +] + +{ #category : #'*Spec-Deprecated80' } +MessageBrowser >> setSelectedIndex: anIndex [ + self deprecated: 'Use #selectIndex: instead' transformWith: '`@receiver setSelectedIndex: `@argument' -> '`@receiver selectIndex: `@argument'. + self selectIndex: anIndex +] + +{ #category : #'*Spec-Deprecated80' } +MessageBrowser >> toolbarModel [ + self deprecated: 'Use #toolbarPresenter instead' transformWith: '`@receiver toolbarModel' -> '`@receiver toolbarPresenter'. + ^ self toolbarPresenter +] diff --git a/src/Spec-Deprecated80/MorphicCodeAdapter.extension.st b/src/Spec-Deprecated80/MorphicCodeAdapter.extension.st new file mode 100644 index 00000000000..fa627066db4 --- /dev/null +++ b/src/Spec-Deprecated80/MorphicCodeAdapter.extension.st @@ -0,0 +1,7 @@ +Extension { #name : #MorphicCodeAdapter } + +{ #category : #'*Spec-Deprecated80' } +MorphicCodeAdapter >> isAboutToStyle [ + self deprecated: 'Use #okToStle instead' transformWith: '`@receiver isAboutToStyle' -> '`@receiver okToStyle'. + ^ self okToStyle +] diff --git a/src/Spec-Examples/InputTextDropList.extension.st b/src/Spec-Examples/InputTextDropList.extension.st index 8ab148f080c..e4f0a5a6e76 100644 --- a/src/Spec-Examples/InputTextDropList.extension.st +++ b/src/Spec-Examples/InputTextDropList.extension.st @@ -3,12 +3,14 @@ Extension { #name : #InputTextDropList } { #category : #'*Spec-Examples' } InputTextDropList class >> example [ - ^ self new + | example | + example := self new placeholder: 'a Number'; displayBlock: [ :item | item asString ]; items: {'Potatoes' . 'Carrots' . 'Onions'}; extent: 350 @ 50; - title: 'InputTextDropList example'; openWithSpec; - yourself + yourself. + example withWindowDo: [ :window | window title: 'InputTextDropList example' ]. + ^ example ] diff --git a/src/Spec-Examples/LabelledContainer.extension.st b/src/Spec-Examples/LabelledContainer.extension.st index 0df2a63149f..9a9e3b44405 100644 --- a/src/Spec-Examples/LabelledContainer.extension.st +++ b/src/Spec-Examples/LabelledContainer.extension.st @@ -4,9 +4,7 @@ Extension { #name : #LabelledContainer } LabelledContainer class >> abstractExample [ | example | example := self new. - example - title: self name asString , ' example'; - label: 'I am a label'. + example label: 'I am a label'. ^ example ] @@ -15,9 +13,14 @@ LabelledContainer class >> example [ | example | example := self abstractExample. - example content: ButtonPresenter. - example subwidget - label: 'I am a button'. + self setUpExample: example. example openDialogWithSpec. + example withWindowDo: [ :window | window title: self name asString , ' example' ]. ^ example ] + +{ #category : #'*Spec-Examples' } +LabelledContainer class >> setUpExample: example [ + example content: ButtonPresenter. + example subwidget label: 'I am a button' +] diff --git a/src/Spec-Examples/LabelledDropList.extension.st b/src/Spec-Examples/LabelledDropList.extension.st index 9d166f7e1bb..3749a7d6d15 100644 --- a/src/Spec-Examples/LabelledDropList.extension.st +++ b/src/Spec-Examples/LabelledDropList.extension.st @@ -3,12 +3,13 @@ Extension { #name : #LabelledDropList } { #category : #'*Spec-Examples' } LabelledDropList class >> example [ - | example | - example := self abstractExample. -example + ^ super example +] + +{ #category : #'*Spec-Examples' } +LabelledDropList class >> setUpExample: example [ + example items: {'item 1' . 'item 2'}; displayBlock: [ :item | item asString ]; - extent: 400 @ 50; - openWithSpec. - ^ example + extent: 400 @ 50 ] diff --git a/src/Spec-Examples/LabelledList.extension.st b/src/Spec-Examples/LabelledList.extension.st index 0f945acbed4..f3ba771b410 100644 --- a/src/Spec-Examples/LabelledList.extension.st +++ b/src/Spec-Examples/LabelledList.extension.st @@ -3,10 +3,10 @@ Extension { #name : #LabelledList } { #category : #'*Spec-Examples' } LabelledList class >> example [ - | example | - example := self abstractExample. - example - items: {'item 1' . 'item 2'}; - openWithSpec. - ^ example + ^ super example +] + +{ #category : #'*Spec-Examples' } +LabelledList class >> setUpExample: example [ + example items: {'item 1' . 'item 2'} ] diff --git a/src/Spec-Examples/LabelledSliderInput.extension.st b/src/Spec-Examples/LabelledSliderInput.extension.st index 3556f35059e..266fded126f 100644 --- a/src/Spec-Examples/LabelledSliderInput.extension.st +++ b/src/Spec-Examples/LabelledSliderInput.extension.st @@ -3,14 +3,15 @@ Extension { #name : #LabelledSliderInput } { #category : #'*Spec-Examples' } LabelledSliderInput class >> example [ - | example | - example := self new + ^ super example +] + +{ #category : #'*Spec-Examples' } +LabelledSliderInput class >> setUpExample: example [ + example min: 0; max: 250; autoAccept: true; value: 120; - extent: 400 @ 50; - title: 'LabelledSliderInput example'; - openWithSpec. - ^ example + extent: 400 @ 50 ] diff --git a/src/Spec-Examples/LabelledTextInput.extension.st b/src/Spec-Examples/LabelledTextInput.extension.st index cd4fb3981c6..682568444bf 100644 --- a/src/Spec-Examples/LabelledTextInput.extension.st +++ b/src/Spec-Examples/LabelledTextInput.extension.st @@ -3,11 +3,11 @@ Extension { #name : #LabelledTextInput } { #category : #'*Spec-Examples' } LabelledTextInput class >> example [ - | example | - example := self abstractExample. + ^ super example +] + +{ #category : #'*Spec-Examples' } +LabelledTextInput class >> setUpExample: example [ example input placeholder: 'Tilt'. - example - extent: 400 @ 50; - openWithSpec. - ^ example + example extent: 400 @ 50 ] diff --git a/src/Spec-Examples/MessageBrowser.extension.st b/src/Spec-Examples/MessageBrowser.extension.st new file mode 100644 index 00000000000..74610880149 --- /dev/null +++ b/src/Spec-Examples/MessageBrowser.extension.st @@ -0,0 +1,6 @@ +Extension { #name : #MessageBrowser } + +{ #category : #'*Spec-Examples' } +MessageBrowser class >> example [ + self browseSendersOf: #flag: +] diff --git a/src/Spec-Examples/MethodBrowser.class.st b/src/Spec-Examples/MethodBrowser.class.st index 7e9091b50be..15cf71b00df 100644 --- a/src/Spec-Examples/MethodBrowser.class.st +++ b/src/Spec-Examples/MethodBrowser.class.st @@ -97,8 +97,7 @@ MethodBrowser >> initializeWidgets [ self focusOrder add: listModel; add: toolbarModel; - add: textModel. - textModel aboutToStyle: true + add: textModel ] { #category : #accessing } diff --git a/src/Spec-Examples/RGBSliders.extension.st b/src/Spec-Examples/RGBSliders.extension.st index b0e931baff3..fd225a1155e 100644 --- a/src/Spec-Examples/RGBSliders.extension.st +++ b/src/Spec-Examples/RGBSliders.extension.st @@ -4,10 +4,10 @@ Extension { #name : #RGBSliders } RGBSliders class >> example [ | example | - example := self new. - example - title: 'RGBSliders example'; + example := self new extent: 300 @ 200; - openDialogWithSpec. + openDialogWithSpec; + yourself. + example withWindowDo: [ :window | window title: 'RGBSliders example' ]. ^ example ] diff --git a/src/Spec-Examples/RGBWidget.extension.st b/src/Spec-Examples/RGBWidget.extension.st index 16cbbc988fc..2e0c3f6f9cd 100644 --- a/src/Spec-Examples/RGBWidget.extension.st +++ b/src/Spec-Examples/RGBWidget.extension.st @@ -4,10 +4,10 @@ Extension { #name : #RGBWidget } RGBWidget class >> example [ | example | - example := self new. - example - title: 'RGBWidget exampe'; + example := self new extent: 300 @ 250; - openDialogWithSpec. + openDialogWithSpec; + yourself. + example withWindowDo: [ :window | window title: 'RGBWidget example' ]. ^ example ] diff --git a/src/Spec-Examples/SliderInput.extension.st b/src/Spec-Examples/SliderInput.extension.st index 6ac3c56fd2f..9ac38740323 100644 --- a/src/Spec-Examples/SliderInput.extension.st +++ b/src/Spec-Examples/SliderInput.extension.st @@ -10,7 +10,7 @@ SliderInput class >> example [ autoAccept: true; value: 120; extent: 400 @ 50; - title: 'SliderInput example'; openWithSpec. + example withWindowDo: [ :window | window title: 'SliderInput example' ]. ^ example ] diff --git a/src/Spec-Examples/TreeTablePresenter.extension.st b/src/Spec-Examples/TreeTablePresenter.extension.st index bcb7246b61b..88ad4f0d5a2 100644 --- a/src/Spec-Examples/TreeTablePresenter.extension.st +++ b/src/Spec-Examples/TreeTablePresenter.extension.st @@ -3,19 +3,21 @@ Extension { #name : #TreeTablePresenter } { #category : #'*Spec-Examples' } TreeTablePresenter class >> example [ - ^ self new - addColumn: (CompositeTableColumn new - title: 'Classes'; - addColumn: (ImageTableColumn new - width: 20; - evaluated: #systemIcon; - yourself); - addColumn: (StringTableColumn new - evaluated: #name; + addColumn: + (CompositeTableColumn new + title: 'Classes'; + addColumn: + (ImageTableColumn new + width: 20; + evaluated: #systemIcon; + yourself); + addColumn: + (StringTableColumn new + evaluated: #name; + yourself); yourself); - yourself); - roots: { Object }; + roots: {Object}; children: [ :aClass | aClass subclasses ]; openWithSpec ] diff --git a/src/Spec-Inspector/EyeAbstractInspector.class.st b/src/Spec-Inspector/EyeAbstractInspector.class.st index 9e945fd9b01..ceb762aea8e 100644 --- a/src/Spec-Inspector/EyeAbstractInspector.class.st +++ b/src/Spec-Inspector/EyeAbstractInspector.class.st @@ -84,8 +84,7 @@ EyeAbstractInspector >> initialize [ { #category : #initialization } EyeAbstractInspector >> initializePresenter [ object whenChangedDo: [ self objectChanged ]. - self text - whenBuiltDo: [ :w | w widget editingMode classOrMetaClass: self object class ]. + self text whenBuiltDo: [ :w | self text behavior: self object class ]. self initializeShortcuts ] @@ -220,9 +219,7 @@ EyeAbstractInspector >> shortCuts [ { #category : #accessing } EyeAbstractInspector >> text [ - ^ text ifNil: [ - text := self newCode. - text aboutToStyle: true. ] + ^ text ifNil: [ text := self newCode ] ] { #category : #accessing } diff --git a/src/Spec-Inspector/EyeInspector.class.st b/src/Spec-Inspector/EyeInspector.class.st index 1a2def1729a..79808a1993a 100644 --- a/src/Spec-Inspector/EyeInspector.class.st +++ b/src/Spec-Inspector/EyeInspector.class.st @@ -186,7 +186,7 @@ EyeInspector >> doItContext [ { #category : #accessing } EyeInspector >> elements [ - ^ self list model shownItems + ^ self list items ] { #category : #inspecting } @@ -301,8 +301,7 @@ EyeInspector >> objectChanged [ self description doItReceiver: self object. self text doItContext: self doItContext. self description doItContext: self doItContext. - self text adapter - ifNotNil: [ :w | w editingMode classOrMetaClass: self objectClass ] + self text ifNotNil: [ :w | w behavior: self objectClass ] ] { #category : #accessing } @@ -478,7 +477,7 @@ EyeInspector >> updateList [ | elements | " self haltOnce." elements := self generateElements. - self list model shownItems = elements + self list items = elements ifTrue: [ ^ self ]. "first reset the items to make sure we don't interfere with the display block" "self list items: #()." @@ -486,7 +485,7 @@ EyeInspector >> updateList [ self list items: elements. "handle when last item of list is removed" - self list selection selectedIndex > self list model shownItems size + self list selection selectedIndex > self list items size ifTrue: [ self list setSelectedIndex: self list listItems size ]. "handle when selected dictionary key is removed" diff --git a/src/Spec-Inspector/EyePointerExplorer.class.st b/src/Spec-Inspector/EyePointerExplorer.class.st index ad4a39af95f..aa86832fc5d 100644 --- a/src/Spec-Inspector/EyePointerExplorer.class.st +++ b/src/Spec-Inspector/EyePointerExplorer.class.st @@ -75,8 +75,7 @@ EyePointerExplorer >> object: anObject [ { #category : #'event-handling' } EyePointerExplorer >> objectChanged [ self text doItReceiver: self object. - self text widget - ifNotNil: [ :w | w editingMode classOrMetaClass: self object class ]. + self text ifNotNil: [ :w | w behavior: self object class ]. self tree roots: self roots ] diff --git a/src/Spec-Inspector/EyeTreeInspector.class.st b/src/Spec-Inspector/EyeTreeInspector.class.st index 86acfd9829f..f26a928f4e7 100644 --- a/src/Spec-Inspector/EyeTreeInspector.class.st +++ b/src/Spec-Inspector/EyeTreeInspector.class.st @@ -40,10 +40,7 @@ EyeTreeInspector >> childrenForObject: anObject [ { #category : #'event-handling' } EyeTreeInspector >> elementChanged [ self text doItReceiver: self selectedElement value. - self text adapter - ifNotNil: [ :w | - w widget editingMode - classOrMetaClass: self selectedElement value class ] + self text ifNotNil: [ :w | w behavior: self selectedElement value class ] ] { #category : #api } @@ -93,8 +90,7 @@ EyeTreeInspector >> labelFor: anEyeElement [ { #category : #'event-handling' } EyeTreeInspector >> objectChanged [ self text doItReceiver: self object. - self text adapter - ifNotNil: [ :w | w editingMode classOrMetaClass: self object class ]. + self text ifNotNil: [ :w | w behavior: self object class ]. self tree roots: self roots; expandRoots diff --git a/src/Spec-MorphicAdapters/FTBasicItem.extension.st b/src/Spec-MorphicAdapters/FTBasicItem.extension.st index e33cb081a58..8a08354fe7e 100644 --- a/src/Spec-MorphicAdapters/FTBasicItem.extension.st +++ b/src/Spec-MorphicAdapters/FTBasicItem.extension.st @@ -2,13 +2,11 @@ Extension { #name : #FTBasicItem } { #category : #'*Spec-MorphicAdapters' } FTBasicItem >> expandedChildren [ - - self isExpanded ifFalse: [ ^ #() ]. - ^ self children , (self children flatCollect: [ :e | e expandedChildren ]) + self isExpanded ifFalse: [ ^ { self } ]. + ^ {self} , (self children flatCollect: [ :e | e expandedChildren ]) ] { #category : #'*Spec-MorphicAdapters' } FTBasicItem >> withExpandedChildren [ - - ^ { self } , self expandedChildren + ^ self expandedChildren ] diff --git a/src/Spec-MorphicAdapters/MorphicBaseMenuAdapter.class.st b/src/Spec-MorphicAdapters/MorphicBaseMenuAdapter.class.st index 8513c89cfbb..95bcc383a7e 100644 --- a/src/Spec-MorphicAdapters/MorphicBaseMenuAdapter.class.st +++ b/src/Spec-MorphicAdapters/MorphicBaseMenuAdapter.class.st @@ -15,6 +15,7 @@ MorphicBaseMenuAdapter >> icon [ { #category : #protocol } MorphicBaseMenuAdapter >> menuGroups [ + ^ self model menuGroups reject: [ :e | e isEmpty ] ] diff --git a/src/Spec-MorphicAdapters/MorphicCodeAdapter.class.st b/src/Spec-MorphicAdapters/MorphicCodeAdapter.class.st index 63d4ee7f966..66e76c8326a 100644 --- a/src/Spec-MorphicAdapters/MorphicCodeAdapter.class.st +++ b/src/Spec-MorphicAdapters/MorphicCodeAdapter.class.st @@ -10,6 +10,16 @@ MorphicCodeAdapter >> behavior [ ^ self model behavior ] +{ #category : #factory } +MorphicCodeAdapter >> buildWidget [ + | newWidget | + newWidget := super buildWidget. + + self presenter whenSyntaxHighlightChangedDo: [ :hasSyntaxHighlight | self setEditingModeFor: newWidget ]. + + ^ newWidget +] + { #category : #'private-shout' } MorphicCodeAdapter >> classOrMetaClass: aClass [ @@ -36,16 +46,9 @@ MorphicCodeAdapter >> guessTypeForName: aString [ ^nil ] -{ #category : #initialization } -MorphicCodeAdapter >> initialize [ - - super initialize. -] - -{ #category : #shout } -MorphicCodeAdapter >> isAboutToStyle [ - - ^ self okToStyle +{ #category : #private } +MorphicCodeAdapter >> hasSyntaxHighlight [ + ^ self model hasSyntaxHighlight ] { #category : #NOCompletion } @@ -54,12 +57,6 @@ MorphicCodeAdapter >> isCodeCompletionAllowed [ ^ true ] -{ #category : #'private-shout' } -MorphicCodeAdapter >> okToStyle [ - - ^ self model hasSyntaxHighlight -] - { #category : #NOCompletion } MorphicCodeAdapter >> receiverClass [ @@ -79,9 +76,10 @@ MorphicCodeAdapter >> selectedClassOrMetaClass [ ] { #category : #private } -MorphicCodeAdapter >> setEditingModeFor: textArea [ - - self setEditingModeFor: textArea withBehavior: self behavior +MorphicCodeAdapter >> setEditingModeFor: textArea [ + self hasSyntaxHighlight + ifTrue: [ self setEditingModeFor: textArea withBehavior: self behavior ] + ifFalse: [ super setEditingModeFor: textArea ] ] { #category : #private } @@ -92,12 +90,6 @@ MorphicCodeAdapter >> setEditingModeFor: textArea withBehavior: aBehavior [ ifNil: [ textArea beForSmalltalkScripting ] ] -{ #category : #shout } -MorphicCodeAdapter >> shoutAboutToStyle: aMorph [ - - ^ self isAboutToStyle -] - { #category : #private } MorphicCodeAdapter >> textWithStyle [ "This method is to be used for testing. diff --git a/src/Spec-MorphicAdapters/MorphicImageAdapter.class.st b/src/Spec-MorphicAdapters/MorphicImageAdapter.class.st index 691779112f8..7444a028da3 100644 --- a/src/Spec-MorphicAdapters/MorphicImageAdapter.class.st +++ b/src/Spec-MorphicAdapters/MorphicImageAdapter.class.st @@ -26,19 +26,17 @@ MorphicImageAdapter >> buildWidget [ getImageSelector: #getImage; vResizing: #spaceFill; hResizing: #spaceFill; - layout: (self model autoScale - ifTrue: [ #scaledAspect ] - ifFalse: [ #center ]); + layout: self layoutValue; dragEnabled: self dragEnabled; dropEnabled: self dropEnabled; setBalloonText: self help; update: #getImage. - + self model whenImageChangeDo: [ - (self getImage) - ifNotNil: [ :x | alphaImage image: x ] - ifNil: [ alphaImage image: (Form extent: 1@1 depth: 32)] ]. - + self getImage + ifNotNil: [ :x | alphaImage image: x ] + ifNil: [ alphaImage image: (Form extent: 1 @ 1 depth: 32) ] ]. + ^ alphaImage ] @@ -61,10 +59,13 @@ MorphicImageAdapter >> image [ ] { #category : #'widget protocol' } -MorphicImageAdapter >> switchAutoscale [ - | layoutValue | - layoutValue := self model autoScale +MorphicImageAdapter >> layoutValue [ + ^ self model autoScale ifTrue: [ #scaledAspect ] - ifFalse: [ #center ]. - self widgetDo: [ :w | w layout: layoutValue ] + ifFalse: [ #center ] +] + +{ #category : #'widget protocol' } +MorphicImageAdapter >> switchAutoscale [ + self widgetDo: [ :w | w layout: self layoutValue ] ] diff --git a/src/Spec-MorphicAdapters/MorphicListAdapter.class.st b/src/Spec-MorphicAdapters/MorphicListAdapter.class.st index ce7164bff82..3746872d18e 100644 --- a/src/Spec-MorphicAdapters/MorphicListAdapter.class.st +++ b/src/Spec-MorphicAdapters/MorphicListAdapter.class.st @@ -37,47 +37,40 @@ MorphicListAdapter >> backgroundColorFor: anItem at: index [ { #category : #factory } MorphicListAdapter >> buildWidget [ | datasource | - datasource := SpecListFastTableDataSource new. datasource model: self model. widget := FTTableMorph new dataSource: datasource; hideColumnHeaders; beResizable; - columns: { self newListColumn }; + columns: {self newListColumn}; setMultipleSelection: self model isMultipleSelection; dragEnabled: self dragEnabled; dropEnabled: self dropEnabled; setBalloonText: self help; hResizing: #spaceFill; vResizing: #spaceFill; - onAnnouncement: FTSelectionChanged - send: #selectionChanged: - to: self; - onAnnouncement: FTStrongSelectionChanged - send: #strongSelectionChanged: - to: self; + onAnnouncement: FTSelectionChanged send: #selectionChanged: to: self; + onAnnouncement: FTStrongSelectionChanged send: #strongSelectionChanged: to: self; yourself. self presenter whenModelChangedDo: [ widget refresh ]. - self presenter - whenSelectionChangedDo: [ self refreshWidgetSelection ]. - self presenter selection - whenChangedDo: [ self refreshWidgetSelection ]. + self presenter whenSelectionChangedDo: [ self refreshWidgetSelection ]. + self presenter selection whenChangedDo: [ self refreshWidgetSelection ]. self refreshWidgetHeaderTitle. self refreshWidgetSelection. - self itemFilterBlock - ifNotNil: [ :block | - widget - enableFilter: (FTSpecFilter block: block); - explicitFunction ]. - - widget - bindKeyCombination: Character space - toAction: [ self model clickOnSelectedItem ]. - + self presenter whenItemFilterBlockChangedDo: [ :block | self updateItemFilterBlockWith: block ]. + self updateItemFilterBlockWith: self itemFilterBlock. + + widget bindKeyCombination: Character space toAction: [ self model clickOnSelectedItem ]. + ^ widget ] +{ #category : #emulating } +MorphicListAdapter >> hasFilter [ + ^ self widget submorphs anySatisfy: [ :each | each isKindOf: RubTextFieldMorph "This morph is the explicit filter of the list" ] +] + { #category : #accessing } MorphicListAdapter >> isShowColumnHeaders [ @@ -207,6 +200,15 @@ MorphicListAdapter >> strongSelectionChanged: aFTStrongSelectionChanged [ doubleClickAtIndex: aFTStrongSelectionChanged selectedIndex ] ] +{ #category : #factory } +MorphicListAdapter >> updateItemFilterBlockWith: block [ + ^ block + ifNotNil: [ widget + enableFilter: (FTSpecFilter block: block); + explicitFunction ] + ifNil: [ widget disableFunction ] +] + { #category : #events } MorphicListAdapter >> updateMenu [ diff --git a/src/Spec-MorphicAdapters/MorphicMenuBarAdapter.class.st b/src/Spec-MorphicAdapters/MorphicMenuBarAdapter.class.st index fb040751aea..9f60c036aa8 100644 --- a/src/Spec-MorphicAdapters/MorphicMenuBarAdapter.class.st +++ b/src/Spec-MorphicAdapters/MorphicMenuBarAdapter.class.st @@ -15,7 +15,8 @@ MorphicMenuBarAdapter >> adoptMenuGroupModel: aGroupModel first: aBoolean [ addMorphBack: (self theme newToolSpacerIn: widget) ]. controls := OrderedCollection new. - aGroupModel menuItems do: [ :item | self adoptMenuItemModel: item accumulator: controls ]. + aGroupModel menuItems do: [ :item | + self adoptMenuItemModel: item accumulator: controls ]. self emptyAccumulator: controls ] @@ -41,6 +42,7 @@ MorphicMenuBarAdapter >> adoptMenuItemModel: item accumulator: controls [ { #category : #private } MorphicMenuBarAdapter >> buildButtonFor: item [ + ^ self theme newButtonIn: widget for: item @@ -59,13 +61,15 @@ MorphicMenuBarAdapter >> buildWidget [ vResizing: #spaceFill; yourself. - self menuGroups doWithIndex: [ :aGroup :index | self adoptMenuGroupModel: aGroup first: index = 1 ]. + self menuGroups doWithIndex: [ :aGroup :index | + self adoptMenuGroupModel: aGroup first: index = 1 ]. ^ widget ] { #category : #private } MorphicMenuBarAdapter >> emptyAccumulator: controls [ + controls do: [ :button | widget addMorphBack: button ]. controls removeAll ] diff --git a/src/Spec-MorphicAdapters/MorphicMorphAdapter.class.st b/src/Spec-MorphicAdapters/MorphicMorphAdapter.class.st new file mode 100644 index 00000000000..b5f05842738 --- /dev/null +++ b/src/Spec-MorphicAdapters/MorphicMorphAdapter.class.st @@ -0,0 +1,28 @@ +Class { + #name : #MorphicMorphAdapter, + #superclass : #AbstractMorphicAdapter, + #category : #'Spec-MorphicAdapters-Base' +} + +{ #category : #factory } +MorphicMorphAdapter >> buildWidget [ + | panel | + + panel := PanelMorph new + changeTableLayout; + hResizing: #spaceFill; + vResizing: #spaceFill; + color: Color transparent; + borderColor: Color transparent; + yourself. + + self presenter morph + ifNotNil: [ :morph | panel addMorphBack: morph ]. + self presenter + whenMorphChangedDo: [ :morph | + panel + removeAllMorphs; + addMorphBack: morph ]. + + ^ panel +] diff --git a/src/Spec-MorphicAdapters/MorphicTextAdapter.class.st b/src/Spec-MorphicAdapters/MorphicTextAdapter.class.st index e4bdce8fd78..d0ed3d652a9 100644 --- a/src/Spec-MorphicAdapters/MorphicTextAdapter.class.st +++ b/src/Spec-MorphicAdapters/MorphicTextAdapter.class.st @@ -59,14 +59,13 @@ MorphicTextAdapter >> autoAccept: aBoolean [ { #category : #factory } MorphicTextAdapter >> buildWidget [ | newWidget | - - newWidget := RubPluggableTextMorph new - on: self - text: #getText - accept: #accept:notifying: - readSelection: #readSelection - menu: #codePaneMenu:shifted: - setSelection: #setSelection:; + self flag: #pharo7. "When support for P7 will be dropped, remove this compatibility hack." + newWidget := ((self class environment at: #SpecRubScrolledTextMorph ifAbsent: [ RubScrolledTextMorph ]) on: self) + getTextSelector: #getText; + setTextSelector: #accept:notifying:; + getSelectionSelector: #readSelection; + menuProvider: self selector: #codePaneMenu:shifted:; + setSelectionSelector: #setSelection:; beWrapped; enabled: self enabled; askBeforeDiscardingEdits: self askBeforeDiscardingEdits; @@ -78,12 +77,9 @@ MorphicTextAdapter >> buildWidget [ dropEnabled: self dropEnabled; registerScrollChanges: #scrollValueChanged:; yourself. - self setEditingModeFor: newWidget. - self model additionalKeyBindings ifNotNil: [ :bindings | - bindings keysAndValuesDo: [ :shortcut :action | - newWidget bindKeyCombination: shortcut toAction: action ] ]. - + self model additionalKeyBindings ifNotNil: [ :bindings | bindings keysAndValuesDo: [ :shortcut :action | newWidget bindKeyCombination: shortcut toAction: action ] ]. + self presenter whenTextChangedDo: [ :text | newWidget setText: text ]. ^ newWidget ] @@ -94,7 +90,7 @@ MorphicTextAdapter >> canChangeText [ { #category : #'undo-redo' } MorphicTextAdapter >> clearUndoManager [ - self widget clearUndoManager + self widget textArea editingState clearUndoManager: nil ] { #category : #'widget API' } diff --git a/src/Spec-MorphicAdapters/MorphicTreeTableAdapter.class.st b/src/Spec-MorphicAdapters/MorphicTreeTableAdapter.class.st index 33c06fd6c25..05f871c5009 100644 --- a/src/Spec-MorphicAdapters/MorphicTreeTableAdapter.class.st +++ b/src/Spec-MorphicAdapters/MorphicTreeTableAdapter.class.st @@ -61,13 +61,15 @@ MorphicTreeTableAdapter >> addModelTo: tableMorph [ { #category : #factory } MorphicTreeTableAdapter >> basicSelectionChanged: ann [ - | diff selection | - + | selection | selection := self presenter selection. ann newSelectedIndexes ifEmpty: [ ^ selection unselectAll ]. - - diff := ann newSelectedIndexes difference: ann oldSelectedIndexes. - diff ifNotEmpty: [ selection selectPath: (self widget dataSource pathFromIndex: diff last) ] + (ann newSelectedIndexes difference: ann oldSelectedIndexes) ifEmpty: [ ^ self ]. + + selection + selectPaths: + (ann newSelectedIndexes + collect: [ :i | self widget dataSource pathFromIndex: i ]) ] { #category : #factory } diff --git a/src/Spec-MorphicAdapters/RubScrolledTextMorph.extension.st b/src/Spec-MorphicAdapters/RubScrolledTextMorph.extension.st index 194ba082356..5f204780b88 100644 --- a/src/Spec-MorphicAdapters/RubScrolledTextMorph.extension.st +++ b/src/Spec-MorphicAdapters/RubScrolledTextMorph.extension.st @@ -1,5 +1,10 @@ Extension { #name : #RubScrolledTextMorph } +{ #category : #'*Spec-MorphicAdapters' } +RubScrolledTextMorph >> registerScrollChanges: aSelector [ + self scrollPane announcer when: PaneScrolling send: aSelector to: self model +] + { #category : #'*Spec-MorphicAdapters' } RubScrolledTextMorph >> setSelectionSelector: aSelector [ setSelectionSelector := aSelector diff --git a/src/Spec-PolyWidgets-Tests/SearchableListTest.class.st b/src/Spec-PolyWidgets-Tests/SearchableListTest.class.st index 8d95187ee52..3791c864491 100644 --- a/src/Spec-PolyWidgets-Tests/SearchableListTest.class.st +++ b/src/Spec-PolyWidgets-Tests/SearchableListTest.class.st @@ -11,7 +11,7 @@ SearchableListTest >> classToTest [ { #category : #tests } SearchableListTest >> testFiltering [ - presenter listPresenter items: {'aa' . 'bb' . 'ab' . 'ba'}. + presenter items: {'aa' . 'bb' . 'ab' . 'ba'}. presenter searchPresenter text: 'a'. - self assert: presenter listPresenter model shownItems asArray equals: {'aa' . 'ab'} + self assertCollection: presenter listPresenter items hasSameElements: {'aa' . 'ab'} ] diff --git a/src/Spec-PolyWidgets/CalendarPresenter.class.st b/src/Spec-PolyWidgets/CalendarPresenter.class.st index d8aa521cb14..9435b0732bc 100644 --- a/src/Spec-PolyWidgets/CalendarPresenter.class.st +++ b/src/Spec-PolyWidgets/CalendarPresenter.class.st @@ -124,9 +124,7 @@ CalendarPresenter >> daysToDisplayCount [ { #category : #initialization } CalendarPresenter >> initialize [ super initialize. - self - title: 'Calendar' translated; - whenDaySelectedBlock: [ :aDate | ] + self whenDaySelectedBlock: [ :aDate | ] ] { #category : #initialization } @@ -145,6 +143,11 @@ CalendarPresenter >> initializeWidgets [ daysButtons := self newNullPresenter ] +{ #category : #initialization } +CalendarPresenter >> initializeWindow: aWindowPresenter [ + aWindowPresenter title: 'Calendar' +] + { #category : #private } CalendarPresenter >> julianDaysIntervalFor: aDate [ "Returns an interval of integers with the first one being the first day to display in the UI and the last integer the last day. diff --git a/src/Spec-PolyWidgets/EditableList.class.st b/src/Spec-PolyWidgets/EditableList.class.st index c23fc6234a1..916ecd799bd 100644 --- a/src/Spec-PolyWidgets/EditableList.class.st +++ b/src/Spec-PolyWidgets/EditableList.class.st @@ -164,10 +164,10 @@ EditableList >> list: aList [ { #category : #private } EditableList >> moveElementAt: index to: newIndex [ | elementToMove orderedList | - (newIndex < 1 or: [ newIndex > list model shownItems size ]) + (newIndex < 1 or: [ newIndex > list items size ]) ifTrue: [ ^ self ]. - elementToMove := list model shownItems at: index. - orderedList := list model items copy asOrderedCollection + elementToMove := list itemAt: index. + orderedList := list items copy asOrderedCollection removeAt: index; add: elementToMove beforeIndex: newIndex; yourself. diff --git a/src/Spec-PolyWidgets/LabelledList.class.st b/src/Spec-PolyWidgets/LabelledList.class.st index 9c68e1b86cf..5c5e86d23c4 100644 --- a/src/Spec-PolyWidgets/LabelledList.class.st +++ b/src/Spec-PolyWidgets/LabelledList.class.st @@ -24,11 +24,6 @@ LabelledList >> displayBlock: aBlock [ ^self list displayBlock: aBlock ] -{ #category : #'api-shortcuts' } -LabelledList >> filteringBlock: aBlock [ - ^ self list filteringBlock: aBlock -] - { #category : #initialization } LabelledList >> initializeWidgets [ super initializeWidgets. diff --git a/src/Spec-PolyWidgets/RGBSliders.class.st b/src/Spec-PolyWidgets/RGBSliders.class.st index 561285b6b45..930ab2cb84d 100644 --- a/src/Spec-PolyWidgets/RGBSliders.class.st +++ b/src/Spec-PolyWidgets/RGBSliders.class.st @@ -16,7 +16,7 @@ Class { 'greenSlider', 'blueSlider' ], - #category : #'Spec-PolyWidgets-Support' + #category : #'Spec-PolyWidgets-RGB' } { #category : #specs } diff --git a/src/Spec-PolyWidgets/RGBWidget.class.st b/src/Spec-PolyWidgets/RGBWidget.class.st index 684a0401910..072776f3647 100644 --- a/src/Spec-PolyWidgets/RGBWidget.class.st +++ b/src/Spec-PolyWidgets/RGBWidget.class.st @@ -19,7 +19,7 @@ Class { 'sliders', 'extentForPreview' ], - #category : #'Spec-PolyWidgets-RGBAndShape' + #category : #'Spec-PolyWidgets-RGB' } { #category : #specs } diff --git a/src/Spec-PolyWidgets/SearchableList.class.st b/src/Spec-PolyWidgets/SearchableList.class.st index 7c6696d4d29..5dadc64e0ab 100644 --- a/src/Spec-PolyWidgets/SearchableList.class.st +++ b/src/Spec-PolyWidgets/SearchableList.class.st @@ -13,7 +13,8 @@ Class { #superclass : #ComposablePresenter, #instVars : [ 'listPresenter', - 'searchPresenter' + 'searchPresenter', + 'baseItems' ], #category : #'Spec-PolyWidgets-ListAndTree' } @@ -30,14 +31,11 @@ SearchableList class >> defaultSpec [ { #category : #initialization } SearchableList >> initializePresenter [ searchPresenter - whenTextChangedDo: [ :newText | - | text | - text := searchPresenter getText asLowercase. - text isEmpty - ifTrue: [ listPresenter model resetFilter ] - ifFalse: [ listPresenter model - filterWith: - [ :element :col | element asLowercase beginsWith: searchPresenter getText asLowercase ] ] ] + whenTextChangedDo: + [ :newText | + searchPresenter getText asLowercase + ifEmpty: [ listPresenter items: baseItems ] + ifNotEmpty: [ :text | listPresenter items: (baseItems select: [ :element | element asLowercase beginsWith: text ]) ] ] ] { #category : #initialization } @@ -46,11 +44,12 @@ SearchableList >> initializeWidgets [ searchPresenter := self newTextInput. searchPresenter autoAccept: true; - placeholder: 'filter' + placeholder: 'Filter' ] { #category : #accessing } SearchableList >> items: aCollection [ + baseItems := aCollection. listPresenter items: aCollection ] diff --git a/src/Spec-Tests/CodePresenterTest.class.st b/src/Spec-Tests/CodePresenterTest.class.st index 4ea407e5048..0ea6e59e4b7 100644 --- a/src/Spec-Tests/CodePresenterTest.class.st +++ b/src/Spec-Tests/CodePresenterTest.class.st @@ -29,3 +29,17 @@ CodePresenterTest >> testContextMenu [ self assert: presenter contextMenu equals: menu. self assert: changed ] + +{ #category : #tests } +CodePresenterTest >> testWhenSyntaxHighlightChangedDo [ + | count result | + count := 0. + result := true. + presenter + whenSyntaxHighlightChangedDo: [ :syntaxHighlight | + count := count + 1. + result := syntaxHighlight ]. + presenter withoutSyntaxHighlight. + self assert: count equals: 1. + self deny: result +] diff --git a/src/Spec-Tests/SpecVersatileDialogPresenterTest.class.st b/src/Spec-Tests/SpecVersatileDialogPresenterTest.class.st index 047b2959a55..faf815c9f42 100644 --- a/src/Spec-Tests/SpecVersatileDialogPresenterTest.class.st +++ b/src/Spec-Tests/SpecVersatileDialogPresenterTest.class.st @@ -11,30 +11,30 @@ SpecVersatileDialogPresenterTest >> classToTest [ { #category : #tests } SpecVersatileDialogPresenterTest >> testListBox [ - | dialog app listPresenter | - app := MockApplication new. - + dialog := SpecVersatileDialogPresenter newApplication: app. - dialog title: 'Confirmation'. listPresenter := dialog newList. listPresenter items: #(one two three). dialog contentArea: listPresenter. - dialog addButton: #ok text: 'OK' value: #ok condition: [ listPresenter selection isEmpty not ]. + dialog + addButton: #ok + text: 'OK' + value: #ok + condition: [ listPresenter selection isEmpty not ]. dialog addButton: #cancel text: 'Cancel' value: nil. dialog mainIcon: (self iconNamed: #question). - dialog openModalWithSpec. - + dialog openModalWithSpec. + dialog withWindowDo: [ :w | w title: 'Confirmation' ]. + dialog contentArea selection selectIndex: 2. (dialog buttons at: #ok) click. - self assert: dialog result equals: #ok. - self assert: dialog contentArea selection selectedItem equals: #two. - - + self assert: dialog result equals: #ok. + self assert: dialog contentArea selection selectedItem equals: #two ] { #category : #tests } @@ -45,7 +45,6 @@ SpecVersatileDialogPresenterTest >> testResult [ app := MockApplication new. dialog := SpecVersatileDialogPresenter newApplication: app. - dialog title: 'Confirmation'. dialog mainMessage: 'Save content' asText allBold. dialog addButton: #save text: 'Save' value: true. dialog addButton: #cancel text: 'Cancel' value: false. @@ -53,6 +52,7 @@ SpecVersatileDialogPresenterTest >> testResult [ dialog moreOptionsArea: (dialog newCheckBox label: 'Save header'). dialog openModalWithSpec. + dialog withWindowDo: [ :w | w title: 'Confirmation' ]. (dialog buttons at: #save) performAction. dialog moreOptionsArea click. diff --git a/src/Spec-Tests/SpecWindowTest.class.st b/src/Spec-Tests/SpecWindowTest.class.st index 35f6a5a88f6..cbcd5cf165c 100644 --- a/src/Spec-Tests/SpecWindowTest.class.st +++ b/src/Spec-Tests/SpecWindowTest.class.st @@ -12,13 +12,17 @@ Class { { #category : #tests } SpecWindowTest >> testAboutText [ + | presenter window | windowPresenter := WindowPresenter new. windowPresenter aboutText: 'test'. self assert: windowPresenter aboutText equals: 'test'. windowPresenter close. - - windowPresenter := TextPresenter new aboutText: 'test2'. - self assert: windowPresenter aboutText equals: 'test2' + + presenter := TextPresenter new. + [ window := presenter openWithSpec. + presenter withWindowDo: [ :w | w aboutText: 'test2' ]. + self assert: presenter window aboutText equals: 'test2' ] + ensure: [ window ifNotNil: #delete ] ] { #category : #tests } @@ -39,12 +43,16 @@ SpecWindowTest >> testIsDisplayed [ { #category : #tests } SpecWindowTest >> testTitle [ + | presenter window | windowPresenter := TextPresenter new openWithSpec. - + self assert: windowPresenter isDisplayed. self assert: windowPresenter title equals: 'Text'. - - windowPresenter title: 'Test Window'. - self assert: windowPresenter title equals: 'Test Window'. - windowPresenter close + windowPresenter close. + + presenter := TextPresenter new. + [ window := presenter openWithSpec. + presenter withWindowDo: [ :w | w title: 'Test Window' ]. + self assert: presenter window title equals: 'Test Window' ] + ensure: [ window ifNotNil: #delete ] ] diff --git a/src/Spec-Tools/AbstractMessageCentricBrowser.class.st b/src/Spec-Tools/AbstractMessageCentricBrowser.class.st new file mode 100644 index 00000000000..90d7077f43e --- /dev/null +++ b/src/Spec-Tools/AbstractMessageCentricBrowser.class.st @@ -0,0 +1,57 @@ +" +I am an abstrct class for browsers centered around messages such as MessageBrowser or VersionBrowser. +" +Class { + #name : #AbstractMessageCentricBrowser, + #superclass : #ComposablePresenter, + #instVars : [ + 'messageList', + 'textConverter', + 'toolbarPresenter' + ], + #category : #'Spec-Tools-VersionBrowser' +} + +{ #category : #initialization } +AbstractMessageCentricBrowser >> initialize [ + textConverter := SourceMethodConverter new. + super initialize +] + +{ #category : #initialization } +AbstractMessageCentricBrowser >> initializeWidgets [ + messageList := self instantiate: MessageList. + toolbarPresenter := self instantiate: MethodToolbar +] + +{ #category : #initialization } +AbstractMessageCentricBrowser >> initializeWindow: aWindowPresenter [ + aWindowPresenter initialExtent: (900 min: World extent x) @ (550 min: World extent y) +] + +{ #category : #private } +AbstractMessageCentricBrowser >> isMethodDefinition: anItem [ + "an item can be nil, a compiled method, or a ring object. Whereas a ring object can be a ring method or comment definition. + Some operations are only valid for compiled methods or ring object that are a method definitions" + + anItem ifNil: [ ^ false ]. + + "assume it is a compiled method or ring method definition" + ^ (anItem isRingObject and: [ anItem isMethod and: [ anItem compiledMethod isNotNil ] ]) + or: [ anItem isCompiledMethod ] +] + +{ #category : #api } +AbstractMessageCentricBrowser >> selectedMessage [ + ^ messageList selectedMessage +] + +{ #category : #accessing } +AbstractMessageCentricBrowser >> textConverter [ + ^ textConverter +] + +{ #category : #accessing } +AbstractMessageCentricBrowser >> textConverter: aTextConverter [ + textConverter := aTextConverter method: self textConverter method +] diff --git a/src/Spec-Tools/ChangeSorterModel.class.st b/src/Spec-Tools/ChangeSorterModel.class.st index f7d1f7ffd54..7350eb8d729 100644 --- a/src/Spec-Tools/ChangeSorterModel.class.st +++ b/src/Spec-Tools/ChangeSorterModel.class.st @@ -4,9 +4,40 @@ A ChangeSorterModel is a model used by Change Sorter UIs for computation Class { #name : #ChangeSorterModel, #superclass : #AbstractTool, + #classVars : [ + 'ClassDescriptionsMap' + ], #category : #'Spec-Tools-ChangeSorter' } +{ #category : #accessing } +ChangeSorterModel class >> classDescriptionsMap [ + ^ ClassDescriptionsMap +] + +{ #category : #accessing } +ChangeSorterModel class >> classDescriptionsMap: anObject [ + ClassDescriptionsMap := anObject +] + +{ #category : #default } +ChangeSorterModel class >> defaultClassDescriptionsMap [ + ^ Dictionary new + at: #remove put: 'Entire class was removed.'; + at: #addedThenRemoved put: 'Class was added then removed.'; + at: #rename put: 'Class name was changed.'; + at: #add put: 'Class definition was added.'; + at: #change put: 'Class definition was changed.'; + at: #reorganize put: 'Class organization was changed.'; + at: #comment put: 'New class comment.'; + yourself +] + +{ #category : #'class initialization' } +ChangeSorterModel class >> initialize [ + self classDescriptionsMap: self defaultClassDescriptionsMap +] + { #category : #'change set' } ChangeSorterModel >> addPreambleTo: aChangeSet [ @@ -29,26 +60,10 @@ ChangeSorterModel >> buildChangeSetDescriptionFor: changeSet [ { #category : #text } ChangeSorterModel >> buildClassDescriptionFor: changeSet class: class [ - | stream | - - stream := (String new: 100) writeStream. - (changeSet classChangeAt: class name) - do: [:each | - each = #remove - ifTrue: [ stream nextPutAll: 'Entire class was removed.'; cr ]. - each = #addedThenRemoved - ifTrue: [ stream nextPutAll: 'Class was added then removed.'; cr ]. - each = #rename - ifTrue: [ stream nextPutAll: 'Class name was changed.'; cr ]. - each = #add - ifTrue: [ stream nextPutAll: 'Class definition was added.'; cr ]. - each = #change - ifTrue: [ stream nextPutAll: 'Class definition was changed.'; cr ]. - each = #reorganize - ifTrue: [ stream nextPutAll: 'Class organization was changed.'; cr ]. - each = #comment - ifTrue: [ stream nextPutAll: 'New class comment.'; cr ]]. - ^ stream contents + ^ String streamContents: [ :stream | + (changeSet classChangeAt: class name) + do: [ :each | stream nextPutAll: (self classDescriptionsMap at: each) ] + separatedBy: [ stream cr ] ] ] { #category : #text } @@ -70,6 +85,11 @@ ChangeSorterModel >> buildSelectorDescriptionFor: changeSet class: class selecto ^ code asText ] +{ #category : #accessing } +ChangeSorterModel >> classDescriptionsMap [ + ^ self class classDescriptionsMap +] + { #category : #'change set' } ChangeSorterModel >> copyAllChangesFrom: source to: destination [ diff --git a/src/Spec-Tools/ChangeSorterPresenter.class.st b/src/Spec-Tools/ChangeSorterPresenter.class.st index 504c25671b8..dadc0a41590 100644 --- a/src/Spec-Tools/ChangeSorterPresenter.class.st +++ b/src/Spec-Tools/ChangeSorterPresenter.class.st @@ -1,7 +1,6 @@ " A change sorter is a little tool to manage changes. Developer can give name to change containers and all the change made during this container is active are collected in the container. - The DualChangeSorter tool supports manipulation of changes between containers and fileout of the changes. ChangeSorterPresenter new openWithSpec @@ -38,7 +37,7 @@ ChangeSorterPresenter class >> defaultSpec [ { #category : #specs } ChangeSorterPresenter class >> title [ - ^ 'Change Sorter' + ^ 'Change sorter' ] { #category : #'menu - change set' } @@ -354,12 +353,6 @@ ChangeSorterPresenter >> forgetMessage [ self setSelectedClassIndex: self selectedClassIndex ] ] -{ #category : #api } -ChangeSorterPresenter >> initialExtent [ - - ^ 500 @ 350 -] - { #category : #initialization } ChangeSorterPresenter >> initialize [ model := ChangeSorterModel new. @@ -384,6 +377,7 @@ ChangeSorterPresenter >> initializePresenter [ self registerChangeActions. self registerClassActions. self registerSelectorActions. + changesListPresenter items ifNotEmpty: [ changesListPresenter selectIndex: 1 ] ] @@ -407,8 +401,14 @@ ChangeSorterPresenter >> initializeWidgets [ changesListPresenter items: self model allChanges. changesListPresenter displayBlock: [ :item | item name ]. - classesListPresenter sortingBlock: [ :a :b | a name < b name ]. - textPresenter aboutToStyle: true + classesListPresenter sortingBlock: [ :a :b | a name < b name ] +] + +{ #category : #initialization } +ChangeSorterPresenter >> initializeWindow: aWindowPresenter [ + aWindowPresenter + title: self title; + initialExtent: 500 @ 350 ] { #category : #menu } @@ -499,14 +499,12 @@ ChangeSorterPresenter >> model [ { #category : #'menu - change set' } ChangeSorterPresenter >> newSet [ | aSet | - self selectedChangeSet - ifNil: [ ^ self inform: 'No change set selected' ]. - self okToChange - ifFalse: [ ^ self ]. + self selectedChangeSet ifNil: [ ^ self inform: 'No change set selected' ]. + self okToChange ifFalse: [ ^ self ]. aSet := self model createNewSet. aSet ifNotNil: [ self updateChangesList. - changesListPresenter selectItem: aSet. + changesListPresenter setSelectedItem: aSet. self updateWindowTitle ] ] @@ -552,7 +550,7 @@ ChangeSorterPresenter >> registerClassActions [ whenSelectionChangedDo: [ :selection | self updateTextContents. textPresenter behavior: selection selectedItem. - textPresenter aboutToStyle: false. + textPresenter syntaxHighlight: false. selection selectedItem ifNil: [ methodsListPresenter items: {} ] ifNotNil: [ :class | @@ -635,14 +633,12 @@ ChangeSorterPresenter >> removePreamble [ { #category : #'menu - change set' } ChangeSorterPresenter >> rename [ | set | - self selectedChangeSet - ifNil: [ ^ self inform: 'No change set selected' ]. + self selectedChangeSet ifNil: [ ^ self inform: 'No change set selected' ]. set := self model rename: self selectedChangeSet. + changesListPresenter updateList; - selectItem: set. - "may be it would be better to introduce a hook for selectedItem: and update from this point - systematically." + setSelectedItem: set. self updateWindowTitle ] @@ -681,8 +677,7 @@ ChangeSorterPresenter >> selectorsMenu: aBlock [ { #category : #'menu - change set' } ChangeSorterPresenter >> setCurrentChangeSet [ - self selectedChangeSet - ifNil: [ ^ self inform: 'No change set selected' ]. + self selectedChangeSet ifNil: [ ^ self inform: 'No change set selected' ]. self model setCurrentChangeSet: self selectedChangeSet. self updateWindowTitle ] @@ -758,7 +753,7 @@ ChangeSorterPresenter >> updateClassesListAndMessagesList [ sel := methodsListPresenter selectedItem. self updateClassesList. methodsListPresenter setSelectedItem: sel. - self updateMessagesList. + self updateMessagesList ] { #category : #api } @@ -777,15 +772,16 @@ ChangeSorterPresenter >> updateMessagesList [ ChangeSorterPresenter >> updateTextContents [ | text | text := self model setContentsOfChangeSet: self selectedChangeSet forClass: self selectedClass andSelector: self selectedSelector. - ({'Method was added, but cannot be found!' . 'Added then removed (see versions)' . 'Method has been removed (see versions)'} includes: text) - ifTrue: [ textPresenter aboutToStyle: false ] - ifFalse: [ textPresenter aboutToStyle: true ]. + (text asString lines + anySatisfy: [ :line | + self model classDescriptionsMap values , {'Method was added, but cannot be found!' . 'Added then removed (see versions)' . 'Method has been removed (see versions)' . 'Class organization was changed.'} + includes: line ]) ifTrue: [ textPresenter withoutSyntaxHighlight ] ifFalse: [ textPresenter withSyntaxHighlight ]. textPresenter text: text ] -{ #category : #'menu - change set' } +{ #category : #api } ChangeSorterPresenter >> updateWindowTitle [ - self window title: self title + self withWindowDo: [ :window | window title: self title ] ] { #category : #'api-events' } diff --git a/src/Spec-Tools/DiffPresenter.extension.st b/src/Spec-Tools/DiffPresenter.extension.st deleted file mode 100644 index 397a2d394a4..00000000000 --- a/src/Spec-Tools/DiffPresenter.extension.st +++ /dev/null @@ -1,39 +0,0 @@ -Extension { #name : #DiffPresenter } - -{ #category : #'*Spec-Tools-VersionBrowser' } -DiffPresenter >> aboutToStyle: aBoolean [ -] - -{ #category : #'*Spec-Tools-VersionBrowser' } -DiffPresenter >> behavior [ - ^ self contextClass -] - -{ #category : #'*Spec-Tools-VersionBrowser' } -DiffPresenter >> behavior: aClass [ - - self contextClass: aClass -] - -{ #category : #'*Spec-Tools-VersionBrowser' } -DiffPresenter >> doItReceiver: aReceiver [ -] - -{ #category : #'*Spec-Tools-VersionBrowser' } -DiffPresenter >> getText [ - - ^ self rightText -] - -{ #category : #'*Spec-Tools-VersionBrowser' } -DiffPresenter >> text: aPairOfString [ - - (aPairOfString isText or: [aPairOfString isString]) - ifTrue: [ - self leftText: ''. - self rightText: aPairOfString - ] - ifFalse: [ - self leftText: aPairOfString first. - self rightText: aPairOfString second ] -] diff --git a/src/Spec-Tools/KeymapBrowser.class.st b/src/Spec-Tools/KeymapBrowser.class.st index eceb2369eac..e108932e301 100644 --- a/src/Spec-Tools/KeymapBrowser.class.st +++ b/src/Spec-Tools/KeymapBrowser.class.st @@ -87,7 +87,7 @@ KeymapBrowser >> initialExtent [ { #category : #initialization } KeymapBrowser >> initializePresenter [ filterField - whenTextChangedDo: [ :text | + whenTextChanged: [ :text | clearFilterButton enabled: text isNotEmpty. self setFilter: text ]. clearFilterButton action: [ filterField text: '' ] diff --git a/src/Spec-Tools/MessageBrowser.class.st b/src/Spec-Tools/MessageBrowser.class.st index d1bc92121d2..57b8ab98f0f 100644 --- a/src/Spec-Tools/MessageBrowser.class.st +++ b/src/Spec-Tools/MessageBrowser.class.st @@ -10,16 +10,10 @@ MessageBrowser new " Class { #name : #MessageBrowser, - #superclass : #ComposablePresenter, + #superclass : #AbstractMessageCentricBrowser, #instVars : [ - 'listModel', 'textModel', - 'toolbarModel', - 'refreshingBlockHolder', - 'cachedHierarchy', - 'model', - 'topologicSortHolder', - 'textConverterHolder' + 'refreshingBlock' ], #category : #'Spec-Tools-Senders' } @@ -87,64 +81,15 @@ MessageBrowser class >> browseSendersOf: aSymbol [ { #category : #specs } MessageBrowser class >> defaultSpec [ ^ SpecPanedLayout newVertical - add: #listModel; + add: #messageList; add: (SpecBoxLayout newVertical - add: #toolbarModel withConstraints: [ :constraints | constraints height: self buttonHeight ]; + add: #toolbarPresenter withConstraints: [ :constraints | constraints height: self buttonHeight ]; add: #textModel; yourself); yourself ] -{ #category : #menu } -MessageBrowser class >> messageBrowserListMenu: aBuilder [ - - - | target model message | - - target := aBuilder model. - model := target model. - target selectedMessage ifNil: [ ^self ]. - - message := target selectedMessage compiledMethod. - - (aBuilder item: #'Browse full...') - keyText: 'b'; - action: [ - Smalltalk tools browser - openOnClass: message methodClass - selector: message selector ]. - - (aBuilder item: #'Inspect method...') - keyText: 'i'; - action: [ message inspect ]; - withSeparatorAfter. - - (aBuilder item: #'Remove method...') - keyText: 'x'; - action: [ - model - removeMethod: message - inClass: message methodClass ]. - - (aBuilder item: #'Senders of...') - keyText: 'n'; - action: [ model browseSendersOfMessagesFrom: message selector ]. - - (aBuilder item: #'Implementors of...') - keyText: 'm'; - action: [ model browseMessagesFrom: message selector ]. - - (aBuilder item: #'Users of...') - keyText: 'N'; - action: [ model browseClassRefsOf: message methodClass ]. - - (aBuilder item: #'Versions...') - keyText: 'v'; - action: [ model browseVersionsFrom: message ]. - -] - { #category : #'instance creation - old' } MessageBrowser class >> openMessageList: messageList name: aString autoSelect: aSelector refreshingBlockSelector: aRefreshingBlockSelector [ @@ -178,14 +123,13 @@ MessageBrowser class >> taskbarIconName [ { #category : #specs } MessageBrowser class >> title [ - ^ 'Message Browser' ] { #category : #private } MessageBrowser >> accept: text notifying: notifyer [ - ^listModel selectedItem + ^ self selectedMessage ifNotNil: [:message | message methodClass compile: text @@ -204,62 +148,6 @@ MessageBrowser >> autoSelect: aSelector [ ifTrue: [ self intervalOf: aSelector inCode: text of: msg ] ] ] ] -{ #category : #actions } -MessageBrowser >> browseClass [ - self currentMethod ifNotNil: [ :method | method methodClass browse ] -] - -{ #category : #actions } -MessageBrowser >> browseClassRefs [ - self currentMethod ifNotNil: [ :method | - model browseClassRefsOf: method methodClass ] -] - -{ #category : #actions } -MessageBrowser >> browseMessages [ - self currentMethod ifNotNil: [ :method | - model browseMessagesFrom: method selector ] -] - -{ #category : #actions } -MessageBrowser >> browseMethod [ - self currentMethod ifNotNil: [ :method | method browse ] -] - -{ #category : #actions } -MessageBrowser >> browseSendersOfMessage [ - self currentMethod ifNotNil: [ :method | - model browseSendersOfMessagesFrom: method selector ] -] - -{ #category : #actions } -MessageBrowser >> browseVersions [ - self currentMethod ifNotNil: [ :method | - model browseVersionsFrom: method compiledMethod ] -] - -{ #category : #testing } -MessageBrowser >> buildHierarchyForMessages: messages [ - | result classes | - self topologicSort ifFalse: [ - result := IdentityDictionary new. - messages do: [:m | result at: m put: {} ]. - ^ result ]. - - result := Dictionary new. - classes := (messages collect: #methodClass) asSet. - messages do: [:message || level class | - class := message methodClass. - level := OrderedCollection new. - class allSuperclassesDo: [:superClass | - (classes includes: superClass) - ifTrue: [ level addFirst: superClass ]]. - level addLast: class. - level addLast: message selector. - result at: message put: level ]. - ^ result -] - { #category : #initialization } MessageBrowser >> buildUpdateTitle [ "Trying to have a clean subscription, this method is called in #initialize" @@ -268,19 +156,6 @@ MessageBrowser >> buildUpdateTitle [ textModel text: textModel getText. ] -{ #category : #testing } -MessageBrowser >> cacheHierarchyForClasses: aCollection [ - - cachedHierarchy := self buildHierarchyForMessages: aCollection. -] - -{ #category : #announcements } -MessageBrowser >> classModified: anAnnouncement [ - "this method forces the announcement to be handled in the UI process" - UIManager default defer: [ - self handleClassModified: anAnnouncement ] -] - { #category : #announcements } MessageBrowser >> classRenamed: anAnnouncement [ "this method forces the announcement to be handled in the UI process" @@ -293,22 +168,6 @@ MessageBrowser >> codeFont [ ^ StandardFonts codeFont ] -{ #category : #accessing } -MessageBrowser >> currentMethod [ - ^ self selectedMessage -] - -{ #category : #'private-focus' } -MessageBrowser >> ensureKeyBindingsFor: aWidget [ - aWidget bindKeyCombination: PharoShortcuts current browseShortcut toAction: [ self browseMethod ]. - aWidget bindKeyCombination: PharoShortcuts current inspectItShortcut toAction: [ self inspectMethod ]. - aWidget bindKeyCombination: PharoShortcuts current browseImplementorsShortcut toAction: [ self browseMessages ]. - aWidget bindKeyCombination: PharoShortcuts current browseSendersShortcut toAction: [ self browseSendersOfMessage ]. - aWidget bindKeyCombination: PharoShortcuts current browseReferencesShortcut toAction: [ self browseClassRefs ]. - aWidget bindKeyCombination: PharoShortcuts current browseVersionsShortcut toAction: [ self browseVersions ]. - aWidget bindKeyCombination: PharoShortcuts current removeShortcut toAction: [ self removeMethods ] -] - { #category : #'text selection' } MessageBrowser >> findFirstOccurrenceOf: searchedString in: textToSearchIn [ "Return the first index of aString in textToSearchIn " @@ -324,7 +183,7 @@ MessageBrowser >> findFirstOccurrenceOf: searchedString in: textToSearchIn [ { #category : #announcements } MessageBrowser >> handleClassRenamed: anAnnouncement [ | items selectedIndex | - items := listModel model shownItems + items := self messages collect: [ :rgMethod | | interestedClassName interestedClass | interestedClassName := anAnnouncement oldName. @@ -335,9 +194,9 @@ MessageBrowser >> handleClassRenamed: anAnnouncement [ rgMethod parentName = interestedClassName ifTrue: [ (interestedClass >> rgMethod selector) asFullRingDefinition ] ifFalse: [ rgMethod ] ]. - selectedIndex := listModel selection selectedIndex. + selectedIndex := messageList selectedIndex. self messages: items. - listModel selectIndex: selectedIndex + self setSelectedIndex: selectedIndex ] { #category : #announcements } @@ -345,7 +204,7 @@ MessageBrowser >> handleMethodAdded: anAnnouncement [ | item sel text boolean | self isDisplayed ifFalse: [ ^ self ]. - refreshingBlockHolder ifNil: [ ^ self ]. + refreshingBlock ifNil: [ ^ self ]. item := anAnnouncement method. @@ -355,9 +214,9 @@ MessageBrowser >> handleMethodAdded: anAnnouncement [ boolean := textModel hasUnacceptedEdits. boolean ifTrue: [ text := textModel pendingText ]. - sel := listModel selectedItem. - self messages: (listModel listItems add: item asFullRingDefinition; yourself). - listModel setSelectedItem: sel. + sel := self selectedMessage. + self messages: (self messages add: item asFullRingDefinition; yourself). + self selectedMessage: sel. boolean ifTrue: [ textModel pendingText: text ] ] @@ -367,10 +226,10 @@ MessageBrowser >> handleMethodModified: anAnnouncement [ | item oldItem sel index text list edits | self isDisplayed ifFalse: [ ^ self ]. - refreshingBlockHolder ifNil: [ ^ self ]. + refreshingBlock ifNil: [ ^ self ]. item := anAnnouncement newMethod. oldItem := anAnnouncement oldMethod. - sel := listModel selection selectedItem. + sel := self selectedMessage. sel ifNil: [ ^ self ]. (sel methodClass = oldItem methodClass and: [ sel selector = oldItem selector ]) @@ -380,14 +239,14 @@ MessageBrowser >> handleMethodModified: anAnnouncement [ edits := textModel hasUnacceptedEdits. edits ifTrue: [ text := textModel pendingText ]. - index := listModel selection selectedIndex. - list := listModel model shownItems + index := messageList selectedIndex. + list := self messages remove: sel ifAbsent: [ ]; add: item asFullRingDefinition; "to ensure it's still a RGMethod" yourself. self messages: list. - listModel selectIndex: index. + self setSelectedIndex: index. edits ifFalse: [ ^ self ]. textModel pendingText: text. @@ -399,7 +258,7 @@ MessageBrowser >> handleMethodRemoved: anAnnouncement [ | item selection removeItem | self isDisplayed ifFalse: [ ^ self ]. - refreshingBlockHolder ifNil: [ ^ self ]. + refreshingBlock ifNil: [ ^ self ]. self okToChange ifFalse: [ ^ self ]. @@ -407,80 +266,62 @@ MessageBrowser >> handleMethodRemoved: anAnnouncement [ item := anAnnouncement method. (item methodClass notNil and: [ item methodClass isObsolete not ]) ifFalse: [ ^ self ]. - selection := listModel selection selectedIndex. - removeItem := listModel selection selectedItem. + selection := messageList selectedIndex. + removeItem := self selectedMessage. (removeItem notNil and: [ removeItem methodClass = item methodClass and: [ removeItem selector = item selector ] ]) ifTrue: [ textModel hasUnacceptedEdits: false ]. self messages: - (listModel model shownItems + (self messages remove: item asFullRingDefinition ifAbsent: [ nil ]; yourself). - listModel selectIndex: selection -] - -{ #category : #private } -MessageBrowser >> initialExtent [ - - ^ (900 min: (World extent x)) @ (550 min: (World extent y)) + self setSelectedIndex: selection ] { #category : #initialization } MessageBrowser >> initialize [ - textConverterHolder := SourceMethodConverter new asValueHolder. - model := AbstractTool new. - topologicSortHolder := true asValueHolder. super initialize. - askOkToClose := true asValueHolder. - self windowIcon: self taskbarIcon. self registerToAnnouncements. self announcer when: WidgetBuilt send: #buildUpdateTitle to: self ] { #category : #initialization } MessageBrowser >> initializeDropList [ - - toolbarModel + toolbarPresenter addItemLabeled: 'Source' do: [ self textConverter: SourceMethodConverter new ]; addItemLabeled: 'Time stamp' do: [ self textConverter: TimeStampMethodConverter new ] ] { #category : #initialization } MessageBrowser >> initializePresenter [ - listModel + messageList whenSelectionChangedDo: [ :selection | [ :item | self selectItem: item ] cull: selection selectedItem ]; whenModelChangedDo: [ self updateTitle ]. - titleHolder whenChangedDo: [ self updateTitle ]. textModel acceptBlock: [ :text :notifyer | (self accept: text notifying: notifyer) notNil ] ] { #category : #initialization } MessageBrowser >> initializeWidgets [ - listModel := self newTable. + super initializeWidgets. textModel := self newCode. - toolbarModel := self instantiate: MethodToolbar. - - listModel - addColumn: (StringTableColumn title: 'Location' evaluated: [ :item | self locationOf: item ]); - addColumn: (StringTableColumn title: 'Selector' evaluated: [ :item | self selectorOf: item ]); - addColumn: (StringTableColumn title: 'Package' evaluated: [ :item | self packageOf: item ]); - beResizable. - textModel aboutToStyle: true. textModel whenBuiltDo: [ :ann | ann widget font: self codeFont ]. - refreshingBlockHolder := [ :item | true ] asValueHolder. + refreshingBlock := [ :item | true ]. self - setListMenu; initializeDropList; setFocus ] -{ #category : #actions } -MessageBrowser >> inspectMethod [ - self currentMethod ifNotNil: [ :m | m inspect ] +{ #category : #initialization } +MessageBrowser >> initializeWindow: aWindowPresenter [ + super initializeWindow: aWindowPresenter. + aWindowPresenter + title: self title; + windowIcon: self taskbarIcon; + askOkToClose: true ] { #category : #private } @@ -504,52 +345,14 @@ MessageBrowser >> intervalOf: aSelector inCommentText: aText [ ^ self searchedString: aSelector asString in: aText ] -{ #category : #private } -MessageBrowser >> isMethodDefinition: anItem [ - "an item can be nil, a compiled method, or a ring object. Whereas a ring object can be a ring method or comment definition. - Some operations are only valid for compiled methods or ring object that are a method definitions" - - anItem ifNil: [ ^ false ]. - - "assume it is a compiled method or ring method definition" - ^ (anItem isRingObject and: [ anItem isMethod and: [ anItem compiledMethod isNotNil ] ]) - or: [ anItem isCompiledMethod ] -] - -{ #category : #accessing } -MessageBrowser >> listModel [ - - ^ listModel -] - -{ #category : #accessing } -MessageBrowser >> locationOf: anItem [ - ^ String - streamContents: [ :aStream | - 3 to: (cachedHierarchy at: anItem) size do: [ :i | aStream << ' ' ]. - aStream << (self methodClassNameForItem: anItem) << ' ('. - anItem isFromTrait - ifTrue: [ aStream - << anItem compiledMethod origin name; - space ]. - aStream << (self protocolNameForItem: anItem) << ')' ] -] - { #category : #api } MessageBrowser >> messages [ - - ^ listModel listItems + ^ messageList messages ] { #category : #api } MessageBrowser >> messages: aCollection [ - - self cacheHierarchyForClasses: aCollection. - listModel items: (cachedHierarchy keys - sort: [ :a :b | self sortClassesInCachedHierarchy: a b: b ]) - asOrderedCollection. - listModel listSize > 0 - ifTrue: [ listModel selectIndex: 1 ] + messageList messages: aCollection ] { #category : #announcements } @@ -582,11 +385,6 @@ MessageBrowser >> methodRemoved: anAnnouncement [ self handleMethodRemoved: anAnnouncement ] ] -{ #category : #accessing } -MessageBrowser >> model [ - ^model -] - { #category : #'messageList interface' } MessageBrowser >> open [ @@ -598,20 +396,9 @@ MessageBrowser >> packageNameForItem: anItem [ ^ anItem package ifNil: [ '' ] ifNotNil: [ :package | package name ] ] -{ #category : #accessing } -MessageBrowser >> packageOf: anItem [ - ^ '[' , (self packageNameForItem: anItem) , ']' -] - -{ #category : #private } -MessageBrowser >> protocolNameForItem: anItem [ - ^ anItem category ifNil: [ '' ] -] - { #category : #api } MessageBrowser >> refreshingBlock: aBlock [ - - refreshingBlockHolder value: aBlock + refreshingBlock := aBlock ] { #category : #'announcements-registration' } @@ -625,18 +412,6 @@ MessageBrowser >> registerToAnnouncements [ when: ClassRenamed send: #classRenamed: to: self ] -{ #category : #actions } -MessageBrowser >> removeMethods [ - self currentMethod ifNotNil: [ :method | - model removeMethod: method inClass: method methodClass ] -] - -{ #category : #api } -MessageBrowser >> resetSelection [ - - listModel resetSelection -] - { #category : #'text selection' } MessageBrowser >> searchedString: searchedString in: aString [ "Return the interval that corresponds to the portion of aString " @@ -671,9 +446,14 @@ MessageBrowser >> searchedString: searchedString in: aString [ ^ interval ] +{ #category : #api } +MessageBrowser >> selectIndex: anIndex [ + messageList selectIndex: anIndex +] + { #category : #private } MessageBrowser >> selectItem: item [ - toolbarModel method: item. + toolbarPresenter method: item. textModel behavior: (item ifNotNil: [ item methodClass ]). textModel doItReceiver: textModel behavior. textModel text: (self textConverter @@ -684,64 +464,33 @@ MessageBrowser >> selectItem: item [ ] -{ #category : #api } +{ #category : #accessing } MessageBrowser >> selectedClass [ ^ self selectedMethod origin ] -{ #category : #accessing } -MessageBrowser >> selectedItem [ - - ^ listModel selection selectedItem -] - -{ #category : #api } -MessageBrowser >> selectedMessage [ - - ^ listModel selection selectedItem -] - { #category : #api } MessageBrowser >> selectedMessage: aMessage [ - - listModel selectItem: aMessage. + messageList selectMessage: aMessage ] { #category : #accessing } MessageBrowser >> selectedMethod [ - - self selectedMessage ifNil: [ ^ nil ]. - ^ self selectedMessage compiledMethod -] - -{ #category : #accessing } -MessageBrowser >> selectedMethods [ - ^ {self selectedMessage} asOrderedCollection -] - -{ #category : #accessing } -MessageBrowser >> selectorOf: anItem [ - ^ anItem selector + ^ messageList selectedMethod ] { #category : #initialization } MessageBrowser >> setFocus [ self focusOrder - add: listModel; - add: toolbarModel; + add: messageList; + add: toolbarPresenter; add: textModel ] -{ #category : #menus } -MessageBrowser >> setListMenu [ - listModel contextMenu: [ :menu | menu addAllFromPragma: 'messageBrowserListMenu' target: self ] -] - { #category : #api } MessageBrowser >> setRefreshingBlockForImplementorsOf: aSelector [ - - self refreshingBlock: [:message | message selector = aSelector ]. + self refreshingBlock: [ :message | message selector = aSelector ] ] { #category : #api } @@ -752,47 +501,19 @@ MessageBrowser >> setRefreshingBlockForSendersOf: aSelector [ method hasSelector: aSelector specialSelectorIndex: specialIndex ] ] -{ #category : #api } -MessageBrowser >> setSelectedIndex: anIndex [ - listModel selectIndex: anIndex -] - { #category : #announcements } MessageBrowser >> shouldRefreshItem: item fromAnnouncement: anAnnouncement [ - - "The refreshing block holder contains a block that accepts an item of the list, the received announcement and the message browser. + "The refreshing block contains a block that accepts an item of the list, the received announcement and the message browser. It will anwer a boolean indicating if the modified item should be refreshed. Concretely, this is used to know if the contents of the selected message should be refreshed" - ^ refreshingBlockHolder value - cull: item - cull: anAnnouncement - cull: self -] - -{ #category : #testing } -MessageBrowser >> sortClassesInCachedHierarchy: aMethodDefinition b: otherMethodDefinition [ - "This method checks wether the cached inheritance hierarchy of a method should be before than the one of another method. - It compares alphabetically the hierarchy using #compare: - If both are alphabetically equals, it uses the size the hierarchy. - We do not know why this is done like this." - | aMethodHierarchy otherMethodHierarchy minSize| - aMethodHierarchy := cachedHierarchy at: aMethodDefinition. - otherMethodHierarchy := cachedHierarchy at: otherMethodDefinition. - - minSize := aMethodHierarchy size min: otherMethodHierarchy size. - - 1 to: minSize do: [ :i | |compare| - compare := (aMethodHierarchy at: i) printString compare: (otherMethodHierarchy at: i) printString. - compare ~~ 2 - ifTrue: [ ^ compare == 1 ]]. - ^ aMethodHierarchy size < otherMethodHierarchy size + + ^ refreshingBlock cull: item cull: anAnnouncement cull: self ] { #category : #api } MessageBrowser >> sortingBlock: aBlock [ - - listModel sortingBlock: aBlock + messageList sortingBlock: aBlock ] { #category : #'text selection' } @@ -802,17 +523,10 @@ MessageBrowser >> sourceIntervalOf: aSelector in: aMethodNode [ ^ senderNode keywordsPositions first to: senderNode keywordsPositions last + senderNode keywords last size - 1 ] -{ #category : #accessing } -MessageBrowser >> textConverter [ - - ^ textConverterHolder value -] - { #category : #accessing } MessageBrowser >> textConverter: aTextConverter [ - - textConverterHolder value: (aTextConverter method: self textConverter method). - textModel aboutToStyle: self textConverter shouldShout . + super textConverter: aTextConverter. + textModel syntaxHighlight: self textConverter shouldShout . textModel text: self textConverter getText. ] @@ -830,31 +544,33 @@ MessageBrowser >> textModel: aModel [ { #category : #private } MessageBrowser >> title [ - ^ titleHolder value , ' [' , listModel listSize printString , ']' + ^ self class title , ' [' , messageList numberOfElements printString , ']' ] { #category : #accessing } -MessageBrowser >> toolbarModel [ +MessageBrowser >> toolbarPresenter [ - ^ toolbarModel + ^ toolbarPresenter ] { #category : #api } MessageBrowser >> topologicSort [ - - ^ topologicSortHolder value + ^ messageList topologicSort ] { #category : #api } MessageBrowser >> topologicSort: aBoolean [ - - ^ topologicSortHolder value: aBoolean + ^ messageList topologicSort: aBoolean +] + +{ #category : #api } +MessageBrowser >> updateTitle [ + self withWindowDo: [ :window | window title: self title ] ] { #category : #'api-events' } MessageBrowser >> whenSelectedItemChanged: aBlock [ - - listModel whenSelectedItemChanged: aBlock + messageList whenSelectedItemChanged: aBlock ] { #category : #private } diff --git a/src/Spec-Tools/MessageList.class.st b/src/Spec-Tools/MessageList.class.st new file mode 100644 index 00000000000..5eb0b0c6231 --- /dev/null +++ b/src/Spec-Tools/MessageList.class.st @@ -0,0 +1,319 @@ +" +I am a presenter listing messages. + +I am used by more complexe browsers such as MessageBrowser or VersionBrowser. + + +Internal Representation and Key Implementation Points. +-------------------- + + Instance Variables + cachedHierarchy: A cache keeping info about the level of a class in the list. + listModel: A list presenter to show all the messages. + model:  A model grouping generic methods for managing packages/classes/groups/methods from a browser + topologySort: A boolean to know if we should use a topology sort or not. + +" +Class { + #name : #MessageList, + #superclass : #ComposablePresenter, + #instVars : [ + 'listModel', + 'cachedHierarchy', + 'topologySort', + 'model' + ], + #category : #'Spec-Tools-Senders' +} + +{ #category : #specs } +MessageList class >> defaultSpec [ + ^ SpecBoxLayout newVertical + add: #listModel; + yourself +] + +{ #category : #actions } +MessageList >> browseClassRefs [ + self currentMethod ifNotNil: [ :method | + model browseClassRefsOf: method methodClass ] +] + +{ #category : #actions } +MessageList >> browseMessages [ + self currentMethod ifNotNil: [ :method | + model browseMessagesFrom: method selector ] +] + +{ #category : #actions } +MessageList >> browseMethod [ + self currentMethod ifNotNil: [ :method | method browse ] +] + +{ #category : #actions } +MessageList >> browseSendersOfMessage [ + self currentMethod ifNotNil: [ :method | + model browseSendersOfMessagesFrom: method selector ] +] + +{ #category : #actions } +MessageList >> browseVersions [ + self currentMethod ifNotNil: [ :method | + model browseVersionsFrom: method compiledMethod ] +] + +{ #category : #testing } +MessageList >> buildHierarchyForMessages: messages [ + | result classes | + self topologicSort ifFalse: [ + result := IdentityDictionary new. + messages do: [:m | result at: m put: {} ]. + ^ result ]. + + result := Dictionary new. + classes := (messages collect: #methodClass) asSet. + messages do: [:message || level class | + class := message methodClass. + level := OrderedCollection new. + class allSuperclassesDo: [:superClass | + (classes includes: superClass) + ifTrue: [ level addFirst: superClass ]]. + level addLast: class. + level addLast: message selector. + result at: message put: level ]. + ^ result +] + +{ #category : #testing } +MessageList >> cacheHierarchyForClasses: aCollection [ + cachedHierarchy := self buildHierarchyForMessages: aCollection. +] + +{ #category : #api } +MessageList >> contextMenu: aMenuPresenter [ + listModel contextMenu: aMenuPresenter +] + +{ #category : #'private-focus' } +MessageList >> ensureKeyBindingsFor: aWidget [ + aWidget bindKeyCombination: PharoShortcuts current browseShortcut toAction: [ self browseMethod ]. + aWidget bindKeyCombination: PharoShortcuts current inspectItShortcut toAction: [ self inspectMethod ]. + aWidget bindKeyCombination: PharoShortcuts current browseImplementorsShortcut toAction: [ self browseMessages ]. + aWidget bindKeyCombination: PharoShortcuts current browseSendersShortcut toAction: [ self browseSendersOfMessage ]. + aWidget bindKeyCombination: PharoShortcuts current browseReferencesShortcut toAction: [ self browseClassRefs ]. + aWidget bindKeyCombination: PharoShortcuts current browseVersionsShortcut toAction: [ self browseVersions ]. + aWidget bindKeyCombination: PharoShortcuts current removeShortcut toAction: [ self removeMethods ] +] + +{ #category : #initialization } +MessageList >> initialize [ + topologySort := true. + model := AbstractTool new. + super initialize +] + +{ #category : #initialization } +MessageList >> initializeWidgets [ + listModel := self newTable. + + listModel + sortingBlock: [ :a :b | self sortClassesInCachedHierarchy: a b: b ]; + addColumn: (StringTableColumn title: 'Location' evaluated: [ :item | self locationOf: item ]); + addColumn: (StringTableColumn title: 'Selector' evaluated: [ :item | self selectorOf: item ]); + addColumn: (StringTableColumn title: 'Package' evaluated: [ :item | self packageOf: item ]); + beResizable. + + self contextMenu: self messageListMenu +] + +{ #category : #actions } +MessageList >> inspectMethod [ + self currentMethod ifNotNil: [ :m | m inspect ] +] + +{ #category : #accessing } +MessageList >> listModel [ + ^ listModel +] + +{ #category : #accessing } +MessageList >> locationOf: anItem [ + ^ String + streamContents: [ :aStream | + 3 to: (cachedHierarchy at: anItem) size do: [ :i | aStream << ' ' ]. + aStream << (self methodClassNameForItem: anItem) << ' ('. + anItem isFromTrait + ifTrue: [ aStream + << anItem compiledMethod origin name; + space ]. + aStream << (self protocolNameForItem: anItem) << ')' ] +] + +{ #category : #accessing } +MessageList >> messageListMenu [ + ^ self newMenu + addGroup: [ :aGroup | + aGroup + addItem: [ :anItem | + anItem + name: 'Browse full...'; + shortcut: $b meta; + action: [ self selectedMethod browse ] ]; + addItem: [ :anItem | + anItem + name: 'Inspect method...'; + shortcut: $i meta; + action: [ self selectedMethod inspect ] ] ]; + addGroup: [ :aGroup | + aGroup + addItem: [ :anItem | + anItem + name: 'Remove method...'; + shortcut: $x meta; + action: [ self selectedMethod removeFromSystem ] ]; + addItem: [ :anItem | + anItem + name: 'Senders of...'; + shortcut: $n meta; + action: [ model browseSendersOfMessagesFrom: self selectedMethod selector ] ]; + addItem: [ :anItem | + anItem + name: 'Implementors of...'; + shortcut: $m meta; + action: [ model browseMessagesFrom: self selectedMethod selector ] ] ]; + addItem: [ :anItem | + anItem + name: 'Users of...'; + shortcut: $N meta; + action: [ model browseClassRefsOf: self selectedMethod methodClass ] ]; + addItem: + [ :anItem | + anItem + name: 'Versions...'; + shortcut: $v meta; + action: [ model browseVersionsFrom: self selectedMethod ] ] yourself +] + +{ #category : #accessing } +MessageList >> messages [ + ^ listModel items +] + +{ #category : #accessing } +MessageList >> messages: aCollection [ + self cacheHierarchyForClasses: aCollection. + listModel items: cachedHierarchy keys asOrderedCollection. + listModel listSize > 0 ifTrue: [ listModel selectIndex: 1 ] +] + +{ #category : #private } +MessageList >> methodClassNameForItem: anItem [ + ^ anItem methodClass ifNotNil: [ :class | class name ] ifNil: [ '' ] +] + +{ #category : #accessing } +MessageList >> model [ + ^model +] + +{ #category : #accessing } +MessageList >> numberOfElements [ + ^ listModel listSize +] + +{ #category : #private } +MessageList >> packageNameForItem: anItem [ + ^ anItem package ifNil: [ '' ] ifNotNil: [ :package | package name ] +] + +{ #category : #private } +MessageList >> packageOf: anItem [ + ^ '[' , (self packageNameForItem: anItem) , ']' +] + +{ #category : #private } +MessageList >> protocolNameForItem: anItem [ + ^ anItem category ifNil: [ '' ] +] + +{ #category : #actions } +MessageList >> removeMethods [ + self currentMethod ifNotNil: [ :method | + model removeMethod: method inClass: method methodClass ] +] + +{ #category : #selecting } +MessageList >> selectIndex: anInteger [ + listModel selectIndex: anInteger +] + +{ #category : #accessing } +MessageList >> selectMessage: aMessage [ + listModel selectItem: aMessage +] + +{ #category : #selecting } +MessageList >> selectedIndex [ + ^ listModel selection selectedIndex +] + +{ #category : #accessing } +MessageList >> selectedMessage [ + ^ listModel selection selectedItem +] + +{ #category : #accessing } +MessageList >> selectedMethod [ + self selectedMessage ifNil: [ ^ nil ]. + + ^ self selectedMessage compiledMethod +] + +{ #category : #accessing } +MessageList >> selectorOf: anItem [ + ^ anItem selector +] + +{ #category : #sorting } +MessageList >> sortClassesInCachedHierarchy: aMethodDefinition b: otherMethodDefinition [ + "This method checks wether the cached inheritance hierarchy of a method should be before than the one of another method. + It compares alphabetically the hierarchy using #compare: + If both are alphabetically equals, it uses the size the hierarchy. + We do not know why this is done like this." + | aMethodHierarchy otherMethodHierarchy minSize| + aMethodHierarchy := cachedHierarchy at: aMethodDefinition. + otherMethodHierarchy := cachedHierarchy at: otherMethodDefinition. + + minSize := aMethodHierarchy size min: otherMethodHierarchy size. + + 1 to: minSize do: [ :i | |compare| + compare := (aMethodHierarchy at: i) printString compare: (otherMethodHierarchy at: i) printString. + compare ~~ 2 + ifTrue: [ ^ compare == 1 ]]. + ^ aMethodHierarchy size < otherMethodHierarchy size +] + +{ #category : #api } +MessageList >> sortingBlock: aBlock [ + listModel sortingBlock: aBlock +] + +{ #category : #accessing } +MessageList >> topologicSort [ + ^ topologySort +] + +{ #category : #accessing } +MessageList >> topologicSort: anObject [ + topologySort := anObject +] + +{ #category : #enumerating } +MessageList >> whenModelChangedDo: aBlock [ + listModel whenModelChangedDo: aBlock +] + +{ #category : #enumerating } +MessageList >> whenSelectionChangedDo: aBlock [ + listModel whenSelectionChangedDo: aBlock +] diff --git a/src/Spec-Tools/RGMethodDefinition.extension.st b/src/Spec-Tools/RGMethodDefinition.extension.st new file mode 100644 index 00000000000..dccfee8363b --- /dev/null +++ b/src/Spec-Tools/RGMethodDefinition.extension.st @@ -0,0 +1,12 @@ +Extension { #name : #RGMethodDefinition } + +{ #category : #'*Spec-Tools' } +RGMethodDefinition >> displayName [ + ^ String + streamContents: [ :aStream | + self parentName + ifNotNil: [ aStream + nextPutAll: self parentName; + nextPutAll: '>>' ]. + aStream print: self selector ] +] diff --git a/src/Spec-Tools/VersionBrowser.class.st b/src/Spec-Tools/VersionBrowser.class.st index dfa5bac86c0..2b61542dbc4 100644 --- a/src/Spec-Tools/VersionBrowser.class.st +++ b/src/Spec-Tools/VersionBrowser.class.st @@ -1,12 +1,32 @@ " -A VersionBrowser is a tool made for browsing the several versions of the provided method. +I am a tool made for browsing the several versions of the provided method. + +I will list of the history of the method available in the sources of the image. + +Examples +-------------------- + + self browseVersionsForClass: self selector: #initializeWidgets + + +Internal Representation and Key Implementation Points. +-------------------- + + Instance Variables + isShowingDiff: Since I can show a diff or a code presenter, I am a boolean here to know which one is currently selected. + rgMethod: The method to browse the versions. + sourcePresenter: Either a code or diff presenter depending on the informations the user wants to know. + + Maybe the #sourcePreseneter management should be extracted into a Strategy design pattern later to have a cleaner code. + " Class { #name : #VersionBrowser, - #superclass : #Object, + #superclass : #AbstractMessageCentricBrowser, #instVars : [ 'rgMethod', - 'browser' + 'sourcePresenter', + 'isShowingDiff' ], #category : #'Spec-Tools-VersionBrowser' } @@ -15,7 +35,7 @@ Class { VersionBrowser class >> browseVersionsForClass: aClass selector: aSelector [ ^ aClass compiledMethodAt: aSelector - ifPresent: [ :method | self new browseVersionsOf: method ] + ifPresent: [ :method | self browseVersionsForMethod: method ] ifAbsent: [ self inform: ('No method {1} in class {2}' @@ -26,125 +46,52 @@ VersionBrowser class >> browseVersionsForClass: aClass selector: aSelector [ { #category : #api } VersionBrowser class >> browseVersionsForMethod: aRingMethod [ - ^ self new - browseVersionsOf: aRingMethod - + ^ (self on: aRingMethod) openWithSpec ] -{ #category : #'tool registry' } +{ #category : #specs } +VersionBrowser class >> defaultSpec [ + ^ SpecPanedLayout newVertical + add: #messageList; + add: + (SpecBoxLayout newVertical + add: #toolbarPresenter withConstraints: [ :constraints | constraints height: self buttonHeight ]; + add: #sourcePresenter; + yourself); + yourself +] + +{ #category : #'tools registry' } VersionBrowser class >> registerToolsOn: registry [ - "Add ourselves to registry. See [Smalltalk tools]" + "Add ourselves to registry. See [Smalltalk tools]" + registry register: self as: #versionBrowser +] +{ #category : #visiting } +VersionBrowser >> accept: text notifying: notifyer [ + ^ self selectedMessage + ifNotNil: [:message | + message methodClass + compile: text + classified: message protocol + notifying: notifyer ] ] -{ #category : #menu } -VersionBrowser class >> versionsBrowserListMenu: aBuilder [ - - - | browser model | - model := aBuilder model. - browser := aBuilder model browser. - browser selectedMessage notNil - ifTrue: [ - (aBuilder item: #'Compare to current') - help: 'Compare selected version to the current version'; - target: model; - selector: #compareToCurrentVersion. - (aBuilder item: #'Compare to version...') - help: 'Compare selected version to another selected version'; - target: model; - selector: #compareToOtherVersion. - (aBuilder item: #'Revert to selected version') - help: 'Resubmit the selected version, so that it becomes the current version'; - action: [ model revert: browser selectedItem ]]. - (aBuilder item: #Senders) - keyText: 'n'; - help: 'Browse all senders of this selector'; - action: [ model browseSenders ]. - (aBuilder item: #Implementors) - keyText: 'm'; - help: 'Browse all implementors of this selector'; - action: [ model browseImplementors ]; - withSeparatorAfter -] - -{ #category : #menu } +{ #category : #actions } VersionBrowser >> browseImplementors [ SystemNavigation new browseAllImplementorsOf: rgMethod selector ] -{ #category : #menu } +{ #category : #actions } VersionBrowser >> browseSenders [ SystemNavigation new browseSendersOf: rgMethod selector name: 'Senders of ' , rgMethod selector autoSelect: rgMethod selector ] -{ #category : #'instance creation' } -VersionBrowser >> browseVersionsOf: aMethod [ - - self setRGMethodFrom: aMethod. - ^ self buildBrowser -] - -{ #category : #'instance creation' } -VersionBrowser >> browseVersionsOf: method class: aClass meta: meta category: msgCategory selector: aSelector [ - - self setRGMethodFrom: method. - ^ self buildBrowser -] - -{ #category : #accessing } -VersionBrowser >> browser [ - ^ browser -] - -{ #category : #'instance creation' } -VersionBrowser >> browserForList: aList [ - browser := MessageBrowser new. - browser - topologicSort: false; - refreshingBlock: [ :m | false ]; - sortingBlock: [ :a :b | "; - displayBlock: [:changeRecord | self displayStringsFor: changeRecord]" (a annotationNamed: #versionIndex ifAbsent: [ 0 ]) < (b annotationNamed: #versionIndex ifAbsent: [ 0 ]) ]. - - browser toolbarModel - emptyDropList; - addItemLabeled: 'Side By Side' do: [ self showDiffMorphWithConverter: (DiffMorphChangeRecordConverter methodReference: browser textConverter method referencesList: aList) ]; - addItemLabeled: 'Source' do: [ self showSourceWithConverter: (SourceMethodConverter method: browser textConverter method) ]; - addItemLabeled: 'Diff' do: [ self showSourceWithConverter: (DiffChangeRecordConverter methodReference: browser textConverter method referencesList: aList) ]. - - browser toolbarModel versionModel - label: 'Revert'; - action: [ self revert: browser selectedItem ]. - browser listModel contextMenu: [ :menu | menu addAllFromPragma: 'versionBrowserListMenu' target: self ]. - ^ browser -] - -{ #category : #'instance creation' } -VersionBrowser >> buildBrowser [ - | changeList b | - - changeList := self buildChangeList. - - self browserForList: changeList. - - b := browser - messages: changeList; - title: 'Recent versions of ' , rgMethod asString; - openWithSpec. - b takeKeyboardFocus. - - self showDiffMorphWithConverter: (DiffMorphChangeRecordConverter - methodReference: browser textConverter method - referencesList: changeList). - - ^ b -] - { #category : #'instance creation' } VersionBrowser >> buildChangeList [ rgMethod sourcePointer ifNil:[ ^ #() ]. - + ^ (SourceFiles changeRecordsFrom: rgMethod sourcePointer className: rgMethod instanceSideParentName @@ -154,97 +101,196 @@ VersionBrowser >> buildChangeList [ rg annotationNamed: #versionIndex put: i ] ] -{ #category : #menu } -VersionBrowser >> compareTo:anOtherVersion withLabel:aLabel [ - | diff versions selected| - selected := browser selectedMessage. - versions := Array with:anOtherVersion with: (selected). - diff := DiffPresenter new. - diff title: ('Comparison from {1} to {2}' format:{selected stamp . aLabel}). - diff text:(DiffMorphChangeRecordConverter - methodReference: anOtherVersion - referencesList: versions) getText. - diff openWithSpec. +{ #category : #accessing } +VersionBrowser >> changeList [ + ^ messageList messages +] +{ #category : #actions } +VersionBrowser >> compareTo: anOtherVersion withLabel: aLabel [ + | versions texts | + versions := Array with: anOtherVersion with: self selectedMessage. + texts := (DiffMorphChangeRecordConverter methodReference: anOtherVersion referencesList: versions) getText. + DiffPresenter new + title: ('Comparison from {1} to {2}' format: {versions second stamp . aLabel}); + leftText: texts first; + rightText: texts second; + openWithSpec ] -{ #category : #menu } +{ #category : #actions } VersionBrowser >> compareToCurrentVersion [ - self compareTo: rgMethod withLabel:'current version' + self compareTo: rgMethod withLabel: 'Current version' ] -{ #category : #menu } +{ #category : #actions } VersionBrowser >> compareToOtherVersion [ | labels versions index selected | - versions := self buildChangeList. - labels := versions collect: [ :version | version stamp ]. + versions := self changeList. + labels := versions collect: #stamp. index := UIManager default chooseFrom: labels. - index > 0 - ifFalse: [ ^ self ]. + index > 0 ifFalse: [ ^ self ]. selected := versions at: index. self compareTo: selected withLabel: selected stamp ] +{ #category : #initialization } +VersionBrowser >> initialize [ + isShowingDiff := false. + super initialize +] + +{ #category : #initialization } +VersionBrowser >> initializePresenter [ + messageList + whenSelectionChangedDo: [ :selection | self selectItem: selection selectedItem ]; + messages: self buildChangeList. + + toolbarPresenter dropListModel selectedIndex: 1 +] + +{ #category : #initialization } +VersionBrowser >> initializeWidgets [ + messageList := self instantiate: MessageList. + toolbarPresenter := self instantiate: MethodToolbar. + + messageList + topologicSort: false; + sortingBlock: [ :a :b | (a annotationNamed: #versionIndex ifAbsent: [ 0 ]) < (b annotationNamed: #versionIndex ifAbsent: [ 0 ]) ]; + contextMenu: self messageListMenu. + + toolbarPresenter + addItemLabeled: 'Side By Side' do: [ self showDiffMorphWithConverter: (DiffMorphChangeRecordConverter methodReference: self textConverter method referencesList: self changeList) ]; + addItemLabeled: 'Source' do: [ self showSourceWithConverter: (SourceMethodConverter method: self textConverter method) ]; + addItemLabeled: 'Diff' do: [ self showSourceWithConverter: (DiffChangeRecordConverter methodReference: self textConverter method referencesList: self changeList) ]. + + toolbarPresenter versionModel + label: 'Revert'; + action: [ self revert: self selectedMessage ] +] + +{ #category : #initialization } +VersionBrowser >> initializeWindow: aWindowPresenter [ + super initializeWindow: aWindowPresenter. + aWindowPresenter title: 'Recent versions of ' , rgMethod displayName +] + +{ #category : #private } +VersionBrowser >> installIconStylerFor: anItem [ + "icons styler are only supported for method definitions (not nil / not for comment definitions + (those may occure for comment or general string searches)) and in the case the source presenter is not a diff" + + ((self isMethodDefinition: anItem) or: [ isShowingDiff not ]) ifFalse: [ ^ self ]. + + IconStyler styleText: sourcePresenter withAst: anItem ast +] + { #category : #accessing } -VersionBrowser >> displayStringsFor: aMethodVersion [ - | author version cleanStampParts | - - "a stamp is a string in the form 'GuillermoPolito 3/4/2015 14:33'" - "It may be incomplete, empty or even start with spaces." - cleanStampParts := aMethodVersion stamp trim substrings. - - author := cleanStampParts ifEmpty: [ '' ] ifNotEmpty: [ :parts | parts first ]. - version := cleanStampParts ifEmpty: [ '' ] ifNotEmpty: [ :parts | parts allButFirst joinUsing: ' ' ]. - - ^ {author. - version. - (aMethodVersion realClass name). - (aMethodVersion selector). - ('{' , aMethodVersion category , '}')} +VersionBrowser >> messageListMenu [ + ^ self newMenu + addGroup: [ :aGroup | + aGroup + addItem: [ :anItem | + anItem + name: 'Compare to current'; + help: 'Compare selected version to the current version'; + action: [ self compareToCurrentVersion ] ]; + addItem: [ :anItem | + anItem + name: 'Compare to version...'; + help: 'Compare selected version to another selected version'; + action: [ self compareToOtherVersion ] ]; + addItem: [ :anItem | + anItem + name: 'Revert to selected version'; + help: 'Resubmit the selected version, so that it becomes the current version'; + action: [ self revert: self selectedMessage ] ]; + addItem: [ :anItem | + anItem + name: 'Senders'; + shortcut: $n meta; + action: [ self browseSenders ] ]; + addItem: [ :anItem | + anItem + name: 'Implementors'; + shortcut: $m meta; + action: [ self browseImplementors ] ] ]; + yourself ] { #category : #'instance creation' } VersionBrowser >> revert: aChangeRecord [ - aChangeRecord - ifNil: [self inform: 'nothing selected, so nothing done'] - ifNotNil: [ rgMethod realClass compile: aChangeRecord sourceCode classified: aChangeRecord category withStamp: aChangeRecord stamp notifying:nil]. - - "reinitialize me" - self setRGMethodFrom: (rgMethod realClass >> (rgMethod selector)). + aChangeRecord + ifNil: [ ^ self inform: 'nothing selected, so nothing done' ] + ifNotNil: [ rgMethod realClass + compile: aChangeRecord sourceCode + classified: aChangeRecord category + withStamp: aChangeRecord stamp + notifying: nil ]. - browser + "reinitialize me" + self setRGMethodFrom: rgMethod realClass >> rgMethod selector. + + messageList messages: self buildChangeList; - setSelectedIndex: 1. + selectIndex: 1 ] { #category : #private } +VersionBrowser >> selectItem: item [ + sourcePresenter ifNil: [ ^ self ]. + + self + setSourceContentWith: + (self textConverter + method: item; + getText). + + sourcePresenter clearUndoManager. + self installIconStylerFor: item +] + +{ #category : #'accessing model' } +VersionBrowser >> setModelBeforeInitialization: aMethod [ + self setRGMethodFrom: aMethod. +] + +{ #category : #initialization } VersionBrowser >> setRGMethodFrom: aMethod [ "asHistorical, because active RGMethods don't always have the source pointer attached" rgMethod := aMethod asRingDefinition asHistorical. ] +{ #category : #private } +VersionBrowser >> setSourceContentWith: content [ + isShowingDiff + ifTrue: [ (content isText or: [ content isString ]) + ifTrue: [ sourcePresenter leftText: ''. + sourcePresenter rightText: content ] + ifFalse: [ sourcePresenter leftText: content first. + sourcePresenter rightText: content second ] ] + ifFalse: [ sourcePresenter text: content ] +] + { #category : #'instance creation' } VersionBrowser >> showDiffMorphWithConverter: aConverter [ - | behavior | - - behavior := browser textModel behavior. - browser textModel: browser newDiff. - browser needRebuild: false. - browser openWithSpec. - browser textConverter: aConverter. - browser textModel behavior: behavior + sourcePresenter := self newDiff. + isShowingDiff := true. + self needRebuild: false. + self buildWithSpec. + self textConverter: aConverter. + sourcePresenter contextClass: self selectedMessage methodClass. + messageList selectIndex: (messageList selectedIndex) ] { #category : #'instance creation' } VersionBrowser >> showSourceWithConverter: aConverter [ - | behavior | - - behavior := browser textModel behavior. - browser textModel: browser newCode. - browser needRebuild: false. - browser textModel behavior: behavior. - browser textConverter: aConverter. - - browser openWithSpec. - + sourcePresenter := self newCode. + isShowingDiff := false. + self needRebuild: false. + self buildWithSpec. + self textConverter: aConverter. + sourcePresenter acceptBlock: [ :text :notifyer | (self accept: text notifying: notifyer) notNil ]. + sourcePresenter behavior: self selectedMessage methodClass. + messageList selectIndex: (messageList selectedIndex) ] diff --git a/src/Spec-Transmission/SpecMorphPort.class.st b/src/Spec-Transmission/SpecMorphPort.class.st new file mode 100644 index 00000000000..a63b6211fae --- /dev/null +++ b/src/Spec-Transmission/SpecMorphPort.class.st @@ -0,0 +1,21 @@ +" +I define an incomming transmission to modify the morph value of a presenter. +I'm used on MorphPresenter. +" +Class { + #name : #SpecMorphPort, + #superclass : #SpecInputPort, + #category : #'Spec-Transmission' +} + +{ #category : #accessing } +SpecMorphPort class >> portName [ + + ^ #morph +] + +{ #category : #'handling transmission' } +SpecMorphPort >> incomingTransmission: anObject from: aTransmission [ + + self destinationPresenter morph: anObject +]