The Inbox: Tools-tonyg.1034.mcz

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@0 corner: 0.15@0.3) -> [self buildEnvironmentTreeWith: builder].
+ (0@0.3 corner: 0.35@max) -> [self buildEnvironmentImportExportListWith: builder].
+ (0.15@0 corner: 0.35@0.3) -> [self buildSystemCategoryListWith: builder].
- (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>>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!