[Pkg] The Trunk: Tools-mt.667.mcz

[commits at source.squeak.org]

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!