[squeak-dev] The Inbox: Tools-fbs.304.mcz

commits at source.squeak.org commits at source.squeak.org
Wed Mar 9 22:44:15 UTC 2011


A new version of Tools was added to project The Inbox:
http://source.squeak.org/inbox/Tools-fbs.304.mcz

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

Name: Tools-fbs.304
Author: fbs
Time: 5 March 2011, 8:58:45.982 pm
UUID: e88e5f59-1814-e642-96ee-7e29fe361941
Ancestors: Tools-fbs.303

#selectSystemCategory: reads better, even though it means the setter method name doesn't match the instvar name.

=============== Diff against Tools-fbs.303 ===============

Item was changed:
  ----- Method: Browser class>>newOnCategory: (in category 'instance creation') -----
  newOnCategory: aCategory
  	"Browse the system category of the given name.  7/13/96 sw"
  
  	"Browser newOnCategory: 'Interface-Browser'"
  
  	| newBrowser newCat |
  	newBrowser := self new..
  	newCat := aCategory asSymbol.
  	(newBrowser systemCategoryList includes: newCat)
+ 		ifTrue: [ newBrowser selectSystemCategory: newCat ]
- 		ifTrue: [ newBrowser selectedSystemCategory: newCat ]
  		ifFalse: [ ^ self inform: 'No such category' ].
  	
  	^ self 
  		openBrowserView: (newBrowser openSystemCatEditString: nil)
  		label: 'Classes in category ', aCategory
  !

Item was changed:
  ----- Method: Browser>>addSystemCategory (in category 'system category functions') -----
  addSystemCategory
  	"Prompt for a new category name and add it before the
  	current selection, or at the end if no current selection"
  	| oldSelection newName |
  	self okToChange ifFalse: [^ self].
  	oldSelection := self selectedSystemCategory.
  	newName := self
  		request: 'Please type new category name'
  		initialAnswer: 'Category-Name'.
  	newName isEmpty
  		ifTrue: [^ self]
  		ifFalse: [newName := newName asSymbol].
  	systemOrganizer
  		addCategory: newName
  		before: self selectedSystemCategory.
+ 	self selectSystemCategory:
- 	self selectedSystemCategory:
  		(oldSelection isNil
  			ifTrue: [ self systemCategoryList last ]
  			ifFalse: [ oldSelection ]).
  	self changed: #systemCategoryList.!

Item was changed:
  ----- Method: Browser>>alphabetizeSystemCategories (in category 'system category functions') -----
  alphabetizeSystemCategories
  
  	self okToChange ifFalse: [^ false].
  	systemOrganizer sortCategories.
+ 	self selectSystemCategory: nil.
- 	self selectedSystemCategory: nil.
  	self changed: #systemCategoryList.
  !

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."
  
  	| newBrowser |
  	messageCategoryListIndex ~= 0
  		ifTrue: 
  			[newBrowser := Browser new.
+ 			newBrowser selectSystemCategory: self selectedSystemCategory.
- 			newBrowser selectedSystemCategory: self selectedSystemCategory.
  			newBrowser classListIndex: (newBrowser classList indexOf: self selectedClassName).
  			newBrowser metaClassIndicated: metaClassIndicated.
  			newBrowser messageCategoryListIndex: messageCategoryListIndex.
  			newBrowser messageListIndex: messageListIndex.
  			self class openBrowserView: (newBrowser openMessageCatEditString: aString)
  				label: 'Message Category Browser (' , 
  						newBrowser selectedClassOrMetaClassName , ')']!

Item was changed:
  ----- Method: Browser>>buildSystemCategoryBrowserEditString: (in category 'system category functions') -----
  buildSystemCategoryBrowserEditString: aString 
  	"Create and schedule a new system category browser with initial textual 
  	contents set to aString."
  
  	| newBrowser |
  	self hasSystemCategorySelected
  		ifTrue: 
  			[newBrowser := self class new.
+ 			newBrowser selectSystemCategory: self selectedSystemCategory.
- 			newBrowser selectedSystemCategory: self selectedSystemCategory.
  			newBrowser setClass: self selectedClassOrMetaClass selector: self selectedMessageName.
  			self class openBrowserView: (newBrowser openSystemCatEditString: aString)
  				label: 'Classes in category ', newBrowser selectedSystemCategory]!

Item was changed:
  ----- Method: Browser>>editSystemCategories (in category 'system category functions') -----
  editSystemCategories
  	"Retrieve the description of the class categories of the system organizer."
  
  	self okToChange ifFalse: [^ self].
+ 	self selectSystemCategory: nil.
- 	self selectedSystemCategory: nil.
  	self editSelection: #editSystemCategories.
  	self changed: #editSystemCategories.
  	self contentsChanged!

