The Trunk: Tools-mt.667.mcz

Marcel Taeumel uploaded a new version of Tools to project The Trunk:
http://source.squeak.org/trunk/Tools-mt.667.mcz

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

Name: Tools-mt.667
Author: mt
Time: 22 January 2016, 2:27:46.750541 pm
UUID: be24b1d6-4343-49a7-a3fa-ccafb5215cdb
Ancestors: Tools-kfr.666

Cleans up code regarding spawning system and hierarchy browsers.

Adds support for browser message categories via toolsets.

=============== Diff against Tools-kfr.666 ===============

Item was changed:
  ----- Method: Browser class>>fullOnClass: (in category 'instance creation') -----
  fullOnClass: aClass
  "Open a new full browser set to class."
+
+ ^ self
+ openBrowserView: (self new
+ setClass: aClass;
+ openEditString: nil)
+ label: nil!
- | brow |
- brow := self new.
- brow setClass: aClass selector: nil.
- ^ self
- openBrowserView: (brow openEditString: nil)
- label: 'System Browser'!

Item was added:
+ ----- Method: Browser class>>fullOnClass:category: (in category 'instance creation') -----
+ fullOnClass: aClass category: category
+
+ ^ self
+ openBrowserView: (self new
+ setClass: aClass;
+ selectMessageCategoryNamed: category;
+ openEditString: nil)
+ label: nil!

Item was changed:
  ----- Method: Browser class>>fullOnClass:selector: (in category 'instance creation') -----
  fullOnClass: aClass selector: aSelector
  "Open a new full browser set to class."
 
+ ^ self
+ openBrowserView: (self new
+ setClass: aClass selector: aSelector;
+ openEditString: nil)
+ label: nil!
- | brow classToUse |
- classToUse := SystemBrowser default.
- brow := classToUse new.
- brow setClass: aClass selector: aSelector.
- ^ classToUse
- openBrowserView: (brow openEditString: nil)
- label: brow labelString!

Item was changed:
  ----- Method: Browser class>>newOnClass:label: (in category 'instance creation') -----
  newOnClass: aClass label: aLabel
  "Open a new class browser on this class."
  | newBrowser |
 
  newBrowser := self new.
+ newBrowser setClass: aClass.
- newBrowser setClass: aClass selector: nil.
  ^ self
  openBrowserView: (newBrowser openOnClassWithEditString: nil)
  label: aLabel
  !

Item was added:
+ ----- Method: Browser class>>newOnMessageCategory:inClass: (in category 'instance creation') -----
+ newOnMessageCategory: aCategory inClass: aClass
+
+ ^ self
+ openBrowserView: (self new
+ setClass: aClass;
+ selectMessageCategoryNamed: aCategory;
+ openMessageCatEditString: nil)
+ label: 'Message Category Browser (' , aClass name, ')'.!

Item was changed:
  ----- Method: Browser class>>openBrowserView:label: (in category 'instance creation') -----
  openBrowserView: aBrowserView label: aString
  "Schedule aBrowserView, labelling the view aString."
