The Inbox: Tools-tonyg.1033.mcz

Tony Garnock-Jones uploaded a new version of Tools to project The Inbox:
http://source.squeak.org/inbox/Tools-tonyg.1033.mcz

==================== Summary ====================

Name: Tools-tonyg.1033
Author: tonyg
Time: 25 March 2021, 1:41:22.140964 pm
UUID: 904b0ec0-42f7-4ee7-9151-9b909132f7bd
Ancestors: Tools-tonyg.1032

EXPERIMENTAL. EnvironmentBrowser class, to go alongside Environments-tonyg.78, which introduces nested `Namespace`s.

=============== Diff against Tools-tonyg.1032 ===============

Item was changed:
- SystemOrganization addCategory: #'Tools-ArchiveViewer'!
- SystemOrganization addCategory: #'Tools-Base'!
- SystemOrganization addCategory: #'Tools-Browser'!
- SystemOrganization addCategory: #'Tools-Changes'!
  SystemOrganization addCategory: #'Tools-Debugger'!
+ SystemOrganization addCategory: #'Tools-Changes'!
+ SystemOrganization addCategory: #'Tools-Inspector'!
+ SystemOrganization addCategory: #'Tools-MethodFinder'!
- SystemOrganization addCategory: #'Tools-Explorer'!
  SystemOrganization addCategory: #'Tools-File Contents Browser'!
  SystemOrganization addCategory: #'Tools-FileList'!
+ SystemOrganization addCategory: #'Tools-Explorer'!
- SystemOrganization addCategory: #'Tools-Inspector'!
  SystemOrganization addCategory: #'Tools-Menus'!
+ SystemOrganization addCategory: #'Tools-Browser'!
+ SystemOrganization addCategory: #'Tools-Base'!
+ SystemOrganization addCategory: #'Tools-ArchiveViewer'!
- SystemOrganization addCategory: #'Tools-MethodFinder'!
  SystemOrganization addCategory: #'Tools-Process Browser'!

Item was added:
+ Browser subclass: #EnvironmentBrowser
+ instanceVariableNames: 'environmentPath'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Tools-Browser'!

Item was added:
+ ----- Method: EnvironmentBrowser>>buildDefaultBrowserWith: (in category 'toolbuilder') -----
+ buildDefaultBrowserWith: builder
+ | max windowSpec w |
+ max := self wantsOptionalButtons ifTrue:[0.42] ifFalse:[0.5].
+
+ windowSpec := self buildWindowWith: builder specs: {
+ (0@0 corner: 0.15@max) -> [self buildEnvironmentTreeWith: builder].
+ (0.15@0 corner: 0.35@max) -> [self buildSystemCategoryListWith: builder].
+ (self classListFrame: max fromLeft: 0.35 width: 0.25) -> [self buildClassListWith: builder].
+ (self switchesFrame: max fromLeft: 0.35 width: 0.25) -> [self buildSwitchesWith: builder].
+ (0.6@0 corner: 0.75@max) -> [self buildMessageCategoryListWith: builder].
+ (0.75@0 corner: 1@max) -> [self buildMessageListWith: builder].
+ (0@max corner: 1@1) -> [self buildCodePaneWith: builder].
+ }.
+ self setMultiWindowFor:windowSpec.
+
+ w := builder build: windowSpec.
+ self changed: #expandRootsRequested.
+ ^ w!

Item was added:
+ ----- Method: EnvironmentBrowser>>buildEnvironmentTreeWith: (in category 'namespace hierarchy') -----
+ buildEnvironmentTreeWith: builder
+ | treeSpec |
+ treeSpec := builder pluggableTreeSpec new.
+ treeSpec
+ model: self ;
+ roots: #rootEnvironmentList;
+ hasChildren: #hasSubenvironments:;
+ getChildren: #subenvironmentsOf:;
+ setSelected: #selectEnvironment: ;
+ getSelected: #environment;
+ getSelectedPath: #environmentPath;
+ label: #subenvironmentNameOf: ;
+ menu: #environmentMenu: ;
+ autoDeselect: false.
+ ^ treeSpec
+ !