Item was changed:
  ----- Method: Browser>>removeSystemCategory (in category 'system category functions') -----
  removeSystemCategory
  	"If a class category is selected, create a Confirmer so the user can 
  	verify that the currently selected class category and all of its classes
   	should be removed from the system. If so, remove it."
  
  	self hasSystemCategorySelected ifFalse: [^ self].
  	self okToChange ifFalse: [^ self].
  	(self classList size = 0
  		or: [self confirm: 'Are you sure you want to
  remove this system category 
  and all its classes?'])
  		ifTrue: 
  		[systemOrganizer removeSystemCategory: self selectedSystemCategory.
+ 		self selectSystemCategory: nil.
- 		self selectedSystemCategory: nil.
  		self changed: #systemCategoryList]!

Item was changed:
  ----- Method: Browser>>renameSystemCategory (in category 'system category functions') -----
  renameSystemCategory
  	"Prompt for a new category name and add it before the
  	current selection, or at the end if no current selection"
  	| oldSelection newName |
  	oldSelection := self selectedSystemCategory.
  	oldSelection isNil
  		ifTrue: [^ self].  "no selection"
  	self okToChange ifFalse: [^ self].
  	
  	newName := self
  		request: 'Please type new category name'
  		initialAnswer: oldSelection.
  	newName isEmpty
  		ifTrue: [^ self]
  		ifFalse: [newName := newName asSymbol].
  	oldSelection = newName ifTrue: [^ self].
  	systemOrganizer
  		renameCategory: oldSelection
  		toBe: newName.
+ 	self selectSystemCategory: oldSelection.
- 	self selectedSystemCategory: oldSelection.
  	self changed: #systemCategoryList.!

Item was changed:
  ----- Method: Browser>>restoreToCategory:className:protocol:selector:mode:meta: (in category 'multi-window support') -----
  restoreToCategory: category className: className protocol: protocol selector: selector mode: editMode meta: metaBool
+ 	self selectSystemCategory: category.
- 	self selectedSystemCategory: category.
  	self classListIndex: (self classListIndexOf: className).
  	self metaClassIndicated: metaBool.
  	self messageCategoryListIndex: (self messageCategoryList indexOf: protocol).
  	self messageListIndex: (self messageList indexOf: selector).
  	editSelection := editMode.
  	self
  		contentsChanged;
  		decorateButtons!

Item was changed:
  ----- Method: Browser>>selectCategoryForClass: (in category 'system category list') -----
  selectCategoryForClass: theClass
+ 	self selectSystemCategory: theClass category.!
- 	self selectedSystemCategory: theClass category.!

Item was added:
+ ----- Method: Browser>>selectSystemCategory: (in category 'system category list') -----
+ selectSystemCategory: aSymbol
+ 	"Set the selected system category. Update all other selections to be deselected."
+ 
+ 	selectedSystemCategory := aSymbol.
+ 	
+ 	classListIndex := 0.
+ 	messageCategoryListIndex := 0.
+ 	messageListIndex := 0.
+ 	self editSelection: ( aSymbol isNil ifTrue: [#none] ifFalse: [#newClass]).
+ 	metaClassIndicated := false.
+ 	self setClassOrganizer.
+ 	contents := nil.
+ 	self changed: #systemCategorySelectionChanged.
+ 	self changed: #systemCategoryListIndex.	"update my selection"
+ 	self changed: #classList.
+ 	self changed: #messageCategoryList.
+ 	self changed: #messageList.
+ 	self changed: #relabel.
+ 	self contentsChanged!

Item was changed:
  ----- Method: Browser>>selectedSystemCategory: (in category 'system category list') -----
  selectedSystemCategory: aSymbol
+ 	^ self selectSystemCategory: aSymbol.!
- 	"Set the selected system category. Update all other selections to be deselected."
- 
- 	selectedSystemCategory := aSymbol.
- 	
- 	classListIndex := 0.
- 	messageCategoryListIndex := 0.
- 	messageListIndex := 0.
- 	self editSelection: ( aSymbol isNil ifTrue: [#none] ifFalse: [#newClass]).
- 	metaClassIndicated := false.
- 	self setClassOrganizer.
- 	contents := nil.
- 	self changed: #systemCategorySelectionChanged.
- 	self changed: #systemCategoryListIndex.	"update my selection"
- 	self changed: #classList.
- 	self changed: #messageCategoryList.
- 	self changed: #messageList.
- 	self changed: #relabel.
- 	self contentsChanged!

Item was changed:
  ----- Method: Browser>>systemCategoryListIndex: (in category 'system category list') -----
  systemCategoryListIndex: anInteger 
  	"Set the selected system category index to be anInteger. Update all other 
  	selections to be deselected."
  	
+ 	self selectSystemCategory: (self systemCategoryList at: anInteger ifAbsent: [ nil ])!
- 	self selectedSystemCategory: (self systemCategoryList at: anInteger ifAbsent: [ nil ])!

Item was changed:
  ----- Method: FileContentsBrowser>>findClass (in category 'class list') -----
  findClass
  	| pattern foundClass classNames index foundPackage |
  	self okToChange ifFalse: [^ self classNotFound].
  	pattern := (UIManager default request: 'Class Name?') asLowercase.
  	pattern isEmpty ifTrue: [^ self].
  	classNames := Set new.
  	self packages do:[:p| classNames addAll: p classes keys].
  	classNames := classNames asArray select: 
  		[:n | (n asLowercase indexOfSubCollection: pattern startingAt: 1) > 0].
  	classNames isEmpty ifTrue: [^ self].
  	index := classNames size = 1
  				ifTrue:	[1]
  				ifFalse:	[(UIManager default chooseFrom: classNames lines: #())].
  	index = 0 ifTrue: [^ self].
  	foundPackage := nil.
  	foundClass := nil.
  	self packages do:[:p| 
  		(p classes includesKey: (classNames at: index)) ifTrue:[
  			foundClass := p classes at: (classNames at: index).
  			foundPackage := p]].
  	foundClass isNil ifTrue:[^self].
+  	self selectSystemCategory: foundPackage packageName asSymbol.
-  	self selectedSystemCategory: foundPackage packageName asSymbol.
  	self classListIndex: (self classList indexOf: foundClass name). !

Item was changed:
  ----- Method: FileContentsBrowser>>removePackage (in category 'removing') -----
  removePackage
  	self hasSystemCategorySelected ifTrue: [^ self].
  	self okToChange ifFalse: [^ self].
  	(self confirm: 'Are you sure you want to
  remove this package 
  and all its classes?') ifFalse:[^self].
  	(systemOrganizer listAtCategoryNamed: self selectedSystemCategory) do:[:el|
  		systemOrganizer removeElement: el].
  	self packages removeKey: self selectedPackage packageName.
  	systemOrganizer removeCategory: self selectedSystemCategory.
+ 	self selectSystemCategory: nil.
- 	self selectedSystemCategory: nil.
  	self changed: #systemCategoryList!

Item was changed:
  ----- Method: PackagePaneBrowser>>packageListIndex: (in category 'package list') -----
  packageListIndex: anInteger 
  	"Set anInteger to be the index of the current package selection."
  
  	packageListIndex := anInteger.
  	anInteger = 0
  		ifFalse: [package := self packageList at: packageListIndex].
  	messageCategoryListIndex := 0.
+ 	self selectSystemCategory: nil.
- 	self selectedSystemCategory: nil.
  	messageListIndex := 0.
  	classListIndex := 0.
  	self setClassOrganizer.
  	self changed: #packageSelectionChanged.
  	self changed: #packageListIndex.	"update my selection"
  	self changed: #systemCategoryList.	"update the category list"
  	self selectedSystemCategory: nil.	"update category list selection"
  !

Item was changed:
  ----- Method: PackagePaneBrowser>>selectCategoryForClass: (in category 'system category list') -----
  selectCategoryForClass: theClass
  	"Set the package and category lists to display the given class."
  
  	| cat catName |
  	cat := theClass category.
  	self packageListIndex: (self packageList indexOf: (cat copyUpTo: $-)).
  	catName := (cat copyFrom: ((cat indexOf: $- ifAbsent: [0]) + 1) to: cat size).
+ 	self selectSystemCategory: catName.!
- 	self selectedSystemCategory: catName.!

Item was changed:
  ----- Method: ParagraphEditor>>browseItHere (in category '*Tools') -----
  browseItHere
  	"Retarget the receiver's window to look at the selected class, if appropriate.  3/1/96 sw"
  	| aSymbol b |
  	(((b := model) isKindOf: Browser) and: [b couldBrowseAnyClass])
  		ifFalse: [^ view flash].
  	model okToChange ifFalse: [^ view flash].
  	self selectionInterval isEmpty ifTrue: [self selectWord].
  	(aSymbol := self selectedSymbol) ifNil: [^ view flash].
  
  	self terminateAndInitializeAround:
  		[| foundClass |
  		foundClass := (Smalltalk at: aSymbol ifAbsent: [nil]).
  			foundClass ifNil: [^ view flash].
  			(foundClass isKindOf: Class)
  				ifTrue:
+ 					[model selectSystemCategory: foundClass category.
- 					[model selectedSystemCategory: foundClass category.
  		model classListIndex: (model classList indexOf: foundClass name)]]!




More information about the Squeak-dev mailing list