diff --git a/src/BaselineOfChest/BaselineOfChest.class.st b/src/BaselineOfChest/BaselineOfChest.class.st index ebac121..0ae597c 100644 --- a/src/BaselineOfChest/BaselineOfChest.class.st +++ b/src/BaselineOfChest/BaselineOfChest.class.st @@ -9,6 +9,8 @@ BaselineOfChest >> baseline: spec [ spec for: #common do: [ + spec postLoadDoIt: #postload:package:. + spec package: 'Chest'; package: 'Chest-Tests'; @@ -17,5 +19,21 @@ BaselineOfChest >> baseline: spec [ spec group: 'default' - with: #( 'Chest' 'Chest-Commands' 'Chest-Tests' 'Chest-Commands-Tests' ) + with: + #( 'Chest' 'Chest-Commands' 'Chest-Tests' 'Chest-Commands-Tests' ) +] + +{ #category : #baselines } +BaselineOfChest >> createChestExamples [ + + Chest at: 'fortyTwo' put: 42. + (Chest newNamed: 'ExampleChest') + at: 'tata' + put: 'someExampleStringCalledTata' +] + +{ #category : #baselines } +BaselineOfChest >> postload: loader package: packageSpec [ + + self createChestExamples ] diff --git a/src/Chest-Commands/ChestAddNewItemCommand.class.st b/src/Chest-Commands/ChestAddNewItemCommand.class.st new file mode 100644 index 0000000..9461235 --- /dev/null +++ b/src/Chest-Commands/ChestAddNewItemCommand.class.st @@ -0,0 +1,35 @@ +Class { + #name : #ChestAddNewItemCommand, + #superclass : #ChestCommand, + #category : #'Chest-Commands' +} + +{ #category : #default } +ChestAddNewItemCommand class >> defaultDescription [ + + ^ 'Request an expression whose result will be stored inside the selected chest' +] + +{ #category : #default } +ChestAddNewItemCommand class >> defaultIconName [ + + ^ #add +] + +{ #category : #default } +ChestAddNewItemCommand class >> defaultName [ + + ^ 'Add item' +] + +{ #category : #testing } +ChestAddNewItemCommand >> canBeExecuted [ + + ^ context selectedChest isNotNil +] + +{ #category : #executing } +ChestAddNewItemCommand >> execute [ + + ^ context requestExpressionToStoreInChest +] diff --git a/src/Chest-Commands/ChestCommand.class.st b/src/Chest-Commands/ChestCommand.class.st index 3978460..8543b37 100644 --- a/src/Chest-Commands/ChestCommand.class.st +++ b/src/Chest-Commands/ChestCommand.class.st @@ -30,9 +30,10 @@ ChestCommand class >> chestLoadItemCommandClasses [ { #category : #'accessing - commands classes' } ChestCommand class >> chestTableContentMenuCommandClasses [ - ^ { + ^ { ChestRenameItemCommand. ChestInspectItemCommand. + ChestAddNewItemCommand. ChestRemoveItemCommand. ChestRemoveAllItemsInChestCommand } ] @@ -40,16 +41,18 @@ ChestCommand class >> chestTableContentMenuCommandClasses [ { #category : #'accessing - commands classes' } ChestCommand class >> chestTableContentToolbarCommandClasses [ - ^ { - ChestRemoveItemCommand. - ChestRemoveAllItemsInChestCommand } + ^ { + ChestAddNewItemCommand. + ChestRemoveItemCommand } ] { #category : #'accessing - commands classes' } ChestCommand class >> chestTableMenuCommandClasses [ - ^ { + ^ { ChestRenameChestCommand. + ChestInspectChestCommand. + ChestAddNewChestCommand. ChestRemoveChestCommand. ChestRemoveAllChestsCommand } ] @@ -57,10 +60,9 @@ ChestCommand class >> chestTableMenuCommandClasses [ { #category : #'accessing - commands classes' } ChestCommand class >> chestTableToolbarCommandClasses [ - ^ { + ^ { ChestAddNewChestCommand. - ChestRemoveChestCommand. - ChestRemoveAllChestsCommand } + ChestRemoveChestCommand } ] { #category : #'accessing - commands classes' } diff --git a/src/Chest-Commands/ChestInspectChestCommand.class.st b/src/Chest-Commands/ChestInspectChestCommand.class.st new file mode 100644 index 0000000..294df81 --- /dev/null +++ b/src/Chest-Commands/ChestInspectChestCommand.class.st @@ -0,0 +1,41 @@ +Class { + #name : #ChestInspectChestCommand, + #superclass : #ChestCommand, + #category : #'Chest-Commands' +} + +{ #category : #default } +ChestInspectChestCommand class >> defaultDescription [ + + ^ 'Inspect the chest' +] + +{ #category : #default } +ChestInspectChestCommand class >> defaultIconName [ + + ^ #glamorousInspect +] + +{ #category : #default } +ChestInspectChestCommand class >> defaultName [ + + ^ 'Inspect chest' +] + +{ #category : #default } +ChestInspectChestCommand class >> defaultShortcutKey [ + + ^ $i meta +] + +{ #category : #testing } +ChestInspectChestCommand >> canBeExecuted [ + + ^ context selectedChest isNotNil +] + +{ #category : #executing } +ChestInspectChestCommand >> execute [ + + context selectedChest inspect +] diff --git a/src/Chest-Commands/ChestInspectItemCommand.class.st b/src/Chest-Commands/ChestInspectItemCommand.class.st index e5ea2dc..89d655f 100644 --- a/src/Chest-Commands/ChestInspectItemCommand.class.st +++ b/src/Chest-Commands/ChestInspectItemCommand.class.st @@ -10,6 +10,12 @@ ChestInspectItemCommand class >> defaultDescription [ ^ 'Inspect the object' ] +{ #category : #default } +ChestInspectItemCommand class >> defaultIconName [ + + ^ #glamorousInspect +] + { #category : #default } ChestInspectItemCommand class >> defaultName [ diff --git a/src/Chest/ChestPresenter.class.st b/src/Chest/ChestPresenter.class.st index 0670ed1..6f3684c 100644 --- a/src/Chest/ChestPresenter.class.st +++ b/src/Chest/ChestPresenter.class.st @@ -11,7 +11,16 @@ Class { 'chestsTable', 'chestContentsTable', 'inspector', - 'chestTableWithContent' + 'chestTableWithContent', + 'showPlaygroundButton', + 'showInspectorButton', + 'showPlaygroundContainer', + 'showInspectorContainer', + 'globalContainer' + ], + #classVars : [ + 'ShowInspector', + 'ShowPlayground' ], #category : #Chest } @@ -58,6 +67,28 @@ ChestPresenter class >> buildLoadItemCommandGroup: aChestWithContentPresenter fo aRoot register: group ] +{ #category : #settings } +ChestPresenter class >> chestSettingsOn: aBuilder [ + + + (aBuilder group: #ChestTool) + label: 'Chest'; + parent: #tools; + description: 'Settings related to the Chest tool'; + with: [ + (aBuilder setting: #showPlayground) + label: 'Shows playground in Chest'; + target: self; + default: self showPlayground; + description: 'Shows a playground below chests and their contents.'. + (aBuilder setting: #showInspector) + label: 'Shows inspector in Chest'; + target: self; + default: self showInspector; + description: + 'Shows an inspector on the right to chests and their contents, on the selected chest item' ] +] + { #category : #'menu-entry' } ChestPresenter class >> debugWorldMenuOn: aBuilder [ @@ -109,6 +140,30 @@ ChestPresenter class >> registerClasses: commandClasses toGroup: aGroup withCont beHiddenWhenCantBeRun) ] ] +{ #category : #accessing } +ChestPresenter class >> showInspector [ + + ^ ShowInspector ifNil: [ ShowInspector := false ] +] + +{ #category : #accessing } +ChestPresenter class >> showInspector: anObject [ + + ShowInspector := anObject +] + +{ #category : #accessing } +ChestPresenter class >> showPlayground [ + + ^ ShowPlayground ifNil: [ ShowPlayground := false ] +] + +{ #category : #accessing } +ChestPresenter class >> showPlayground: anObject [ + + ShowPlayground := anObject +] + { #category : #visiting } ChestPresenter >> accept: aVisitor [ @@ -199,13 +254,28 @@ ChestPresenter >> defaultLayout [ makeChestsTable; makeChestContentsTable. - ^ SpPanedLayout newHorizontal - add: (SpPanedLayout newVertical - add: #chestTableWithContent; - add: #playground; - yourself); - add: #inspector; - yourself + ^ globalContainer +] + +{ #category : #layout } +ChestPresenter >> displayInspector [ + + showInspectorContainer := SpBoxLayout newHorizontal + add: showInspectorButton expand: false; + add: inspector; + yourself. + globalContainer := SpPanedLayout newHorizontal + add: showPlaygroundContainer; + add: showInspectorContainer; + yourself. + showInspectorButton icon: (self application iconNamed: #enable) +] + +{ #category : #layout } +ChestPresenter >> displayPlayground [ + + showPlaygroundContainer add: playground. + showPlaygroundButton icon: (self application iconNamed: #enable) ] { #category : #layout } @@ -217,6 +287,24 @@ ChestPresenter >> headerLayoutWithTitle: aString withToolbar: aToolbar [ yourself ] +{ #category : #layout } +ChestPresenter >> hideInspector [ + + showInspectorContainer := showInspectorButton. + globalContainer := SpBoxLayout newHorizontal + add: showPlaygroundContainer; + add: showInspectorContainer expand: false; + yourself. + showInspectorButton icon: (self application iconNamed: #disable) +] + +{ #category : #layout } +ChestPresenter >> hidePlayground [ + + showPlaygroundContainer remove: playground. + showPlaygroundButton icon: (self application iconNamed: #disable) +] + { #category : #helper } ChestPresenter >> iconManager [ @@ -248,6 +336,8 @@ ChestPresenter >> initializePresenters [ chestsTable selectIndex: 1. self makeChestTreeTableContextMenu. + + self makeExpandableLayouts. self layout: self defaultLayout ] @@ -301,9 +391,11 @@ ChestPresenter >> makeChestContentsTable [ self makeChestContentTableContextMenu. ^ chestContentsTable - whenSelectionChangedDo: [ :selection | + whenSelectionChangedDo: [ :selection | + chestTableWithContent chestContentsTableTransmitBlock cull: + selection. inspector model inspectedObject: - (selection selectedItem ifNotNil: [ :association | + (selection selectedItem ifNotNil: [ :association | association value ]). inspector updateList ]; applyKeyBindingsFromMenu: chestContentsTable contextMenu value; @@ -356,15 +448,64 @@ ChestPresenter >> makeChestsTable [ yourself ] +{ #category : #layout } +ChestPresenter >> makeExpandableLayouts [ + + showPlaygroundButton := self newToggleButton + state: self class showPlayground; + icon: (self application iconNamed: #disable); + yourself. + showPlaygroundContainer := SpBoxLayout newVertical + add: #chestTableWithContent; + add: showPlaygroundButton expand: false; + yourself. + + self class showPlayground ifTrue: [ self displayPlayground ]. + + showInspectorButton := self newToggleButton + state: self class showInspector; + icon: (self application iconNamed: #disable); + yourself. + + self class showInspector + ifTrue: [ self displayInspector ] + ifFalse: [ self hideInspector ]. + + showPlaygroundButton + whenActivatedDo: [ + self class showPlayground: true. + self displayPlayground ]; + whenDeactivatedDo: [ + self class showPlayground: false. + self hidePlayground. + "not satisfied with this but, for obscure reasons, the layout won't update automatically if wer hide the playground after displaying or hiding the inspector. It still displays automatically the playground though, leading to having several playgrounds. I need to force the layout update to prevent that, though I don't really understand why I need to do that. Probably a Spec bug" + self layout: globalContainer ]. + + showInspectorButton + whenActivatedDo: [ + self class showInspector: true. + self displayInspector. + self layout: globalContainer ]; + whenDeactivatedDo: [ + self class showInspector: false. + self hideInspector. + self layout: globalContainer ] +] + { #category : #'presenter building' } ChestPresenter >> makePlayground [ | newPlayground | - newPlayground := StPlayground new. + newPlayground := StPlaygroundPresenter new. - debugger ifNotNil: [ "newPlayground firstPage text interactionModel" + debugger ifNotNil: [ newPlayground firstPage text interactionModel: (ChestCodeScriptingInteractionModel debugger: debugger) ]. + newPlayground firstPage text text: + 'tata := Chest at: ''fortyTwo'' "access an object from the default chest". +(Chest named: ''ExampleChest'') at: ''tata'' put: #tata "error: an object is already named ''tata'' in this chest". +Chest inChest: ''ExampleChest'' at: ''tata'' put: #tata "error: an object is already named ''tata'' in this chest. If ''ExampleChest'' didn''t exist, it would create it". +Chest weak newNamed: ''WeakChestExample'' "creates a new chest that holds weak references to its stored objects"'. ^ newPlayground ] @@ -405,6 +546,12 @@ ChestPresenter >> renameSelectedItem [ ^ chestTableWithContent renameSelectedItem ] +{ #category : #'ui - dialogs' } +ChestPresenter >> requestExpressionToStoreInChest [ + + chestTableWithContent requestExpressionToStoreInChest +] + { #category : #'ui - dialogs' } ChestPresenter >> requestNameNewChest [ diff --git a/src/Chest/ChestTableWithContentPresenter.class.st b/src/Chest/ChestTableWithContentPresenter.class.st index 56d3af6..ffe0037 100644 --- a/src/Chest/ChestTableWithContentPresenter.class.st +++ b/src/Chest/ChestTableWithContentPresenter.class.st @@ -19,6 +19,8 @@ Class { 'chestTableWithContentContainer', 'activePresenter', 'chestWithContentTreeTableToolbar', + 'chestTableToolbarCommandGroup', + 'chestContentsTableToolbarCommandGroup', 'buttonNoCopy', 'buttonShallowCopy', 'buttonDeepCopy' @@ -233,6 +235,12 @@ ChestTableWithContentPresenter >> chestContentsTableToolbar [ ^ chestContentsTableToolbar ] +{ #category : #initialization } +ChestTableWithContentPresenter >> chestContentsTableTransmitBlock [ + + ^ [ :selection | self updateChestContentToolbar ] +] + { #category : #accessing } ChestTableWithContentPresenter >> chestTableContainer [ @@ -242,16 +250,18 @@ ChestTableWithContentPresenter >> chestTableContainer [ { #category : #accessing } ChestTableWithContentPresenter >> chestTableTransmitBlock [ - ^ [ :aChest | + ^ [ :aChest | aChest - ifNotNil: [ + ifNotNil: [ self updateChestContentTableForChest: aChest. - chestContentsTable items ifNotEmpty: [ + chestContentsTable items ifNotEmpty: [ chestContentsTable selectIndex: 1 ]. inputField text: aChest nextDefaultNameForObject ] - ifNil: [ + ifNil: [ chestContentsTable items: { } asOrderedCollection. - inputField text: '' ] ] + inputField text: '' ]. + + self updateChestToolbar ] ] { #category : #accessing } @@ -305,7 +315,9 @@ ChestTableWithContentPresenter >> connectPresenters [ chestsTable transmitDo: self chestTableTransmitBlock; - selectFirst + selectFirst. + + chestContentsTable transmitDo: self chestContentsTableTransmitBlock ] { #category : #layout } @@ -448,7 +460,7 @@ ChestTableWithContentPresenter >> loadCommandLayout [ title: 'Variable Name' evaluated: #variableName) beEditable; - onAcceptEdition: [ :assoc :newVarName | + onAcceptEdition: [ :assoc :newVarName | assoc variableName: newVarName ]; yourself. self makeChestContentsTable. @@ -468,8 +480,9 @@ ChestTableWithContentPresenter >> loadCommandLayout [ add: (SpBoxLayout newHorizontal add: chestsTableToolbar; add: chestContentsTableToolbar; - yourself); - add: confirmActionBar; + yourself) + expand: false; + add: confirmActionBar expand: false; yourself ] @@ -488,15 +501,23 @@ ChestTableWithContentPresenter >> makeChestContentTableContextMenu [ ChestTableWithContentPresenter >> makeChestContentsTable [ chestContentsTable := self newTable - addColumn: ((SpStringTableColumn - title: 'Name' - evaluated: [ :association | - association key ]) width: 40); addColumn: (SpStringTableColumn - title: 'Object' - evaluated: [ :association | - association value asString ]); - items: #( ) asOrderedCollection. + title: 'Name' + evaluated: [ :association | + association key ]) beExpandable; + addColumn: (SpStringTableColumn + title: 'Value' + evaluated: [ :association | + association value printString ]) + beExpandable; + addColumn: (SpStringTableColumn + title: 'Class' + evaluated: [ :association | + association value class name ]) + beExpandable; + items: #( ) asOrderedCollection; + beResizable; + yourself. self makeChestContentTableContextMenu ] @@ -509,7 +530,10 @@ ChestTableWithContentPresenter >> makeChestContentsTableToolbar [ displayMode: StPharoSettings toolbarDisplayMode; addStyle: 'stToolbar'; fillWith: - self rootCommandsGroup / self class chestContentToolbarGroupName; + (chestContentsTableToolbarCommandGroup := self rootCommandsGroup + / + self class + chestContentToolbarGroupName); yourself ] @@ -587,11 +611,19 @@ ChestTableWithContentPresenter >> makeChestWithContentTreeTable [ { #category : #'presenter building' } ChestTableWithContentPresenter >> makeChestsTable [ - chestsTable := self newList + chestsTable := self newTable items: Chest allChests; - display: [ :chest | chest name ]; - sortingBlock: [ :chest1 :chest2 | + addColumn: + (SpStringTableColumn + title: 'Name' + evaluated: [ :chest | chest name ]) beExpandable; + addColumn: ((SpStringTableColumn + title: 'Size' + evaluated: [ :chest | + chest contents size asString ]) width: 40); + sortingBlock: [ :chest1 :chest2 | chest1 name < chest2 name ]; + beResizable; yourself. self makeChestTableContextMenu ] @@ -605,7 +637,10 @@ ChestTableWithContentPresenter >> makeChestsTableToolbar [ displayMode: StPharoSettings toolbarDisplayMode; addStyle: 'stToolbar'; fillWith: - self rootCommandsGroup / self class chestToolbarGroupName; + (chestTableToolbarCommandGroup := self rootCommandsGroup + / + self class + chestToolbarGroupName); yourself ] @@ -824,6 +859,24 @@ ChestTableWithContentPresenter >> renameSelectedItem [ ifFalse: [ chestContentsTable ]) ] +{ #category : #'ui - dialogs' } +ChestTableWithContentPresenter >> requestExpressionToStoreInChest [ + + | expression selectedChest expressionName | + selectedChest := self selectedChest. + expression := (UIManager default request: + ('Enter expression to be stored into ''{1}''' + format: { selectedChest name })) ifNil: [ ^ self ]. + expression trim ifEmpty: [ ^ self ]. + expressionName := self + storeExpression: expression + inChest: selectedChest. + UIManager default inform: + ('Object stored into''{1}'' as ''{2}'' successfully' format: { + selectedChest name. + expressionName }) +] + { #category : #'ui - dialogs' } ChestTableWithContentPresenter >> requestNameNewChest [ @@ -890,7 +943,7 @@ ChestTableWithContentPresenter >> storeCommandLayout [ self chestTableContainer removeAll; - add: inputField; + add: inputField expand: false; add: chestsTable. self chestContentTableContainer removeAll; @@ -901,16 +954,26 @@ ChestTableWithContentPresenter >> storeCommandLayout [ add: (SpBoxLayout newHorizontal add: chestsTableToolbar; add: chestContentsTableToolbar; - yourself); + yourself) expand: false; add: (SpBoxLayout newHorizontal add: buttonNoCopy; add: buttonShallowCopy; add: buttonDeepCopy; yourself); - add: confirmActionBar; + add: confirmActionBar expand: false; yourself ] +{ #category : #'ui - dialogs' } +ChestTableWithContentPresenter >> storeExpression: expression inChest: aChest [ + + | result | + result := Smalltalk compiler + source: expression; + evaluate. + ^ aChest add: result +] + { #category : #updating } ChestTableWithContentPresenter >> subscribeToChestAnnouncer [ @@ -971,6 +1034,18 @@ ChestTableWithContentPresenter >> updateChestContentTableForChest: aChest [ lst items: aChest contents associations asOrderedCollection ] ] +{ #category : #updating } +ChestTableWithContentPresenter >> updateChestContentToolbar [ + + self updateToolbar: chestContentsTableToolbarCommandGroup +] + +{ #category : #updating } +ChestTableWithContentPresenter >> updateChestToolbar [ + + self updateToolbar: chestTableToolbarCommandGroup +] + { #category : #updating } ChestTableWithContentPresenter >> updateChestsTable [ @@ -982,6 +1057,13 @@ ChestTableWithContentPresenter >> updateChestsTable [ chestsTable ifNotNil: [ :lst | lst items: Chest allChests ] ] +{ #category : #accessing } +ChestTableWithContentPresenter >> updateToolbar: aCmCommandGroup [ + + aCmCommandGroup allCommands do: [ :spCommand | + spCommand updateEnableStatus ] +] + { #category : #'ui - dialogs' } ChestTableWithContentPresenter >> warningNamingChest: newChestName [