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

commits at source.squeak.org commits at source.squeak.org
Fri Mar 26 16:39:13 UTC 2021


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

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

Name: Tools-tonyg.1034
Author: tonyg
Time: 26 March 2021, 5:39:11.891811 pm
UUID: 351a3901-163a-4ccf-a9a2-2892c91e2ae1
Ancestors: Tools-tonyg.1033, Tools-mt.1033

EXPERIMENTAL. Merge from trunk, and add UI support for managing import/export policies of Environments in EnvironmentBrowser.

=============== Diff against Tools-tonyg.1033 ===============

Item was added:
+ ----- Method: AddPrefixNamePolicy>>description (in category '*Tools-Browsing') -----
+ description
+ 	^ '* -> ', prefix, '*'!

Item was added:
+ ----- Method: AllNamePolicy>>description (in category '*Tools-Browsing') -----
+ description
+ 	^ '*'!

Item was added:
+ ----- Method: BindingPolicy>>description (in category '*Tools-Browsing') -----
+ description
+ 	"It'd be nice to be a bit more explicit about this, rather than having
+ 	to infer importishness/exportishness by looking at the addSelector"
+ 	| pol |
+ 	pol := '(', policy description, ')'.
+ 	^ addSelector caseOf: {
+ 		[#notifyObserversOfBindingAdded:] -> ['export ', pol].
+ 		[#showBinding:] -> ['import ', environment printString, ' ', pol].
+ 	} otherwise: ['[?] ', environment printString, ' ', pol]!

Item was added:
+ ----- Method: Browser class>>fullOnEnvironment: (in category 'instance creation') -----
+ fullOnEnvironment: anEnvironment
+ 
+ 	^ self new
+ 		selectEnvironment: anEnvironment;
+ 		buildAndOpenFullBrowser!

Item was added:
+ ----- Method: Environment>>browse (in category '*Tools-Browsing') -----
+ browse
+ 
+ 	^ ToolSet browseEnvironment: self!

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

Item was changed:
  ----- 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 0.3) -> [self buildEnvironmentTreeWith: builder].
+ 		(0 at 0.3 corner: 0.35 at max) -> [self buildEnvironmentImportExportListWith: builder].
+ 		(0.15 at 0 corner: 0.35 at 0.3) -> [self buildSystemCategoryListWith: builder].
- 		(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>>buildEnvironmentImportExportListWith: (in category 'as yet unclassified') -----
+ buildEnvironmentImportExportListWith: builder
+ 	| listSpec |
+ 	listSpec := builder pluggableListSpec new.
+ 	listSpec 
+ 		model: self;
+ 		list: #importExportList;
+ 		getIndex: #importExportIndex; 
+ 		setIndex: #importExportIndex:;
+ 		menu: #importExportMenu:.
+ 	^listSpec
+ !

Item was changed:
  ----- 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: #(
+ 		('explore environment' exploreEnvironment)
  		-
  		('unlink environment' unlinkEnvironment)
  		('create subenvironment' createSubenvironment)
  		).
  	^ aMenu
  !

Item was added:
+ ----- Method: EnvironmentBrowser>>exploreEnvironment (in category 'as yet unclassified') -----
+ exploreEnvironment
+ 	self environment explore!

Item was added:
+ ----- Method: EnvironmentBrowser>>importExportExplore (in category 'as yet unclassified') -----
+ importExportExplore
+ 	(self environment policies at: importExportIndex) explore!

Item was added:
+ ----- Method: EnvironmentBrowser>>importExportExportAddingPrefix (in category 'as yet unclassified') -----
+ importExportExportAddingPrefix
+ 	| p |
+ 	p := UIManager default request: 'Prefix to add?'.
+ 	p ifNotEmpty: [
+ 		self environment exportAddingPrefix: p.
+ 		self changed: #importExportList]!

Item was added:
+ ----- Method: EnvironmentBrowser>>importExportExportRemovingPrefix (in category 'as yet unclassified') -----
+ importExportExportRemovingPrefix
+ 	| p |
+ 	p := UIManager default request: 'Prefix to filter by and then remove?'.
+ 	p ifNotEmpty: [
+ 		self environment exportRemovingPrefix: p.
+ 		self changed: #importExportList]!

Item was added:
+ ----- Method: EnvironmentBrowser>>importExportExportSelf (in category 'as yet unclassified') -----
+ importExportExportSelf
+ 	self environment exportSelf!

Item was added:
+ ----- Method: EnvironmentBrowser>>importExportExportSpecific (in category 'as yet unclassified') -----
+ importExportExportSpecific
+ 	(self requestNamesFrom: self environment title: 'Names to export') ifNotNil: [:names |
+ 		self environment export: names.
+ 		self changed: #importExportList]!

Item was added:
+ ----- Method: EnvironmentBrowser>>importExportImportAddingPrefix (in category 'as yet unclassified') -----
+ importExportImportAddingPrefix
+ 	self requestEnvironment: [:e | | p |
+ 		p := UIManager default request: 'Prefix to add?'.
+ 		p ifNotEmpty: [
+ 			self environment import: e addingPrefix: p.
+ 			self changed: #importExportList]]!

Item was added:
+ ----- Method: EnvironmentBrowser>>importExportImportAll (in category 'as yet unclassified') -----
+ importExportImportAll
+ 	self requestEnvironment: [:e |
+ 		self environment import: e.
+ 		self changed: #importExportList]!

Item was added:
+ ----- Method: EnvironmentBrowser>>importExportImportRemovingPrefix (in category 'as yet unclassified') -----
+ importExportImportRemovingPrefix
+ 	self requestEnvironment: [:e | | p |
+ 		p := UIManager default request: 'Prefix to filter by and then remove?'.
+ 		p ifNotEmpty: [
+ 			self environment import: e removingPrefix: p.
+ 			self changed: #importExportList]]!

Item was added:
+ ----- Method: EnvironmentBrowser>>importExportImportSelf (in category 'as yet unclassified') -----
+ importExportImportSelf
+ 	self environment importSelf!

Item was added:
+ ----- Method: EnvironmentBrowser>>importExportImportSpecific (in category 'as yet unclassified') -----
+ importExportImportSpecific
+ 	self requestEnvironment: [:e | 
+ 		(self requestNamesFrom: e title: 'Names to import') ifNotNil: [:names |
+ 			self environment from: e import: names.
+ 			self changed: #importExportList]]!

Item was added:
+ ----- Method: EnvironmentBrowser>>importExportIndex (in category 'as yet unclassified') -----
+ importExportIndex
+ 	^ importExportIndex ifNil: [0]!

Item was added:
+ ----- Method: EnvironmentBrowser>>importExportIndex: (in category 'as yet unclassified') -----
+ importExportIndex: newIndex
+ 	importExportIndex := newIndex.
+ 	self changed: #importExportIndex!

Item was added:
+ ----- Method: EnvironmentBrowser>>importExportList (in category 'as yet unclassified') -----
+ importExportList
+ 	^ self environment policies collect: [:p | p description]!

Item was added:
+ ----- Method: EnvironmentBrowser>>importExportMenu: (in category 'as yet unclassified') -----
+ importExportMenu: aMenu
+ 	aMenu addList: #(
+ 		('import all from self' importExportImportSelf)
+ 		('import all from environment' importExportImportAll)
+ 		('import all from environment, adding prefix' importExportImportAddingPrefix)
+ 		('import prefixed from environment, removing prefix' importExportImportRemovingPrefix)
+ 		('import specific names from environment' importExportImportSpecific)
+ 		-
+ 		('export all' importExportExportSelf)
+ 		('export all, adding prefix' importExportExportAddingPrefix)
+ 		('export prefixed, removing prefix' importExportExportRemovingPrefix)
+ 		('export specific names' importExportExportSpecific)
+ 		-
+ 		('remove policy' importExportRemove)
+ 		-
+ 		('explore policy' importExportExplore)
+ 		).
+ 	^ aMenu!

Item was added:
+ ----- Method: EnvironmentBrowser>>importExportRemove (in category 'as yet unclassified') -----
+ importExportRemove
+ 	self environment removePolicy: (self environment policies at: importExportIndex).
+ 	self changed: #importExportList!

Item was added:
+ ----- Method: EnvironmentBrowser>>requestEnvironment: (in category 'as yet unclassified') -----
+ requestEnvironment: aBlock
+ 	| nss |
+ 	nss := Environment wellKnownInstances gather: [:ns | ns allSubNamespaces].
+ 	(UIManager default
+ 		chooseFrom: (nss collect: [:ns | ns printString])
+ 		values: nss
+ 		lines: #()
+ 		title: 'Select an environment') ifNotNil: aBlock!

Item was added:
+ ----- Method: EnvironmentBrowser>>requestNamesFrom:title: (in category 'as yet unclassified') -----
+ requestNamesFrom: env title: title
+ 	| allNames |
+ 	allNames := env exports sort.
+ 	^ (UIManager default chooseMultipleFrom: allNames values: allNames title: title)!

Item was changed:
  ----- 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.
+ 	self changed: #importExportList.!
- 	self changed: #selectedPath.!

Item was added:
+ ----- Method: ExplicitNamePolicy>>description (in category '*Tools-Browsing') -----
+ description
+ 	^ String streamContents: [:s |
+ 		(aliases associations
+ 			collect: [:a | a key = a value ifTrue: [a key asString] ifFalse: [a printString]])
+ 			sort joinOn: s separatedBy: ', ']!

Item was added:
+ ----- Method: NamePolicy>>description (in category '*Tools-Browsing') -----
+ description
+ 	self subclassResponsibility!

Item was added:
+ ----- Method: RemovePrefixNamePolicy>>description (in category '*Tools-Browsing') -----
+ description
+ 	^ prefix, '* -> *'!

Item was added:
+ ----- Method: StandardToolSet class>>browseEnvironment: (in category 'browsing') -----
+ browseEnvironment: anEnvironment
+ 	
+ 	^ SystemBrowser default fullOnEnvironment: anEnvironment!



More information about the Squeak-dev mailing list