From 875e593482108baf593b01a050b8b88c90c4106e Mon Sep 17 00:00:00 2001 From: Esteban Lorenzano Date: Mon, 11 Sep 2023 10:50:41 +0200 Subject: [PATCH 01/34] clean up a little bit playground model, make it more extensible --- src/NewTools-Inspector/StInspector.class.st | 2 +- .../StPlaygroundPagePresenterTest.class.st | 2 +- ...laygroundPageSummaryPresenterTest.class.st | 4 +- .../StPlaygroundPagesPresenterTest.class.st | 9 +-- .../StPlaygroundTest.class.st | 8 +-- src/NewTools-Playground/StPlayground.class.st | 25 +++++--- .../StPlaygroundPage.class.st | 63 ++++++++++++++++++- .../StPlaygroundPageFlushed.class.st | 31 +++++++++ .../StPlaygroundPageLoaded.class.st | 31 +++++++++ .../StPlaygroundPagePresenter.class.st | 43 ++++++++++--- .../StPlaygroundPageSummaryPresenter.class.st | 28 ++++----- .../StPlaygroundPagesCommand.class.st | 6 ++ .../StPlaygroundPagesPresenter.class.st | 18 ++++-- src/NewTools-Spotter/StSpotterStep.class.st | 1 - 14 files changed, 218 insertions(+), 53 deletions(-) create mode 100644 src/NewTools-Playground/StPlaygroundPageFlushed.class.st create mode 100644 src/NewTools-Playground/StPlaygroundPageLoaded.class.st diff --git a/src/NewTools-Inspector/StInspector.class.st b/src/NewTools-Inspector/StInspector.class.st index ef9b463e5..0cc0982fb 100644 --- a/src/NewTools-Inspector/StInspector.class.st +++ b/src/NewTools-Inspector/StInspector.class.st @@ -267,7 +267,7 @@ StInspector >> newInspectorFor: aModel [ millerList pages ifNotEmpty: [ :pages | newInspector "prepare to close" - whenClosedDo: [ millerList removeAllFrom: newInspector ]; + whenClosedDo: [ millerList removeAllFrom: newInspector ]; "select last shown page (or default)" trySelectAnyPageWithName: { lastPageSelectedTabName. diff --git a/src/NewTools-Playground-Tests/StPlaygroundPagePresenterTest.class.st b/src/NewTools-Playground-Tests/StPlaygroundPagePresenterTest.class.st index a08c97a5e..e41c3a2bc 100644 --- a/src/NewTools-Playground-Tests/StPlaygroundPagePresenterTest.class.st +++ b/src/NewTools-Playground-Tests/StPlaygroundPagePresenterTest.class.st @@ -126,7 +126,7 @@ StPlaygroundPagePresenterTest >> testPageIsSavedWhenExecutingACommand [ memory := FileSystem memory. fileReference := memory / 'page.ph'. fileReference writeStreamDo: [ :stream | ]. - presenter loadPage: fileReference. + presenter loadPage: (StPlaygroundPage fromReference: fileReference). "ensure we do not save in the inner process by mistake" presenter page timeToWait: 1 minute. "we need the activation otherwise the command we are using will not work :(" diff --git a/src/NewTools-Playground-Tests/StPlaygroundPageSummaryPresenterTest.class.st b/src/NewTools-Playground-Tests/StPlaygroundPageSummaryPresenterTest.class.st index 0d8f7d30d..e13b9e4bd 100644 --- a/src/NewTools-Playground-Tests/StPlaygroundPageSummaryPresenterTest.class.st +++ b/src/NewTools-Playground-Tests/StPlaygroundPageSummaryPresenterTest.class.st @@ -37,7 +37,7 @@ Test 2' { #category : #tests } StPlaygroundPageSummaryPresenterTest >> testPageFirstLine [ - self assert: presenter pageFirstLine equals: 'Empty'. + self assert: presenter pageTitle equals: 'Empty'. presenter setModelBeforeInitialization: memoryFileSystem / 'test2.ph'. - self assert: presenter pageFirstLine equals: 'Test' + self assert: presenter pageTitle equals: 'Test' ] diff --git a/src/NewTools-Playground-Tests/StPlaygroundPagesPresenterTest.class.st b/src/NewTools-Playground-Tests/StPlaygroundPagesPresenterTest.class.st index e1a0d11b9..06a89706a 100644 --- a/src/NewTools-Playground-Tests/StPlaygroundPagesPresenterTest.class.st +++ b/src/NewTools-Playground-Tests/StPlaygroundPagesPresenterTest.class.st @@ -27,13 +27,14 @@ StPlaygroundPagesPresenterTest >> initializeMemoryFileSystem: aFileSystem [ { #category : #tests } StPlaygroundPagesPresenterTest >> testLoadPage [ + | loaded | + loaded := false. self deny: presenter window notNil. self openInstance. self assert: presenter window isOpen. - presenter loadPage: (memoryFileSystem / 'test1.ph'). + presenter onLoadPage: [ :aPage | loaded := true ]. + presenter loadPage: (StPlaygroundPage fromReference: (memoryFileSystem / 'test1.ph')). self deny: presenter window isOpen . - self - assert: presenter parent page contents - equals: (memoryFileSystem / 'test1.ph') contents + self assert: loaded ] diff --git a/src/NewTools-Playground-Tests/StPlaygroundTest.class.st b/src/NewTools-Playground-Tests/StPlaygroundTest.class.st index 8af3a45e2..5ca52c56a 100644 --- a/src/NewTools-Playground-Tests/StPlaygroundTest.class.st +++ b/src/NewTools-Playground-Tests/StPlaygroundTest.class.st @@ -45,10 +45,10 @@ StPlaygroundTest >> testLoadPage [ presenter page flush. page := self newPage - contents: 'Test 2'; - flush; - yourself. - presenter loadPage: page fileReference. + contents: 'Test 2'; + flush; + yourself. + presenter loadPage: page. self waitUntilUIRedrawed. self assert: presenter page contents equals: page contents ] diff --git a/src/NewTools-Playground/StPlayground.class.st b/src/NewTools-Playground/StPlayground.class.st index fe003000d..ddf0d6e5a 100644 --- a/src/NewTools-Playground/StPlayground.class.st +++ b/src/NewTools-Playground/StPlayground.class.st @@ -161,9 +161,9 @@ StPlayground >> defaultKeyboardFocus [ ] { #category : #actions } -StPlayground >> loadPage: aFileReference [ +StPlayground >> loadPage: aPlaygroundPage [ - self firstPage loadPage: aFileReference + self firstPage loadPage: aPlaygroundPage ] { #category : #'private - factory' } @@ -174,13 +174,17 @@ StPlayground >> newDefaultPlaygroundPage [ { #category : #'private - factory' } StPlayground >> newInspectorFor: aModel [ - | modelToInspectOrPlayground | - - modelToInspectOrPlayground := (millerList pages isEmpty and: [ aModel isNil ]) - ifTrue: [ self newDefaultPlaygroundPage ] - ifFalse: [ aModel ]. + | isPlayground inspector | - ^ super newInspectorFor: modelToInspectOrPlayground + isPlayground := millerList pages isEmpty and: [ aModel isNil ]. + + inspector := super newInspectorFor: (isPlayground + ifTrue: [ self newDefaultPlaygroundPage ] + ifFalse: [ aModel ]). + + isPlayground ifTrue: [ self prepareInspectorAsPlayground: inspector ]. + + ^ inspector ] { #category : #accessing } @@ -189,6 +193,11 @@ StPlayground >> page [ ^ self firstPage page ] +{ #category : #private } +StPlayground >> prepareInspectorAsPlayground: inspector [ + +] + { #category : #'private - stepping' } StPlayground >> startProcessing [ diff --git a/src/NewTools-Playground/StPlaygroundPage.class.st b/src/NewTools-Playground/StPlaygroundPage.class.st index 2d3e42f64..8d64c9b59 100644 --- a/src/NewTools-Playground/StPlaygroundPage.class.st +++ b/src/NewTools-Playground/StPlaygroundPage.class.st @@ -18,7 +18,9 @@ Class { 'contentReceived', 'timeToWait', 'baseDirectory', - 'versionLog' + 'versionLog', + 'flushAction', + 'modificationTime' ], #category : #'NewTools-Playground-Model' } @@ -29,6 +31,12 @@ StPlaygroundPage class >> defaultTimeToWait [ ^ 10 seconds ] +{ #category : #accessing } +StPlaygroundPage class >> emptyTitle [ + + ^ 'Empty' +] + { #category : #'instance creation' } StPlaygroundPage class >> fromReference: aFileReference [ @@ -128,6 +136,16 @@ StPlaygroundPage >> fileReference [ ^ (self baseDirectory / self fileName) withExtension: self class pageExtension ] +{ #category : #accessing } +StPlaygroundPage >> firstLine [ + + self readStreamDo: [ :stream | | line | + [ stream atEnd not and: [ (line := stream nextLine trimmed) isEmpty ] ] whileTrue. + line isEmptyOrNil ifFalse: [ ^ line ] ]. + + ^ nil +] + { #category : #private } StPlaygroundPage >> flush [ @@ -139,7 +157,10 @@ StPlaygroundPage >> flush [ writeStreamDo: [ :stream | stream << flushContents ]. flushContents := nil. - self storeVersion ] + self storeVersion. + self touch. + flushAction ifNotNil: [ + flushAction value ] ] ] { #category : #initialization } @@ -160,6 +181,32 @@ StPlaygroundPage >> initialize [ mutex := Mutex new ] +{ #category : #testing } +StPlaygroundPage >> isEmpty [ + + ^ self firstLine isNil +] + +{ #category : #accessing } +StPlaygroundPage >> modificationTime [ + + ^ modificationTime ifNil: [ modificationTime := self creationTime ] +] + +{ #category : #events } +StPlaygroundPage >> onFlush: aBlock [ + + flushAction := aBlock +] + +{ #category : #streaming } +StPlaygroundPage >> readStreamDo: aBlock [ + + ^ self fileReference + ifExists: [ :ref | ref readStreamDo: aBlock ] + ifAbsent: [ nil ] +] + { #category : #private } StPlaygroundPage >> spawnFlushProcess [ @@ -204,6 +251,18 @@ StPlaygroundPage >> timeToWait: aDuration [ timeToWait := aDuration ] +{ #category : #accessing } +StPlaygroundPage >> title [ + + ^ self firstLine ifNil: [ self class emptyTitle ] +] + +{ #category : #accessing } +StPlaygroundPage >> touch [ + + modificationTime := DateAndTime now +] + { #category : #'accessing - versions' } StPlaygroundPage >> versionLog [ diff --git a/src/NewTools-Playground/StPlaygroundPageFlushed.class.st b/src/NewTools-Playground/StPlaygroundPageFlushed.class.st new file mode 100644 index 000000000..62d823381 --- /dev/null +++ b/src/NewTools-Playground/StPlaygroundPageFlushed.class.st @@ -0,0 +1,31 @@ +" +Announces when a page is just flushed (saved to disk, generated a new version) +" +Class { + #name : #StPlaygroundPageFlushed, + #superclass : #Announcement, + #instVars : [ + 'page' + ], + #category : #'NewTools-Playground-Model' +} + +{ #category : #'instance creation' } +StPlaygroundPageFlushed class >> newPage: aPage [ + + ^ self new + page: aPage; + yourself +] + +{ #category : #accessing } +StPlaygroundPageFlushed >> page [ + + ^ page +] + +{ #category : #accessing } +StPlaygroundPageFlushed >> page: anObject [ + + page := anObject +] diff --git a/src/NewTools-Playground/StPlaygroundPageLoaded.class.st b/src/NewTools-Playground/StPlaygroundPageLoaded.class.st new file mode 100644 index 000000000..b16751094 --- /dev/null +++ b/src/NewTools-Playground/StPlaygroundPageLoaded.class.st @@ -0,0 +1,31 @@ +" +Announces when a page has been loaded. +" +Class { + #name : #StPlaygroundPageLoaded, + #superclass : #Announcement, + #instVars : [ + 'page' + ], + #category : #'NewTools-Playground-Model' +} + +{ #category : #'instance creation' } +StPlaygroundPageLoaded class >> newPage: aPage [ + + ^ self new + page: aPage; + yourself +] + +{ #category : #accessing } +StPlaygroundPageLoaded >> page [ + + ^ page +] + +{ #category : #accessing } +StPlaygroundPageLoaded >> page: anObject [ + + page := anObject +] diff --git a/src/NewTools-Playground/StPlaygroundPagePresenter.class.st b/src/NewTools-Playground/StPlaygroundPagePresenter.class.st index 12bb87f57..77f7fbcd5 100644 --- a/src/NewTools-Playground/StPlaygroundPagePresenter.class.st +++ b/src/NewTools-Playground/StPlaygroundPagePresenter.class.st @@ -5,6 +5,7 @@ Since `StPlayground` is in fact a miller list that allows users to navigate, the Class { #name : #StPlaygroundPagePresenter, #superclass : #StPresenter, + #classTraits : 'SpTModel classTrait', #instVars : [ 'text', 'toolbar', @@ -12,7 +13,8 @@ Class { 'lineLabel', 'toggleLineNumberButton', 'page', - 'activationBlock' + 'activationBlock', + 'loading' ], #classVars : [ 'CacheDirectory' @@ -20,7 +22,7 @@ Class { #category : #'NewTools-Playground-View' } -{ #category : #'private commands' } +{ #category : #'private - commands' } StPlaygroundPagePresenter class >> baseToolbarCommands [ ^ { @@ -68,13 +70,13 @@ StPlaygroundPagePresenter class >> defaultTitle [ ^ 'Playground' ] -{ #category : #'private commands' } +{ #category : #'private - commands' } StPlaygroundPagePresenter class >> extendedMenuCommands [ ^ StPlaygroundMenuExtensionCommand allCommands ] -{ #category : #'private commands' } +{ #category : #'private - commands' } StPlaygroundPagePresenter class >> extendedToolbarCommands [ ^ StPlaygroundToolbarExtensionCommand allCommands @@ -104,7 +106,7 @@ StPlaygroundPagePresenter class >> registerToolsOn: registry [ ] -{ #category : #'private commands' } +{ #category : #'private - commands' } StPlaygroundPagePresenter class >> toolbarCommands [ ^ (self baseToolbarCommands, self extendedToolbarCommands) sorted: #order ascending @@ -192,6 +194,13 @@ StPlaygroundPagePresenter >> hasOutputActivationPort [ ^ true ] +{ #category : #initialization } +StPlaygroundPagePresenter >> initialize [ + + loading := false. + super initialize +] + { #category : #initialization } StPlaygroundPagePresenter >> initializePresenters [ @@ -205,7 +214,7 @@ StPlaygroundPagePresenter >> initializePresenters [ withEditionContextMenu; contextMenu: [ (self menuActionsFor: text) asMenuPresenter ]; contextKeyBindings: (self menuActionsFor: text) asKMCategory; - whenTextChangedDo: [ :aString | page contents: aString ]. + whenTextChangedDo: [ :aString | self updateContents: aString ]. text announcer when: SpCodeWillBeEvaluatedAnnouncement @@ -266,10 +275,19 @@ StPlaygroundPagePresenter >> interactionModel [ ] { #category : #actions } -StPlaygroundPagePresenter >> loadPage: aFileReference [ +StPlaygroundPagePresenter >> loadPage: aPage [ - self basicPage: (StPlaygroundPage fromReference: aFileReference). - text text: page contents. + loading := true. + + [ + self basicPage: aPage. + aPage onFlush: [ + self announce: (StPlaygroundPageFlushed newPage: aPage) ]. + self announce: (StPlaygroundPageLoaded newPage: aPage). + self updatePresenter ] + ensure: [ + loading := false ]. + ^ page ] @@ -380,6 +398,13 @@ StPlaygroundPagePresenter >> toolbarActions [ yourself ] +{ #category : #'private - updating' } +StPlaygroundPagePresenter >> updateContents: aString [ + + loading ifTrue: [ ^ self ]. + self page contents: aString +] + { #category : #'private - updating' } StPlaygroundPagePresenter >> updateLineNumber [ | pos | diff --git a/src/NewTools-Playground/StPlaygroundPageSummaryPresenter.class.st b/src/NewTools-Playground/StPlaygroundPageSummaryPresenter.class.st index 498d32273..356f15f27 100644 --- a/src/NewTools-Playground/StPlaygroundPageSummaryPresenter.class.st +++ b/src/NewTools-Playground/StPlaygroundPageSummaryPresenter.class.st @@ -6,8 +6,9 @@ I am meant to be used in StPlaygroundPagesPresenter, as element of a list. Class { #name : #StPlaygroundPageSummaryPresenter, #superclass : #SpPresenter, + #traits : 'SpTModel', + #classTraits : 'SpTModel classTrait', #instVars : [ - 'page', 'firstLineLabel', 'timeLabel' ], @@ -17,7 +18,7 @@ Class { { #category : #accessing } StPlaygroundPageSummaryPresenter >> contents [ - ^ page contents + ^ self model contents ] { #category : #initialization } @@ -30,30 +31,25 @@ StPlaygroundPageSummaryPresenter >> initializePresenters [ add: (timeLabel := self newLabel) expand: false; yourself. - firstLineLabel label: self pageFirstLine. - timeLabel - addStyle: 'dim'; - label: page creationTime epiceaBrowsersAsString + timeLabel addStyle: 'dim' ] { #category : #accessing } StPlaygroundPageSummaryPresenter >> page [ - ^ page + ^ self model ] { #category : #initialization } -StPlaygroundPageSummaryPresenter >> pageFirstLine [ - - page readStreamDo: [ :stream | | line | - [ stream atEnd not and: [ (line := stream nextLine trimmed) isEmpty ] ] whileTrue. - line isEmptyOrNil ifFalse: [ ^ line ] ]. +StPlaygroundPageSummaryPresenter >> pageTitle [ - ^ 'Empty' + ^ self model title ] -{ #category : #'accessing - model' } -StPlaygroundPageSummaryPresenter >> setModelBeforeInitialization: aPage [ +{ #category : #initialization } +StPlaygroundPageSummaryPresenter >> updatePresenter [ - page := aPage + self model ifNil: [ ^ self ]. + firstLineLabel label: self pageTitle. + timeLabel label: self model modificationTime epiceaBrowsersAsString ] diff --git a/src/NewTools-Playground/StPlaygroundPagesCommand.class.st b/src/NewTools-Playground/StPlaygroundPagesCommand.class.st index 7a42523c8..6e7d5da63 100644 --- a/src/NewTools-Playground/StPlaygroundPagesCommand.class.st +++ b/src/NewTools-Playground/StPlaygroundPagesCommand.class.st @@ -39,3 +39,9 @@ StPlaygroundPagesCommand >> execute [ model: context) openDialog ] + +{ #category : #actions } +StPlaygroundPagesCommand >> loadPage: page [ + + context loadPage: page +] diff --git a/src/NewTools-Playground/StPlaygroundPagesPresenter.class.st b/src/NewTools-Playground/StPlaygroundPagesPresenter.class.st index 6c0e55b62..91afe8ef2 100644 --- a/src/NewTools-Playground/StPlaygroundPagesPresenter.class.st +++ b/src/NewTools-Playground/StPlaygroundPagesPresenter.class.st @@ -12,7 +12,8 @@ Class { 'pageList', 'pagePreview', 'pageListPanel', - 'pagePreviewPanel' + 'pagePreviewPanel', + 'loadPageAction' ], #category : #'NewTools-Playground-View' } @@ -134,9 +135,9 @@ StPlaygroundPagesPresenter >> initializeWindow: aWindowPresenter [ { #category : #actions } StPlaygroundPagesPresenter >> loadPage: aPage [ - self parent loadPage: aPage. self window close. - self parent takeKeyboardFocus + loadPageAction ifNotNil: [ + loadPageAction value: aPage ] ] { #category : #actions } @@ -145,11 +146,18 @@ StPlaygroundPagesPresenter >> loadSelectedPage [ self loadPage: self selectedPage ] +{ #category : #events } +StPlaygroundPagesPresenter >> onLoadPage: aBlock [ + + loadPageAction := aBlock +] + { #category : #accessing } StPlaygroundPagesPresenter >> pages [ - ^ (StPlayground cacheDirectory allChildrenMatching: '*.ph') - sorted: [ :a :b | a creationTime > b creationTime ] + ^ ((StPlayground cacheDirectory allChildrenMatching: '*.ph') + sorted: [ :a :b | a creationTime > b creationTime ]) + collect: [ :each | StPlaygroundPage fromReference: each ] ] { #category : #private } diff --git a/src/NewTools-Spotter/StSpotterStep.class.st b/src/NewTools-Spotter/StSpotterStep.class.st index af268c881..af62d189a 100644 --- a/src/NewTools-Spotter/StSpotterStep.class.st +++ b/src/NewTools-Spotter/StSpotterStep.class.st @@ -169,7 +169,6 @@ StSpotterStep >> processors: aCollection [ StSpotterStep >> pushQuery: aQuery [ self deactivate. - aQuery processors: (self processors sort: #order ascending). self activateQuery: aQuery. aQuery process From c95e02b010bbfef196344c7a3d73caf49a2e9615 Mon Sep 17 00:00:00 2001 From: Esteban Lorenzano Date: Mon, 11 Sep 2023 10:51:10 +0200 Subject: [PATCH 02/34] using an action event --- src/NewTools-Playground/StPlaygroundPagesCommand.class.st | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/NewTools-Playground/StPlaygroundPagesCommand.class.st b/src/NewTools-Playground/StPlaygroundPagesCommand.class.st index 6e7d5da63..f3256a9e4 100644 --- a/src/NewTools-Playground/StPlaygroundPagesCommand.class.st +++ b/src/NewTools-Playground/StPlaygroundPagesCommand.class.st @@ -31,12 +31,15 @@ StPlaygroundPagesCommand class >> order [ ^ 30 ] -{ #category : #execution } +{ #category : #executing } StPlaygroundPagesCommand >> execute [ (StPlaygroundPagesPresenter newApplication: context application model: context) + onLoadPage: [ :page | + self loadPage: page. + context takeKeyboardFocus ]; openDialog ] From 11247c35f41331c9c730480cb3342dcf8d413bc3 Mon Sep 17 00:00:00 2001 From: Esteban Lorenzano Date: Mon, 11 Sep 2023 11:22:35 +0200 Subject: [PATCH 03/34] playbook version bump --- .../StPlaybook.class.st | 262 ++++++++++++++++++ .../StPlaybookNewPageCommand.class.st | 38 +++ .../StPlaybookPageEntry.class.st | 52 ++++ .../StPlaybookPagesCommand.class.st | 14 + .../StPlaybookProcessor.class.st | 46 +++ .../StPlaybookRemovePageCommand.class.st | 32 +++ src/NewTools-Playground-Playbook/package.st | 1 + 7 files changed, 445 insertions(+) create mode 100644 src/NewTools-Playground-Playbook/StPlaybook.class.st create mode 100644 src/NewTools-Playground-Playbook/StPlaybookNewPageCommand.class.st create mode 100644 src/NewTools-Playground-Playbook/StPlaybookPageEntry.class.st create mode 100644 src/NewTools-Playground-Playbook/StPlaybookPagesCommand.class.st create mode 100644 src/NewTools-Playground-Playbook/StPlaybookProcessor.class.st create mode 100644 src/NewTools-Playground-Playbook/StPlaybookRemovePageCommand.class.st create mode 100644 src/NewTools-Playground-Playbook/package.st diff --git a/src/NewTools-Playground-Playbook/StPlaybook.class.st b/src/NewTools-Playground-Playbook/StPlaybook.class.st new file mode 100644 index 000000000..ed80be029 --- /dev/null +++ b/src/NewTools-Playground-Playbook/StPlaybook.class.st @@ -0,0 +1,262 @@ +" +A playbook is a keeper of playgrounds (in a list). +This works to enhance grouping (as playgrounds tends to accumulate). +" +Class { + #name : #StPlaybook, + #superclass : #StPlayground, + #instVars : [ + 'pageList', + 'pageListToolbar', + 'pages', + 'activating' + ], + #category : #'NewTools-Playground-Playbook-View' +} + +{ #category : #'private - commands' } +StPlaybook class >> baseToolbarCommands [ + + ^ { + StPlaybookNewPageCommand. + StPlaybookPagesCommand. + } +] + +{ #category : #accessing } +StPlaybook class >> defaultTitle [ + + ^ 'Playbook' +] + +{ #category : #'private - commands' } +StPlaybook class >> extendedToolbarCommands [ + + ^ #() +] + +{ #category : #'world menu' } +StPlaybook class >> menuCommandOn: aBuilder [ + + + (aBuilder item: #Playbook) + parent: #InputOutput; + action: [ StPlaybook open ]; + order: 1; + keyText: 'o, p'; + help: 'A window used as a scratchpad area where fragments of Pharo code can be entered, stored, edited, and evaluated.'; + icon: (self iconNamed: #workspace) +] + +{ #category : #'private - commands' } +StPlaybook class >> toolbarCommands [ + + ^ (self baseToolbarCommands, self extendedToolbarCommands) sorted: #order ascending +] + +{ #category : #actions } +StPlaybook >> activatePage: aPage [ + + "if page is already in list, select it" + (pages includes: aPage) ifTrue: [ + pageList selectItem: (pageList items detect: [ :each | each model = aPage ]). + self loadPage: aPage. + ^ self ]. + + self activatingDo: [ + self cleanEmptyPlaygrounds. + aPage touch. + pages add: aPage. + self updatePresenter ] +] + +{ #category : #actions } +StPlaybook >> activateSelectedPage [ + + self activatingDo: [ + self loadPage: self selectedPage ] +] + +{ #category : #private } +StPlaybook >> activatingDo: aBlock [ + | oldActivating | + + oldActivating := activating. + activating := true. + aBlock ensure: [ + activating := false ] +] + +{ #category : #private } +StPlaybook >> addPageListToolbarCommandsTo: aGroup [ + + self class toolbarCommands do: [ :each | + aGroup register: (each forSpecContext: self) ] +] + +{ #category : #private } +StPlaybook >> cleanEmptyPlaygrounds [ + + "'clean' empty playgrounds" + (pages + select: [ :each | each isEmpty ]) + do: [ :each | pages remove: each ]. +] + +{ #category : #layout } +StPlaybook >> defaultLayout [ + + ^ SpPanedLayout newHorizontal + positionOfSlider: 250; + add: (SpBoxLayout newTopToBottom + add: pageListToolbar expand: false; + add: pageList; + yourself); + add: millerList; + yourself +] + +{ #category : #actions } +StPlaybook >> doAddNewPage [ + + pages add: StPlaygroundPage new. + self updatePresenter +] + +{ #category : #actions } +StPlaybook >> doRemoveSelectedPage [ + + pages remove: self selectedPage. + pages + ifEmpty: [ self doAddNewPage ] + ifNotEmpty: [ self updatePresenter ] +] + +{ #category : #initialization } +StPlaybook >> initialize [ + + activating := false. + pages := OrderedCollection with: StPlaygroundPage new. + super initialize +] + +{ #category : #initialization } +StPlaybook >> initializePresenters [ + + super initializePresenters. + + pageListToolbar := self newToolbar + displayMode: self application toolbarDisplayMode; + addStyle: 'stToolbar'; + fillWith: self pageListToolbarActions; + yourself. + + pageList := self newComponentList + activateOnSingleClick; + contextMenu: [ self pageListActions asMenuPresenter ]; + contextKeyBindings: self pageListActions asKMCategory; + whenActivatedDo: [ self activateSelectedPage ]; + yourself +] + +{ #category : #'private - events' } +StPlaybook >> pageFlushed: ann [ + + pageList selectedItem updatePresenter. + "do not trigger an update (that will make me lose the cursor)" + pageList disableActivationDuring: [ + self updatePresenter ] +] + +{ #category : #private } +StPlaybook >> pageListActions [ + + ^ CmCommandGroup forSpec + beRoot; + register: (StPlaybookRemovePageCommand forSpecContext: self); + yourself +] + +{ #category : #private } +StPlaybook >> pageListToolbarActions [ + + ^ CmCommandGroup forSpec + in: [ :this | self addPageListToolbarCommandsTo: this ]; + yourself +] + +{ #category : #'private - events' } +StPlaybook >> pageLoaded: ann [ + | selectedItem | + + activating ifTrue: [ ^ self ]. + + selectedItem := pageList selectedItem. + ann page touch. + pages + at: (pages indexOf: selectedItem model) + put: ann page. + selectedItem model: ann page +] + +{ #category : #private } +StPlaybook >> pages [ + + ^ pages +] + +{ #category : #private } +StPlaybook >> pagesAsPresenters [ + + ^ self pages collect: [ :each | + self + instantiate: StPlaygroundPageSummaryPresenter + on: each ] +] + +{ #category : #private } +StPlaybook >> prepareInspectorAsPlayground: inspector [ + + inspector announcer + when: StPlaygroundPageLoaded + send: #pageLoaded: + to: self; + when: StPlaygroundPageFlushed + send: #pageFlushed: + to: self +] + +{ #category : #private } +StPlaybook >> selectedPage [ + + ^ pageList selectedItem page +] + +{ #category : #private } +StPlaybook >> sortFunction [ + + ^ [ :aPresenter | aPresenter model modificationTime ] descending +] + +{ #category : #'private - stepping' } +StPlaybook >> startProcessing [ + + super startProcessing. + self updatePageList +] + +{ #category : #'private - updating' } +StPlaybook >> updatePageList [ + + pageList updateItemsKeepingSelection: (pageList items sort: self sortFunction) +] + +{ #category : #initialization } +StPlaybook >> updatePresenter [ + + pageList + presenters: (self pagesAsPresenters sort: self sortFunction); + selectFirst. + + self loadPage: pageList selectedItem model +] diff --git a/src/NewTools-Playground-Playbook/StPlaybookNewPageCommand.class.st b/src/NewTools-Playground-Playbook/StPlaybookNewPageCommand.class.st new file mode 100644 index 000000000..03b0c3dde --- /dev/null +++ b/src/NewTools-Playground-Playbook/StPlaybookNewPageCommand.class.st @@ -0,0 +1,38 @@ +" +A command to add a new page to current book. +" +Class { + #name : #StPlaybookNewPageCommand, + #superclass : #StCommand, + #category : #'NewTools-Playground-Playbook-Command' +} + +{ #category : #default } +StPlaybookNewPageCommand class >> defaultDescription [ + + ^ 'Add new playground page.' +] + +{ #category : #accessing } +StPlaybookNewPageCommand class >> defaultIconName [ + + ^ #smallAdd +] + +{ #category : #default } +StPlaybookNewPageCommand class >> defaultName [ + + ^ 'New Page' +] + +{ #category : #default } +StPlaybookNewPageCommand class >> order [ + + ^ 0 +] + +{ #category : #executing } +StPlaybookNewPageCommand >> execute [ + + context doAddNewPage +] diff --git a/src/NewTools-Playground-Playbook/StPlaybookPageEntry.class.st b/src/NewTools-Playground-Playbook/StPlaybookPageEntry.class.st new file mode 100644 index 000000000..7bb655a5a --- /dev/null +++ b/src/NewTools-Playground-Playbook/StPlaybookPageEntry.class.st @@ -0,0 +1,52 @@ +" +An entry for playbook processor. +" +Class { + #name : #StPlaybookPageEntry, + #superclass : #StEntry, + #instVars : [ + 'page', + 'playbook' + ], + #category : #'NewTools-Playground-Playbook-Processor' +} + +{ #category : #'instance creation' } +StPlaybookPageEntry class >> newPlaybook: aPlaybook page: aPage [ + + ^ self new + playbook: aPlaybook; + page: aPage; + yourself +] + +{ #category : #converting } +StPlaybookPageEntry >> asString [ + + ^ page title +] + +{ #category : #evaluating } +StPlaybookPageEntry >> doEvaluate [ + + playbook activatePage: page. +] + +{ #category : #accessing } +StPlaybookPageEntry >> iconName [ + + ^ StPlaybook systemIconName +] + +{ #category : #initialization } +StPlaybookPageEntry >> page: aPage [ + + page := aPage. + self content: page contents +] + +{ #category : #initialization } +StPlaybookPageEntry >> playbook: aPlaybook [ + + playbook := aPlaybook +] diff --git a/src/NewTools-Playground-Playbook/StPlaybookPagesCommand.class.st b/src/NewTools-Playground-Playbook/StPlaybookPagesCommand.class.st new file mode 100644 index 000000000..2dd07e7c4 --- /dev/null +++ b/src/NewTools-Playground-Playbook/StPlaybookPagesCommand.class.st @@ -0,0 +1,14 @@ +" +Load page command for playbook +" +Class { + #name : #StPlaybookPagesCommand, + #superclass : #StPlaygroundPagesCommand, + #category : #'NewTools-Playground-Playbook-Command' +} + +{ #category : #actions } +StPlaybookPagesCommand >> loadPage: page [ + + context activatePage: page +] diff --git a/src/NewTools-Playground-Playbook/StPlaybookProcessor.class.st b/src/NewTools-Playground-Playbook/StPlaybookProcessor.class.st new file mode 100644 index 000000000..84628619b --- /dev/null +++ b/src/NewTools-Playground-Playbook/StPlaybookProcessor.class.st @@ -0,0 +1,46 @@ +" +A spotter processor to show playbook pages (and being able to pick them there) +" +Class { + #name : #StPlaybookProcessor, + #superclass : #StCollectionBasedProcessor, + #category : #'NewTools-Playground-Playbook-Processor' +} + +{ #category : #'default-settings' } +StPlaybookProcessor class >> defaultEnabled [ + + ^ true +] + +{ #category : #accessing } +StPlaybookProcessor class >> order [ + + ^ 10 +] + +{ #category : #accessing } +StPlaybookProcessor class >> title [ + + ^ 'Playbook Pages' +] + +{ #category : #filtering } +StPlaybookProcessor >> collection [ + + ^ StPlaybook allInstances flatCollect: [ :eachBook | + eachBook pages collect: [ :each | + StPlaybookPageEntry newPlaybook: eachBook page: each ] ] +] + +{ #category : #filtering } +StPlaybookProcessor >> newEntryOn: anElement [ + + ^ anElement +] + +{ #category : #configuration } +StPlaybookProcessor >> showForEmptyQuery [ + + ^ true +] diff --git a/src/NewTools-Playground-Playbook/StPlaybookRemovePageCommand.class.st b/src/NewTools-Playground-Playbook/StPlaybookRemovePageCommand.class.st new file mode 100644 index 000000000..519823e03 --- /dev/null +++ b/src/NewTools-Playground-Playbook/StPlaybookRemovePageCommand.class.st @@ -0,0 +1,32 @@ +" +A command to temove page from current playbook +" +Class { + #name : #StPlaybookRemovePageCommand, + #superclass : #StCommand, + #category : #'NewTools-Playground-Playbook-Command' +} + +{ #category : #default } +StPlaybookRemovePageCommand class >> defaultDescription [ + + ^ 'Remove selected playground from book.' +] + +{ #category : #default } +StPlaybookRemovePageCommand class >> defaultName [ + + ^ 'Remove' +] + +{ #category : #accessing } +StPlaybookRemovePageCommand class >> defaultShortcut [ + + ^ $x command mac | $x ctrl unix | $x ctrl win +] + +{ #category : #executing } +StPlaybookRemovePageCommand >> execute [ + + context doRemoveSelectedPage +] diff --git a/src/NewTools-Playground-Playbook/package.st b/src/NewTools-Playground-Playbook/package.st new file mode 100644 index 000000000..a2b714046 --- /dev/null +++ b/src/NewTools-Playground-Playbook/package.st @@ -0,0 +1 @@ +Package { #name : #'NewTools-Playground-Playbook' } From c406edf2f6113bf91f9b754450f4469e4a0e3e74 Mon Sep 17 00:00:00 2001 From: Esteban Lorenzano Date: Mon, 11 Sep 2023 12:51:55 +0200 Subject: [PATCH 04/34] ensure windows is top when choosing a playbook --- src/NewTools-Playground-Playbook/StPlaybook.class.st | 11 +++++++++-- .../StPlaybookPageEntry.class.st | 3 ++- 2 files changed, 11 insertions(+), 3 deletions(-) diff --git a/src/NewTools-Playground-Playbook/StPlaybook.class.st b/src/NewTools-Playground-Playbook/StPlaybook.class.st index ed80be029..7c3564205 100644 --- a/src/NewTools-Playground-Playbook/StPlaybook.class.st +++ b/src/NewTools-Playground-Playbook/StPlaybook.class.st @@ -54,13 +54,20 @@ StPlaybook class >> toolbarCommands [ ^ (self baseToolbarCommands, self extendedToolbarCommands) sorted: #order ascending ] +{ #category : #actions } +StPlaybook >> activateExistingPage: aPage [ + + pageList selectItem: (pageList items detect: [ :each | each model = aPage ]). + self loadPage: aPage. + millerList takeKeyboardFocus +] + { #category : #actions } StPlaybook >> activatePage: aPage [ "if page is already in list, select it" (pages includes: aPage) ifTrue: [ - pageList selectItem: (pageList items detect: [ :each | each model = aPage ]). - self loadPage: aPage. + self activateExistingPage: aPage. ^ self ]. self activatingDo: [ diff --git a/src/NewTools-Playground-Playbook/StPlaybookPageEntry.class.st b/src/NewTools-Playground-Playbook/StPlaybookPageEntry.class.st index 7bb655a5a..7c297e4d5 100644 --- a/src/NewTools-Playground-Playbook/StPlaybookPageEntry.class.st +++ b/src/NewTools-Playground-Playbook/StPlaybookPageEntry.class.st @@ -29,7 +29,8 @@ StPlaybookPageEntry >> asString [ { #category : #evaluating } StPlaybookPageEntry >> doEvaluate [ - playbook activatePage: page. + playbook window activate. + playbook activatePage: page ] { #category : #accessing } From 2cbbf45f7e59c913033d8b11f9bffa07a00f782a Mon Sep 17 00:00:00 2001 From: Esteban Lorenzano Date: Thu, 19 Oct 2023 13:12:46 +0200 Subject: [PATCH 05/34] fix --- src/NewTools-Playground/StPlayground.class.st | 1 + .../StPlaygroundPageFlushed.class.st | 14 ++++++++------ .../StPlaygroundPageLoaded.class.st | 14 ++++++++------ .../StPlaygroundPageSummaryPresenter.class.st | 2 +- .../StPlaygroundPagesCommand.class.st | 2 +- 5 files changed, 19 insertions(+), 14 deletions(-) diff --git a/src/NewTools-Playground/StPlayground.class.st b/src/NewTools-Playground/StPlayground.class.st index 1cc74ae4d..02d2c20dc 100644 --- a/src/NewTools-Playground/StPlayground.class.st +++ b/src/NewTools-Playground/StPlayground.class.st @@ -55,4 +55,5 @@ Class { { #category : 'testing' } StPlayground class >> isDeprecated [ + ^ false ] diff --git a/src/NewTools-Playground/StPlaygroundPageFlushed.class.st b/src/NewTools-Playground/StPlaygroundPageFlushed.class.st index 62d823381..dc33458fd 100644 --- a/src/NewTools-Playground/StPlaygroundPageFlushed.class.st +++ b/src/NewTools-Playground/StPlaygroundPageFlushed.class.st @@ -2,15 +2,17 @@ Announces when a page is just flushed (saved to disk, generated a new version) " Class { - #name : #StPlaygroundPageFlushed, - #superclass : #Announcement, + #name : 'StPlaygroundPageFlushed', + #superclass : 'Announcement', #instVars : [ 'page' ], - #category : #'NewTools-Playground-Model' + #category : 'NewTools-Playground-Model', + #package : 'NewTools-Playground', + #tag : 'Model' } -{ #category : #'instance creation' } +{ #category : 'instance creation' } StPlaygroundPageFlushed class >> newPage: aPage [ ^ self new @@ -18,13 +20,13 @@ StPlaygroundPageFlushed class >> newPage: aPage [ yourself ] -{ #category : #accessing } +{ #category : 'accessing' } StPlaygroundPageFlushed >> page [ ^ page ] -{ #category : #accessing } +{ #category : 'accessing' } StPlaygroundPageFlushed >> page: anObject [ page := anObject diff --git a/src/NewTools-Playground/StPlaygroundPageLoaded.class.st b/src/NewTools-Playground/StPlaygroundPageLoaded.class.st index b16751094..3970f49fb 100644 --- a/src/NewTools-Playground/StPlaygroundPageLoaded.class.st +++ b/src/NewTools-Playground/StPlaygroundPageLoaded.class.st @@ -2,15 +2,17 @@ Announces when a page has been loaded. " Class { - #name : #StPlaygroundPageLoaded, - #superclass : #Announcement, + #name : 'StPlaygroundPageLoaded', + #superclass : 'Announcement', #instVars : [ 'page' ], - #category : #'NewTools-Playground-Model' + #category : 'NewTools-Playground-Model', + #package : 'NewTools-Playground', + #tag : 'Model' } -{ #category : #'instance creation' } +{ #category : 'instance creation' } StPlaygroundPageLoaded class >> newPage: aPage [ ^ self new @@ -18,13 +20,13 @@ StPlaygroundPageLoaded class >> newPage: aPage [ yourself ] -{ #category : #accessing } +{ #category : 'accessing' } StPlaygroundPageLoaded >> page [ ^ page ] -{ #category : #accessing } +{ #category : 'accessing' } StPlaygroundPageLoaded >> page: anObject [ page := anObject diff --git a/src/NewTools-Playground/StPlaygroundPageSummaryPresenter.class.st b/src/NewTools-Playground/StPlaygroundPageSummaryPresenter.class.st index 3fce44416..ab38cce94 100644 --- a/src/NewTools-Playground/StPlaygroundPageSummaryPresenter.class.st +++ b/src/NewTools-Playground/StPlaygroundPageSummaryPresenter.class.st @@ -40,7 +40,7 @@ StPlaygroundPageSummaryPresenter >> page [ ^ self model ] -{ #category : #initialization } +{ #category : 'initialization' } StPlaygroundPageSummaryPresenter >> pageTitle [ ^ 'Empty' diff --git a/src/NewTools-Playground/StPlaygroundPagesCommand.class.st b/src/NewTools-Playground/StPlaygroundPagesCommand.class.st index d5a296b4d..db0aad694 100644 --- a/src/NewTools-Playground/StPlaygroundPagesCommand.class.st +++ b/src/NewTools-Playground/StPlaygroundPagesCommand.class.st @@ -45,7 +45,7 @@ StPlaygroundPagesCommand >> execute [ openDialog ] -{ #category : #actions } +{ #category : 'actions' } StPlaygroundPagesCommand >> loadPage: page [ context loadPage: page From 78fc328f15679e377d4284dc34f64fe2b6e72168 Mon Sep 17 00:00:00 2001 From: Esteban Lorenzano Date: Thu, 19 Oct 2023 15:13:41 +0200 Subject: [PATCH 06/34] added missing parts (durying the manual merge) --- src/NewTools-Playground/StPlaygroundPage.class.st | 6 ++++++ .../StPlaygroundPageSummaryPresenter.class.st | 2 ++ 2 files changed, 8 insertions(+) diff --git a/src/NewTools-Playground/StPlaygroundPage.class.st b/src/NewTools-Playground/StPlaygroundPage.class.st index fd38f4e90..bb55edeaf 100644 --- a/src/NewTools-Playground/StPlaygroundPage.class.st +++ b/src/NewTools-Playground/StPlaygroundPage.class.st @@ -33,6 +33,12 @@ StPlaygroundPage class >> defaultTimeToWait [ ^ 10 seconds ] +{ #category : 'accessing' } +StPlaygroundPage class >> emptyTitle [ + + ^ 'Empty' +] + { #category : 'instance creation' } StPlaygroundPage class >> fromReference: aFileReference [ diff --git a/src/NewTools-Playground/StPlaygroundPageSummaryPresenter.class.st b/src/NewTools-Playground/StPlaygroundPageSummaryPresenter.class.st index ab38cce94..592f85936 100644 --- a/src/NewTools-Playground/StPlaygroundPageSummaryPresenter.class.st +++ b/src/NewTools-Playground/StPlaygroundPageSummaryPresenter.class.st @@ -6,6 +6,8 @@ I am meant to be used in StPlaygroundPagesPresenter, as element of a list. Class { #name : 'StPlaygroundPageSummaryPresenter', #superclass : 'SpPresenter', + #traits : 'SpTModel', + #classTraits : 'SpTModel classTrait', #instVars : [ 'firstLineLabel', 'timeLabel' From b61db56a5739cd87994367b6923358c1d4857623 Mon Sep 17 00:00:00 2001 From: Esteban Lorenzano Date: Sun, 22 Oct 2023 17:36:29 +0200 Subject: [PATCH 07/34] enhance playground extensibility --- .../StPlaygroundPageSummaryPresenter.class.st | 2 +- .../StPlaygroundPagesPresenter.class.st | 6 ++++++ .../StPlaygroundPresenter.class.st | 21 +++++++++++++------ 3 files changed, 22 insertions(+), 7 deletions(-) diff --git a/src/NewTools-Playground/StPlaygroundPageSummaryPresenter.class.st b/src/NewTools-Playground/StPlaygroundPageSummaryPresenter.class.st index 592f85936..5a634732c 100644 --- a/src/NewTools-Playground/StPlaygroundPageSummaryPresenter.class.st +++ b/src/NewTools-Playground/StPlaygroundPageSummaryPresenter.class.st @@ -45,7 +45,7 @@ StPlaygroundPageSummaryPresenter >> page [ { #category : 'initialization' } StPlaygroundPageSummaryPresenter >> pageTitle [ - ^ 'Empty' + ^ self model title ] { #category : 'initialization' } diff --git a/src/NewTools-Playground/StPlaygroundPagesPresenter.class.st b/src/NewTools-Playground/StPlaygroundPagesPresenter.class.st index a36466b7f..7a413cc41 100644 --- a/src/NewTools-Playground/StPlaygroundPagesPresenter.class.st +++ b/src/NewTools-Playground/StPlaygroundPagesPresenter.class.st @@ -148,6 +148,12 @@ StPlaygroundPagesPresenter >> loadSelectedPage [ self loadPage: self selectedPage ] +{ #category : 'events' } +StPlaygroundPagesPresenter >> onLoadPage: aBlock [ + + loadPageAction := aBlock +] + { #category : 'accessing' } StPlaygroundPagesPresenter >> pages [ diff --git a/src/NewTools-Playground/StPlaygroundPresenter.class.st b/src/NewTools-Playground/StPlaygroundPresenter.class.st index 9ecb836e7..d692afd65 100644 --- a/src/NewTools-Playground/StPlaygroundPresenter.class.st +++ b/src/NewTools-Playground/StPlaygroundPresenter.class.st @@ -176,13 +176,17 @@ StPlaygroundPresenter >> newDefaultPlaygroundPage [ { #category : 'private - factory' } StPlaygroundPresenter >> newInspectorFor: aModel [ - | modelToInspectOrPlayground | - - modelToInspectOrPlayground := (millerList pages isEmpty and: [ aModel isNil ]) - ifTrue: [ self newDefaultPlaygroundPage ] - ifFalse: [ aModel ]. + | isPlayground inspector | - ^ super newInspectorFor: modelToInspectOrPlayground + isPlayground := millerList pages isEmpty and: [ aModel isNil ]. + + inspector := super newInspectorFor: (isPlayground + ifTrue: [ self newDefaultPlaygroundPage ] + ifFalse: [ aModel ]). + + isPlayground ifTrue: [ self prepareInspectorAsPlayground: inspector ]. + + ^ inspector ] { #category : 'accessing' } @@ -191,6 +195,11 @@ StPlaygroundPresenter >> page [ ^ self firstPage page ] +{ #category : 'private' } +StPlaygroundPresenter >> prepareInspectorAsPlayground: inspector [ + +] + { #category : 'private - stepping' } StPlaygroundPresenter >> startProcessing [ From 2a0ac577d3486e6e11c286da405999e9418f8f31 Mon Sep 17 00:00:00 2001 From: Esteban Lorenzano Date: Sun, 22 Oct 2023 17:36:57 +0200 Subject: [PATCH 08/34] answer true to dark theme in dark configuration --- src/NewTools-Gtk/StPharoGtkDarkConfiguration.class.st | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/src/NewTools-Gtk/StPharoGtkDarkConfiguration.class.st b/src/NewTools-Gtk/StPharoGtkDarkConfiguration.class.st index 512771d9e..519697dc1 100644 --- a/src/NewTools-Gtk/StPharoGtkDarkConfiguration.class.st +++ b/src/NewTools-Gtk/StPharoGtkDarkConfiguration.class.st @@ -9,6 +9,12 @@ Class { #package : 'NewTools-Gtk' } +{ #category : 'testing' } +StPharoGtkDarkConfiguration >> isDarkTheme [ + + ^ true +] + { #category : 'accessing' } StPharoGtkDarkConfiguration >> macThemeName [ From b9bcb3630bda9aae6f8adb97d1bc17445468275f Mon Sep 17 00:00:00 2001 From: Esteban Lorenzano Date: Tue, 14 Nov 2023 15:20:39 +0100 Subject: [PATCH 09/34] apply deprecations --- src/NewTools-MethodBrowsers/MessageListPresenter.class.st | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/NewTools-MethodBrowsers/MessageListPresenter.class.st b/src/NewTools-MethodBrowsers/MessageListPresenter.class.st index 46c2ccbf5..0867e0876 100644 --- a/src/NewTools-MethodBrowsers/MessageListPresenter.class.st +++ b/src/NewTools-MethodBrowsers/MessageListPresenter.class.st @@ -302,7 +302,8 @@ MessageListPresenter >> packageOf: anItem [ { #category : 'private' } MessageListPresenter >> protocolNameForItem: anItem [ - ^ anItem category ifNil: [ '' ] + + ^ anItem protocolName ifNil: [ '' ] ] { #category : 'actions' } From d35a413872510d6849f6afb8eb0fa09d31529e63 Mon Sep 17 00:00:00 2001 From: Esteban Lorenzano Date: Tue, 14 Nov 2023 15:20:57 +0100 Subject: [PATCH 10/34] use default button --- src/NewTools-FontChooser/StFontChooserPresenter.class.st | 2 +- .../StPlaygroundBindingsPresenter.class.st | 2 +- .../StPlaygroundPageVersionsPresenter.class.st | 8 ++++---- .../StPlaygroundPagesPresenter.class.st | 8 ++++---- 4 files changed, 10 insertions(+), 10 deletions(-) diff --git a/src/NewTools-FontChooser/StFontChooserPresenter.class.st b/src/NewTools-FontChooser/StFontChooserPresenter.class.st index 217a09107..0cb50b838 100644 --- a/src/NewTools-FontChooser/StFontChooserPresenter.class.st +++ b/src/NewTools-FontChooser/StFontChooserPresenter.class.st @@ -167,8 +167,8 @@ StFontChooserPresenter >> initializeDialogWindow: aDialogWindowPresenter [ super initializeDialogWindow: aDialogWindowPresenter. aDialogWindowPresenter - addButton: 'Apply' do: [ :presenter | self applyChanges ]; addButton: 'Update' do: [ :presenter | self updateFonts ]; + addDefaultButton: 'Apply' do: [ :presenter | self applyChanges ]; okAction: [ self applyChanges ]. ] diff --git a/src/NewTools-Playground/StPlaygroundBindingsPresenter.class.st b/src/NewTools-Playground/StPlaygroundBindingsPresenter.class.st index 0e3b4cffc..6afba8459 100644 --- a/src/NewTools-Playground/StPlaygroundBindingsPresenter.class.st +++ b/src/NewTools-Playground/StPlaygroundBindingsPresenter.class.st @@ -95,7 +95,7 @@ StPlaygroundBindingsPresenter >> initializeDialogWindow: aDialogWindowPresenter aDialogWindowPresenter centeredRelativeTo: parent window; - addButton: 'Close' do: [ :presenter | + addDefaultButton: 'Close' do: [ :presenter | presenter triggerOkAction. presenter close ] ] diff --git a/src/NewTools-Playground/StPlaygroundPageVersionsPresenter.class.st b/src/NewTools-Playground/StPlaygroundPageVersionsPresenter.class.st index e8aa77fef..638cd5d1c 100644 --- a/src/NewTools-Playground/StPlaygroundPageVersionsPresenter.class.st +++ b/src/NewTools-Playground/StPlaygroundPageVersionsPresenter.class.st @@ -64,12 +64,12 @@ StPlaygroundPageVersionsPresenter >> doAdoptVersionOnNewPlayground [ StPlaygroundPageVersionsPresenter >> initializeDialogWindow: aDialogWindowPresenter [ aDialogWindowPresenter - addButton: 'Adopt' do: [ :presenter | - presenter triggerOkAction. - self adoptSelectedVersion ]; addButton: 'Close' do: [ :presenter | presenter triggerCancelAction. - presenter close ] + presenter close ]; + addDefaultButton: 'Adopt' do: [ :presenter | + presenter triggerOkAction. + self adoptSelectedVersion ] ] { #category : 'initialization' } diff --git a/src/NewTools-Playground/StPlaygroundPagesPresenter.class.st b/src/NewTools-Playground/StPlaygroundPagesPresenter.class.st index 7a413cc41..a6ecc44d8 100644 --- a/src/NewTools-Playground/StPlaygroundPagesPresenter.class.st +++ b/src/NewTools-Playground/StPlaygroundPagesPresenter.class.st @@ -82,12 +82,12 @@ StPlaygroundPagesPresenter >> initializeDialogWindow: aDialogWindowPresenter [ aDialogWindowPresenter centeredRelativeToTopWindow; - addButton: 'Load' do: [ :presenter | - presenter triggerOkAction. - self loadSelectedPage ]; addButton: 'Close' do: [ :presenter | presenter triggerCancelAction. - presenter close ] + presenter close ]; + addDefaultButton: 'Load' do: [ :presenter | + presenter triggerOkAction. + self loadSelectedPage ] ] { #category : 'initialization' } From 85d2c140088496053ac0e8e233202414f5d0dc67 Mon Sep 17 00:00:00 2001 From: Esteban Lorenzano Date: Tue, 14 Nov 2023 16:46:41 +0100 Subject: [PATCH 11/34] remove warnings --- src/NewTools-Gtk/StPharoGtkConfiguration.class.st | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/src/NewTools-Gtk/StPharoGtkConfiguration.class.st b/src/NewTools-Gtk/StPharoGtkConfiguration.class.st index 3cd92a06e..76ca67204 100644 --- a/src/NewTools-Gtk/StPharoGtkConfiguration.class.st +++ b/src/NewTools-Gtk/StPharoGtkConfiguration.class.st @@ -15,14 +15,14 @@ StPharoGtkConfiguration >> commonStyle [ ^ ' /* compact toolbar */ -toolbar.stToolbar { font-size: 0.7em } -toolbar.stToolbar toolbutton > button { padding: 2px; margin: 2px } +toolbar.stToolbar { font-size: 0.7em; } +toolbar.stToolbar toolbutton > button { padding: 2px; margin: 2px; } -.dim { color: LightSlateGrey } +.dim { color: LightSlateGrey; } .codePopover, .codePopover text { background-color: transparent; } -.scrollbarPopoverLarge { min-height: 350px } +.scrollbarPopoverLarge { min-height: 350px; } ' ] @@ -41,7 +41,7 @@ StPharoGtkConfiguration >> configureOSX: anApplication [ self installTheme: self macThemeName. self addCSSProviderFromString: ' -.code { font: 12pt "Monaco" } +.code { font: 12pt "Monaco"; } ' ] @@ -50,7 +50,7 @@ StPharoGtkConfiguration >> configureUnix: anApplication [ self unixThemeName ifNotNil: [ :aName | self installTheme: aName ]. self addCSSProviderFromString: ' -.code { /* font: 10pt "Source Code Pro" */ } +/* .code { font: 10pt "Source Code Pro" } */ ' ] @@ -59,7 +59,7 @@ StPharoGtkConfiguration >> configureWindows: anApplication [ self installTheme: self windowsThemeName. self addCSSProviderFromString: ' -.code { font: 10pt "Microsoft Sans Serif" } +.code { font: 10pt "Microsoft Sans Serif"; } ' ] From 22fda98a485e2a228923ed6928fb59628432e13c Mon Sep 17 00:00:00 2001 From: Esteban Lorenzano Date: Fri, 24 Nov 2023 09:29:06 +0100 Subject: [PATCH 12/34] working on the message browser (WIP) --- .../MessageBrowser.class.st | 2 +- .../MessageBrowserPresenter.class.st | 2 +- ...ter.class.st => StMessageBrowser.class.st} | 145 +++++++++--------- 3 files changed, 75 insertions(+), 74 deletions(-) rename src/NewTools-MethodBrowsers/{StMessageBrowserPresenter.class.st => StMessageBrowser.class.st} (75%) diff --git a/src/NewTools-MethodBrowsers/MessageBrowser.class.st b/src/NewTools-MethodBrowsers/MessageBrowser.class.st index 1795069d4..a2d852f64 100644 --- a/src/NewTools-MethodBrowsers/MessageBrowser.class.st +++ b/src/NewTools-MethodBrowsers/MessageBrowser.class.st @@ -1,6 +1,6 @@ Class { #name : 'MessageBrowser', - #superclass : 'StMessageBrowserPresenter', + #superclass : 'StMessageBrowser', #category : 'NewTools-MethodBrowsers-Deprecated', #package : 'NewTools-MethodBrowsers', #tag : 'Deprecated' diff --git a/src/NewTools-MethodBrowsers/MessageBrowserPresenter.class.st b/src/NewTools-MethodBrowsers/MessageBrowserPresenter.class.st index 2c1afce3f..8f4dcb2c2 100644 --- a/src/NewTools-MethodBrowsers/MessageBrowserPresenter.class.st +++ b/src/NewTools-MethodBrowsers/MessageBrowserPresenter.class.st @@ -1,6 +1,6 @@ Class { #name : 'MessageBrowserPresenter', - #superclass : 'StMessageBrowserPresenter', + #superclass : 'StMessageBrowser', #category : 'NewTools-MethodBrowsers-Deprecated', #package : 'NewTools-MethodBrowsers', #tag : 'Deprecated' diff --git a/src/NewTools-MethodBrowsers/StMessageBrowserPresenter.class.st b/src/NewTools-MethodBrowsers/StMessageBrowser.class.st similarity index 75% rename from src/NewTools-MethodBrowsers/StMessageBrowserPresenter.class.st rename to src/NewTools-MethodBrowsers/StMessageBrowser.class.st index 1ebea5039..cf8c5c363 100644 --- a/src/NewTools-MethodBrowsers/StMessageBrowserPresenter.class.st +++ b/src/NewTools-MethodBrowsers/StMessageBrowser.class.st @@ -9,7 +9,7 @@ MessageBrowser new yourself " Class { - #name : 'StMessageBrowserPresenter', + #name : 'StMessageBrowser', #superclass : 'AbstractMessageCentricBrowserPresenter', #instVars : [ 'title', @@ -21,8 +21,15 @@ Class { #tag : 'Senders' } +{ #category : 'tools registration' } +StMessageBrowser class >> beDefaultBrowser [ +