[squeak-dev] The Inbox: Tools-tonyg.1033.mcz

commits at source.squeak.org commits at source.squeak.org
Thu Mar 25 12:41:24 UTC 2021


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 at 0 corner: 0.15 at max) -> [self buildEnvironmentTreeWith: builder].
+ 		(0.15 at 0 corner: 0.35 at 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 at 0 corner: 0.75 at max) -> [self buildMessageCategoryListWith: builder].
+ 		(0.75 at 0 corner: 1 at max) -> [self buildMessageListWith: builder].
+ 		(0 at max corner: 1 at 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!



More information about the Squeak-dev mailing list