+
+ (aBrowserView isKindOf: ToolBuilderSpec)
+ ifTrue:[
+ (self canUseMultiWindowBrowsers
+ and: [self useMultiWindowBrowsers])
+ ifTrue: [aBrowserView multiWindowStyle: #labelButton].
+ aString
+ ifNil: [ToolBuilder open: aBrowserView]
+ ifNotNil: [ToolBuilder open: aBrowserView label: aString]]
+ ifFalse:[
+ aBrowserView isMorph
+ ifTrue: [
+ aString ifNotNil: [aBrowserView setLabel: aString].
+ aBrowserView openInWorld]
+ ifFalse: [
+ aString ifNotNil: [aBrowserView label: aString].
+ aBrowserView minimumSize: 300 @ 200.
+ aBrowserView subViews do: [:each | each controller].
+ aBrowserView controller open]].
+
- (aBrowserView isKindOf: ToolBuilderSpec) ifTrue:[
- (self canUseMultiWindowBrowsers
- and: [self useMultiWindowBrowsers]) ifTrue:
- [aBrowserView multiWindowStyle: #labelButton].
- ToolBuilder open: aBrowserView label: aString.
- ] ifFalse:[
- aBrowserView isMorph
- ifTrue:  [(aBrowserView setLabel: aString) openInWorld]
- ifFalse: [aBrowserView label: aString.
- aBrowserView minimumSize: 300 @ 200.
- aBrowserView subViews do: [:each | each controller].
- aBrowserView controller open].
- ].
  ^ aBrowserView model
  !

Item was changed:
  ----- Method: Browser>>buildMessageCategoryBrowserEditString: (in category 'message category functions') -----
  buildMessageCategoryBrowserEditString: aString
  "Create and schedule a message category browser for the currently
  selected message category. The initial text view contains the characters
  in aString."
- "wod 6/24/1998: set newBrowser classListIndex so that it works whether the
- receiver is a standard or a Hierarchy Browser."
 
+ ^ self hasMessageCategorySelected ifTrue: [
+ (self class
+ newOnMessageCategory: self selectedMessageCategoryName
+ inClass: self selectedClassOrMetaClass)
+ "Select my message."
+ selectMessageNamed: self selectedMessageName;
+ yourself]!
- | newBrowser |
- ^ self hasMessageCategorySelected
- ifFalse: [ nil ]
- ifTrue:
- [newBrowser := Browser new.
- newBrowser selectSystemCategory: self selectedSystemCategory.
- newBrowser selectClass: self selectedClass.
- newBrowser metaClassIndicated: self metaClassIndicated.
- newBrowser selectMessageCategoryNamed: self selectedMessageCategoryName.
- newBrowser selectMessageNamed: self selectedMessageName.
- self class openBrowserView: (newBrowser openMessageCatEditString: aString)
- label: 'Message Category Browser (' ,
- newBrowser selectedClassOrMetaClassName , ')'.
- newBrowser.].!

Item was added:
+ ----- Method: Browser>>setClass: (in category 'initialize-release') -----
+ setClass: aBehavior
+ "Set the state of a new, uninitialized Browser."
+
+ | isMeta aClass |
+ aBehavior ifNil: [^ self].
+ (aBehavior isKindOf: Metaclass)
+ ifTrue: [
+ isMeta := true.
+ aClass := aBehavior soleInstance]
+ ifFalse: [
+ isMeta := false.
+ aClass := aBehavior].
+
+ self
+ selectEnvironment: aClass environment;
+ selectCategoryForClass: aClass;
+ classListIndex: (self classListIndexOf: aClass name);
+ metaClassIndicated: isMeta.!

Item was changed:
  ----- Method: Browser>>setClass:selector: (in category 'initialize-release') -----
  setClass: aBehavior selector: aSymbol
  "Set the state of a new, uninitialized Browser."
 
- | isMeta aClass |
  aBehavior ifNil: [^ self].
+
- (aBehavior isKindOf: Metaclass)
- ifTrue: [
- isMeta := true.
- aClass := aBehavior soleInstance]
- ifFalse: [
- isMeta := false.
- aClass := aBehavior].
-
  self
+ setClass: aBehavior;
- selectEnvironment: aClass environment;
- selectCategoryForClass: aClass;
- classListIndex: (self classListIndexOf: aClass name);
- metaClassIndicated: isMeta;
  setSelector: aSymbol.!

Item was changed:
  ----- Method: CodeHolder>>messageListKey:from: (in category 'message list menu') -----
  messageListKey: aChar from: view
  "Respond to a Command key.  I am a model with a code pane, and I also
  have a listView that has a list of methods.  The view knows how to get
  the list and selection."
  | sel class |
  aChar == $D ifTrue: [^ self toggleDiffing].
  sel := self selectedMessageName.
  aChar == $m ifTrue:  "These next two put up a type in if no message selected"
  [^ self useSelector: sel orGetSelectorAndSendQuery: #browseAllImplementorsOf: to: self ].
  aChar == $n ifTrue:
  [^ self useSelector: sel orGetSelectorAndSendQuery: #browseAllCallsOn: to: self ].
  aChar == $d ifTrue: [^ self removeMessageFromBrowser].
  "The following require a class selection"
  (class := self selectedClassOrMetaClass) ifNil: [^ self arrowKey: aChar from: view].
+ aChar == $b ifTrue: [^ ToolSet browse: class selector: sel].
- aChar == $b ifTrue: [^ Browser fullOnClass: class selector: sel].
  aChar == $N ifTrue: [^ self browseClassRefs].
  aChar == $i ifTrue: [^ self methodHierarchy].
  aChar == $h ifTrue: [^ self classHierarchy].
  aChar == $p ifTrue: [^ self browseFullProtocol].
  aChar == $r ifTrue: [^ self browseVariableReferences].
  aChar == $a ifTrue: [^ self browseVariableAssignments].
  "The following require a method selection"
  sel ifNotNil:
  [aChar == $o ifTrue: [^ self fileOutMessage].
  aChar == $c ifTrue: [^ self copySelector].
  aChar == $v ifTrue: [^ self browseVersions].
  aChar == $x ifTrue: [^ self removeMessage].
  aChar == $C ifTrue: [ self copyReference ].
  (aChar == $Y and: [self canShowMultipleMessageCategories])
  ifTrue: [^ self showHomeCategory]].
  ^ self arrowKey: aChar from: view!

Item was changed:
  ----- Method: CodeHolder>>spawnHierarchy (in category 'traits') -----
  spawnHierarchy
  "Create and schedule a new hierarchy browser on the currently selected class or meta."
 
+ ^ ToolSet
+ browseHierarchy: self selectedClassOrMetaClass
+ selector: self selectedMessageName!
- | newBrowser aSymbol selectedClassOrMetaClass |
- (selectedClassOrMetaClass := self selectedClassOrMetaClass)
- ifNil: [^ self].
- selectedClassOrMetaClass isTrait ifTrue: [^self].
- newBrowser := HierarchyBrowser new initHierarchyForClass: selectedClassOrMetaClass.
- ((aSymbol := self selectedMessageName) notNil and: [(MessageSet isPseudoSelector: aSymbol) not])
- ifTrue: [newBrowser setSelector: aSymbol].
- Browser
- openBrowserView: (newBrowser openSystemCatEditString: nil)
- label: newBrowser labelString.
- Smalltalk isMorphic
- ifTrue: ["this workaround only needed in morphic"
- newBrowser assureSelectionsShow].
- ^ newBrowser.!

Item was removed:
- ----- Method: HierarchyBrowser class>>newFor: (in category 'instance creation') -----
- newFor: aClass
- "Open a new HierarchyBrowser on the given class"
- |  newBrowser |
- newBrowser := HierarchyBrowser new initHierarchyForClass: aClass.
- Browser openBrowserView: (newBrowser openSystemCatEditString: nil)
- label: newBrowser labelString
-
- "HierarchyBrowser newFor: Boolean"!

Item was removed:
- ----- Method: HierarchyBrowser class>>newFor:labeled: (in category 'instance creation') -----
- newFor: aClass labeled: aLabel
- "Open a new HierarchyBrowser on the given class, using aLabel as the window title."
-
- |  newBrowser |
- newBrowser := HierarchyBrowser new initHierarchyForClass: aClass.
- Browser openBrowserView: (newBrowser openSystemCatEditString: nil)
- label: aLabel
-
- "HierarchyBrowser newFor: Boolean labeled: 'Testing'"!

Item was added:
+ ----- Method: HierarchyBrowser>>setClass: (in category 'initialization') -----
+ setClass: aClass
+
+ self initHierarchyForClass: aClass.
+ super setClass: aClass.!

Item was changed:
  ----- Method: ProcessBrowser>>browseContext (in category 'stack list') -----
  browseContext
  selectedContext
  ifNil: [^ self].
+ ToolSet browse: self selectedClass selector: self selectedSelector!
- Browser newOnClass: self selectedClass selector: self selectedSelector!

Item was changed:
  ----- Method: SelectorBrowser>>classListIndex: (in category 'class list') -----
  classListIndex: anInteger
 
  classListIndex := anInteger.
  classListIndex > 0 ifTrue:
  [self changed: #startNewBrowser. "MVC view will terminate control to prepare for new browser"
+ ToolSet browse: self selectedClass selector: self selectedMessageName.
- Browser fullOnClass: self selectedClass selector: self selectedMessageName.
  "classListIndex := 0"]
  !

Item was added:
+ ----- Method: StandardToolSet class>>browseClass:category: (in category 'browsing') -----
+ browseClass: aClass category: aCategory
+ "Open a browser for a class selecting a given message category."
+
+ ^ SystemBrowser default
+ fullOnClass: aClass
+ category: aCategory!

Item was changed:
  ----- Method: StandardToolSet class>>browseHierarchy:selector: (in category 'browsing') -----
  browseHierarchy: aClass selector: aSelector
  "Open a browser"
+
+ ^ HierarchyBrowser fullOnClass: aClass selector: aSelector.!
- | newBrowser |
- (aClass == nil)  ifTrue: [^ self].
- (newBrowser := SystemBrowser default new) setClass: aClass selector: aSelector.
- newBrowser spawnHierarchy.!

Item was added:
+ ----- Method: StandardToolSet class>>browseMessageCategory:inClass: (in category 'browsing') -----
+ browseMessageCategory: aCategory inClass: aClass
+ "Open a message category browser."
+
+ ^ SystemBrowser default
+ newOnMessageCategory: aCategory inClass: aClass.!

Item was changed:
  ----- Method: StringHolder>>messageListKey:from: (in category '*Tools') -----
  messageListKey: aChar from: view
  "Respond to a Command key.  I am a model with a code pane, and I also
  have a listView that has a list of methods.  The view knows how to get
  the list and selection."
 
  | sel class |
  aChar == $D ifTrue: [^ self toggleDiffing].
 
  sel := self selectedMessageName.
  aChar == $m ifTrue:  "These next two put up a type in if no message selected"
  [^ self useSelector: sel orGetSelectorAndSendQuery: #browseAllImplementorsOf: to: self systemNavigation].
  aChar == $n ifTrue:
  [^ self useSelector: sel orGetSelectorAndSendQuery: #browseAllCallsOn: to: self systemNavigation].
 
  "The following require a class selection"
  (class := self selectedClassOrMetaClass) ifNil: [^ self arrowKey: aChar from: view].
+ aChar == $b ifTrue: [^ ToolSet browse: class selector: sel].
- aChar == $b ifTrue: [^ Browser fullOnClass: class selector: sel].
  aChar == $N ifTrue: [^ self browseClassRefs].
  aChar == $i ifTrue: [^ self methodHierarchy].
  aChar == $h ifTrue: [^ self classHierarchy].
  aChar == $p ifTrue: [^ self browseFullProtocol].
 
  "The following require a method selection"
  sel ifNotNil:
  [aChar == $o ifTrue: [^ self fileOutMessage].
  aChar == $c ifTrue: [^ self copySelector].
  aChar == $C ifTrue: [^ self copyReference].
  aChar == $v ifTrue: [^ self browseVersions].
  aChar == $x ifTrue: [^ self removeMessage]].
 
  ^ self arrowKey: aChar from: view!