Item was added:
+ ----- Method: EnvironmentBrowser>>createSubenvironment (in category 'namespace hierarchy') -----
+ createSubenvironment
+ | name e |
+ name := self promptForSafeName: 'What name should the new subenvironment have?'.
+ name ifNil: [^ self].
+ e := Namespace withName: name.
+ e parent: environment.
+ self changed: #rootEnvironmentList.
+ self selectEnvironment: e.
+ !

Item was added:
+ ----- Method: EnvironmentBrowser>>defaultBrowserTitle (in category 'initialize-release') -----
+ defaultBrowserTitle
+ ^ 'Environment Browser on ', self environment asString!

Item was added:
+ ----- Method: EnvironmentBrowser>>environmentMenu: (in category 'namespace hierarchy') -----
+ environmentMenu: aMenu
+ aMenu addList: #(
+ ('open workspace here' workspaceHere)
+ -
+ ).
+ aMenu
+ add: (environment isNamespace ifTrue: ['rename ...'] ifFalse: ['(cannot rename non-Namespace)'])
+ action: #renameEnvironment.
+ aMenu addList: #(
+ -
+ ('unlink environment' unlinkEnvironment)
+ ('create subenvironment' createSubenvironment)
+ ).
+ ^ aMenu
+ !

Item was added:
+ ----- Method: EnvironmentBrowser>>environmentPath (in category 'namespace hierarchy') -----
+ environmentPath
+ ^ self environment namespacePath reversed!

Item was added:
+ ----- Method: EnvironmentBrowser>>hasSubenvironments: (in category 'namespace hierarchy') -----
+ hasSubenvironments: anEnvironment
+ ^ anEnvironment namespaces notEmpty!

Item was added:
+ ----- Method: EnvironmentBrowser>>promptForSafeName: (in category 'namespace hierarchy') -----
+ promptForSafeName: promptString
+ | name |
+ name := UIManager default request: promptString.
+ name ifEmpty: [^ nil].
+ name := name asSymbol.
+ environment at: name ifPresent: [:existing |
+ self inform: 'That name already exists in the parent environment.'.
+ ^ nil].
+ ^ name!

Item was added:
+ ----- Method: EnvironmentBrowser>>renameEnvironment (in category 'namespace hierarchy') -----
+ renameEnvironment
+ | name |
+ environment isNamespace ifFalse: [^ self].
+ name := self promptForSafeName: 'What should the new name be?'.
+ name ifNil: [^ self].
+ environment rename: name.
+ self changed: #rootEnvironmentList.
+ self selectEnvironment: environment.!

Item was added:
+ ----- Method: EnvironmentBrowser>>rootEnvironmentList (in category 'namespace hierarchy') -----
+ rootEnvironmentList
+ ^ Environment wellKnownInstances!

Item was added:
+ ----- Method: EnvironmentBrowser>>selectEnvironment: (in category 'accessing') -----
+ selectEnvironment: anEnvironment
+ super selectEnvironment: (anEnvironment ifNil: [self rootEnvironmentList first]).
+ self changed: #windowTitle.
+ self changed: #systemCategoryList.
+ self changed: #environment.
+ self changed: #selectedPath.!

Item was added:
+ ----- Method: EnvironmentBrowser>>subenvironmentNameOf: (in category 'namespace hierarchy') -----
+ subenvironmentNameOf: anEnvironment
+ ^ anEnvironment info name!

Item was added:
+ ----- Method: EnvironmentBrowser>>subenvironmentsOf: (in category 'namespace hierarchy') -----
+ subenvironmentsOf: anEnvironment
+ ^ anEnvironment namespaces!

Item was added:
+ ----- Method: EnvironmentBrowser>>unlinkEnvironment (in category 'namespace hierarchy') -----
+ unlinkEnvironment
+ | p |
+ p := environment parent.
+ p ifNotNil: [
+ (self confirm: 'WARNING. You are about to delete an entire Environment!! Proceed?')
+ ifTrue: [
+ environment parent: nil.
+ self selectEnvironment: p.
+ self changed: #rootEnvironmentList.]]!

Item was added:
+ ----- Method: EnvironmentBrowser>>workspaceHere (in category 'namespace hierarchy') -----
+ workspaceHere
+ Workspace new
+ environment: self environment;
+ openLabel: 'Workspace on environment ', self environment name!