[squeak-dev] The Trunk: Tools-fbs.335.mcz

commits at source.squeak.org commits at source.squeak.org
Wed Apr 20 23:21:48 UTC 2011


Levente Uzonyi uploaded a new version of Tools to project The Trunk:
http://source.squeak.org/trunk/Tools-fbs.335.mcz

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

Name: Tools-fbs.335
Author: fbs
Time: 30 March 2011, 10:06:18.855 pm
UUID: 7cce9339-38c3-914a-be10-29f6b3091a3a
Ancestors: Tools-fbs.334

No more references to messageCategoryListIndex!

=============== Diff against Tools-fbs.334 ===============

Item was changed:
  ----- Method: Browser>>addCategory (in category 'message category functions') -----
  addCategory
  	"Present a choice of categories or prompt for a new category name and add it before the current selection, or at the end if no current selection"
+ 	| labels reject lines menuIndex newName oldCategory |
- 	| labels reject lines menuIndex oldIndex newName oldCategory |
  	self okToChange ifFalse: [^ self].
  	self hasClassSelected ifFalse: [^ self].
  	labels := OrderedCollection with: 'new...'.
  	reject := Set new.
  	reject
  		addAll: self selectedClassOrMetaClass organization categories;
  		add: ClassOrganizer nullCategory;
  		add: ClassOrganizer default.
  	lines := OrderedCollection new.
  	self selectedClassOrMetaClass allSuperclasses do: [:cls | | cats |
  		cls = Object ifFalse: [
  			cats := cls organization categories reject:
  				 [:cat | reject includes: cat].
  			cats isEmpty ifFalse: [
  				lines add: labels size.
  				labels addAll: cats asSortedCollection.
  				reject addAll: cats]]].
  	newName := (labels size = 1 or: [
  		menuIndex := (UIManager default chooseFrom: labels lines: lines title: 'Add Category').
  		menuIndex = 0 ifTrue: [^ self].
  		menuIndex = 1])
  			ifTrue: [
  				self request: 'Please type new category name'
  					initialAnswer: 'category name']
  			ifFalse: [
  				labels at: menuIndex].
- 	oldIndex := messageCategoryListIndex.
  	oldCategory := self selectedMessageCategoryName.
  	newName isEmpty
  		ifTrue: [^ self]
  		ifFalse: [newName := newName asSymbol].
  	self classOrMetaClassOrganizer
  		addCategory: newName
+ 		before: (self hasMessageCategorySelected
+ 				ifFalse: [nil]
+ 				ifTrue: [self selectedMessageCategoryName]).
- 		before: (messageCategoryListIndex = 0
- 				ifTrue: [nil]
- 				ifFalse: [self selectedMessageCategoryName]).
  	self changed: #messageCategoryList.
+ 	self selectMessageCategoryNamed:
+ 		(oldCategory isNil
+ 			ifTrue: [self classOrMetaClassOrganizer categories last]
+ 			ifFalse: [oldCategory]).
- 	self messageCategoryListIndex:
- 		(oldIndex = 0
- 			ifTrue: [self classOrMetaClassOrganizer categories size + 1]
- 			ifFalse: [oldIndex]).
- "	self selectMessageCategoryNamed: (oldCategory ifNil: [self messageCategoryList last] ifNotNil: [oldCategory])."
  	self changed: #messageCategoryList.
  !

Item was changed:
  ----- Method: Browser>>compileMessage:notifying: (in category 'code pane') -----
  compileMessage: aText notifying: aController
  	"Compile the code that was accepted by the user, placing the compiled method into an appropriate message category.  Return true if the compilation succeeded, else false."
  
+ 	| fallBackCategoryName originalSelectorName result fallBackMethodName |
- 	| fallBackCategoryIndex originalSelectorName result fallBackMethodName |
  
  	self selectedMessageCategoryName ifNil:
  			[ self selectOriginalCategoryForCurrentMethod 	
  										ifFalse:["Select the '--all--' category"
  											self messageCategoryListIndex: 1]]. 
  
  
  	self selectedMessageCategoryName asSymbol = ClassOrganizer allCategory
  		ifTrue:
  			[ "User tried to save a method while the ALL category was selected"
+ 			fallBackCategoryName := selectedMessageCategoryName.
- 			fallBackCategoryIndex := messageCategoryListIndex.
  			fallBackMethodName := selectedMessageName.
  			editSelection == #newMessage
  				ifTrue:
  					[ "Select the 'as yet unclassified' category"
+ 					selectedMessageCategoryName := nil.
- 					messageCategoryListIndex := 0.
  					(result := self defineMessageFrom: aText notifying: aController)
  						ifNil:
  							["Compilation failure:  reselect the original category & method"
+ 							selectedMessageCategoryName := fallBackCategoryName.
- 							messageCategoryListIndex := fallBackCategoryIndex.
  							selectedMessageName := fallBackMethodName]
  						ifNotNil:
  							[self setSelector: result]]
  				ifFalse:
  					[originalSelectorName := self selectedMessageName.
  					self setOriginalCategoryIndexForCurrentMethod.
  					selectedMessageName := fallBackMethodName := originalSelectorName.			
  					(result := self defineMessageFrom: aText notifying: aController)
  						ifNotNil:
  							[self setSelector: result]
  						ifNil:
  							[ "Compilation failure:  reselect the original category & method"
+ 							selectedMessageCategoryName := fallBackCategoryName.
- 							messageCategoryListIndex := fallBackCategoryIndex.
  							selectedMessageName := fallBackMethodName.
  							^ result notNil]].
  			self changed: #messageCategoryList.
  			^ result notNil]
  		ifFalse:
  			[ "User tried to save a method while the ALL category was NOT selected"
  			^ (self defineMessageFrom: aText notifying: aController) notNil]!

Item was changed:
  ----- Method: Browser>>messageCategoryListIndex: (in category 'message category list') -----
  messageCategoryListIndex: anInteger
  	"Set the selected message category to be the one indexed by anInteger."
  
- 	messageCategoryListIndex := anInteger.
  	selectedMessageCategoryName := nil.
  	self selectMessageCategoryNamed: (self messageCategoryList at: anInteger ifAbsent: [nil]).!

Item was changed:
  ----- Method: Browser>>messageList (in category 'message list') -----
  messageList
  	"Answer an Array of the message selectors of the currently selected message category, provided that the messageCategoryListIndex is in proper range.  Otherwise, answer an empty Array  If messageCategoryListIndex is found to be larger than the number of categories (it happens!!), it is reset to zero."
  	| sel |
  	(sel := self messageCategoryListSelection) ifNil: 
  		[
  			^ self classOrMetaClassOrganizer
  				ifNil:		[Array new]
  				ifNotNil:	[self classOrMetaClassOrganizer allMethodSelectors]
  			"^ Array new"
  		].
  
  	^ sel = ClassOrganizer allCategory
  		ifTrue: 
  			[self classOrMetaClassOrganizer
  				ifNil:		[Array new]
  				ifNotNil:	[self classOrMetaClassOrganizer allMethodSelectors]]
  		ifFalse:
  			[(self classOrMetaClassOrganizer listAtCategoryNamed: self selectedMessageCategoryName )
+ 				ifNil: [selectedMessageCategoryName := nil. Array new]]!
- 				ifNil: [messageCategoryListIndex := 0.  selectedMessageCategoryName := nil. Array new]]!

Item was changed:
  ----- Method: Browser>>metaClassIndicated: (in category 'metaclass') -----
  metaClassIndicated: trueOrFalse 
  	"Indicate whether browsing instance or class messages."
  
  	metaClassIndicated := trueOrFalse.
  	self setClassOrganizer.
  	self hasSystemCategorySelected ifTrue:
  		[self editSelection: (self hasClassSelected
  			ifFalse: [metaClassIndicated
  				ifTrue: [#none]
  				ifFalse: [#newClass]]
  			ifTrue: [#editClass])].
- 	messageCategoryListIndex := 0.
  	selectedMessageCategoryName := nil.
  	selectedMessageName := nil.
  	contents := nil.
  	self changed: #classSelectionChanged.
  	self changed: #messageCategoryList.
  	self changed: #messageList.
  	self changed: #contents.
  	self changed: #annotation.
  	self decorateButtons
  !

Item was changed:
  ----- Method: Browser>>rawMessageCategoryList (in category 'message category list') -----
  rawMessageCategoryList
  	^ self hasClassSelected
  		ifTrue: [self classOrMetaClassOrganizer categories]
  		ifFalse: [Array new]!

Item was changed:
  ----- Method: Browser>>selectClassNamed: (in category 'class list') -----
  selectClassNamed: aSymbolOrString
  	| className currentMessageCategoryName currentMessageName |
  	currentMessageCategoryName := [self selectedMessageCategoryName]
  										on: Error
  										do: [:ex| ex return: nil].
  	currentMessageName := [self selectedMessageName]
  								on: Error
  								do: [:ex| ex return: nil].
  								
  	selectedClassName := aSymbolOrString ifNotNil: [ aSymbolOrString asSymbol ].
  	self setClassOrganizer.
  
  	"Try to reselect the category and/or selector if the new class has them."
- 	messageCategoryListIndex := self messageCategoryList
- 										indexOf: currentMessageCategoryName
- 										ifAbsent: [0].
  	selectedMessageCategoryName :=(self messageCategoryList includes: currentMessageCategoryName)
  		ifTrue: [currentMessageCategoryName]
  		ifFalse: [nil].
  	self selectMessageNamed: (self hasMessageCategorySelected
  		ifTrue: [ currentMessageName ]
  		ifFalse: [ nil ]).
  
  	self hasMessageSelected ifTrue:
  		[self editSelection: #editMessage] ifFalse:
  	[self hasMessageCategorySelected ifTrue:
  		[self editSelection: #newMessage] ifFalse:
  	[self classCommentIndicated
  		ifTrue: []
  		ifFalse: [self editSelection: (self hasClassSelected not
  					ifTrue: [(metaClassIndicated or: [ self hasSystemCategorySelected not ])
  						ifTrue: [#none]
  						ifFalse: [#newClass]]
  					ifFalse: [#editClass])]]].
  	contents := nil.
  	self selectedClass isNil
  		ifFalse: [className := self selectedClass name.
  					(RecentClasses includes: className)
  				ifTrue: [RecentClasses remove: className].
  			RecentClasses addFirst: className.
  			RecentClasses size > 16
  				ifTrue: [RecentClasses removeLast]].
  	self changed: #classSelectionChanged.
  	self changed: #classCommentText.
  	self changed: #classListIndex.	"update my selection"
  	self changed: #messageCategoryList.
  	self changed: #messageList.
  	self changed: #relabel.
  	self contentsChanged!

Item was changed:
  ----- Method: Browser>>selectMessageCategoryNamed: (in category 'message category list') -----
  selectMessageCategoryNamed: aSymbol 
  	"Given aSymbol, select the category with that name.  Do nothing if 
  	aSymbol doesn't exist."
  	selectedMessageCategoryName := aSymbol.
- 	messageCategoryListIndex := aSymbol ifNil: [0] ifNotNil: [self messageCategoryList indexOf: aSymbol].
  	
  	selectedMessageName := nil.
  	self changed: #messageCategorySelectionChanged.
  	self changed: #messageCategoryListIndex. "update my selection"
  	self changed: #messageList.
  	self editSelection: (aSymbol notNil
  		ifTrue: [#newMessage]
  		ifFalse: [self hasClassSelected
  			ifTrue: [#editClass]
  			ifFalse: [#newClass]]).
  	contents := nil.
  	self contentsChanged.!

Item was changed:
  ----- Method: Browser>>selectOriginalCategoryForCurrentMethod (in category 'message category list') -----
  selectOriginalCategoryForCurrentMethod
  	"private - Select the message category for the current method. 
  	 
  	 Note:  This should only be called when somebody tries to save  
  	 a method that they are modifying while ALL is selected. 
  	 
  	 Returns: true on success, false on failure."
  	| aSymbol selectorName |
  	aSymbol := self categoryOfCurrentMethod.
  	selectorName := self selectedMessageName.
  	(aSymbol notNil and: [aSymbol ~= ClassOrganizer allCategory])
  		ifTrue: 
+ 			[selectedMessageCategoryName := aSymbol.
- 			[messageCategoryListIndex := (self messageCategoryList indexOf: aSymbol).
- 			selectedMessageCategoryName := aSymbol.
  			selectedMessageName := selectorName.
  			self changed: #messageCategorySelectionChanged.
  			self changed: #messageCategoryListIndex.	"update my selection"
  			self changed: #messageList.
  			self changed: #messageListIndex.
  			^ true].
  	^ false!

Item was changed:
  ----- Method: Browser>>selectSystemCategory: (in category 'system category list') -----
  selectSystemCategory: aSymbol
  	"Set the selected system category. Update all other selections to be deselected."
  
  	selectedSystemCategory := aSymbol.
  	selectedClassName := nil.
- 	messageCategoryListIndex := 0.
  	selectedMessageCategoryName := nil.
  	selectedMessageName := nil.
  	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>>selectedMessageCategoryName (in category 'message category list') -----
  selectedMessageCategoryName
  	"Answer the name of the selected message category, if any. Answer nil 
  	otherwise."
  
+ 	^ selectedMessageCategoryName!
- 	messageCategoryListIndex = 0 ifTrue: [^nil].
- 	^self messageCategoryList at: messageCategoryListIndex!

Item was changed:
  ----- Method: Browser>>setOriginalCategoryIndexForCurrentMethod (in category 'message category list') -----
  setOriginalCategoryIndexForCurrentMethod
  	"private - Set the message category index for the currently selected method. 
  	 
  	 Note:  This should only be called when somebody tries to save  
  	 a method that they are modifying while ALL is selected."
  
- 	messageCategoryListIndex := self messageCategoryList indexOf: self categoryOfCurrentMethod.
  	selectedMessageCategoryName := self categoryOfCurrentMethod.!

Item was changed:
  ----- Method: Browser>>systemOrganizer: (in category 'initialize-release') -----
  systemOrganizer: aSystemOrganizer
  	"Initialize the receiver as a perspective on the system organizer, 
  	aSystemOrganizer. Typically there is only one--the system variable 
  	SystemOrganization."
  	
  	contents := nil.
  	systemOrganizer := aSystemOrganizer.
  	selectedSystemCategory := nil.
  	selectedMessageCategoryName := nil.
  	selectedClassName := nil.
- 	messageCategoryListIndex := 0.
  	selectedMessageName := nil.
  	metaClassIndicated := false.
  	self setClassOrganizer.
  	self editSelection: #none.!

Item was changed:
  ----- Method: Browser>>veryDeepInner: (in category 'copying') -----
  veryDeepInner: deepCopier
  	"Copy all of my instance variables.  Some need to be not copied at all, but shared.  See DeepCopier class comment."
  
  super veryDeepInner: deepCopier.
  "systemOrganizer := systemOrganizer. 	clone has the old value. we share it"
  "classOrganizer := classOrganizer		clone has the old value. we share it"
  "metaClassOrganizer 	:= metaClassOrganizer	clone has the old value. we share it"
  selectedSystemCategory := selectedSystemCategory veryDeepCopyWith: deepCopier.
  selectedClassName := selectedClassName veryDeepCopyWith: deepCopier.
- messageCategoryListIndex := messageCategoryListIndex veryDeepCopyWith: deepCopier.
  selectedMessageCategoryName := selectedMessageCategoryName veryDeepCopyWith: deepCopier.
  selectedMessageName := selectedMessageName veryDeepCopyWith: deepCopier.
  editSelection := editSelection veryDeepCopyWith: deepCopier.
  metaClassIndicated := metaClassIndicated veryDeepCopyWith: deepCopier.
  !

Item was changed:
  ----- Method: MessageSet>>compileMessage:notifying: (in category 'as yet unclassified') -----
  compileMessage: aText notifying: aController
  	"Compile the code that was accepted by the user, placing the compiled method into an appropriate message category.  Return true if the compilation succeeded, else false."
  	"Copied from Browser's version of sd 11/20/2005 21:26 because later versions remove messageListIndex."
  
+ 	| fallBackCategoryName fallBackMethodIndex originalSelectorName result |
- 	| fallBackCategoryName fallBackCategoryIndex fallBackMethodIndex originalSelectorName result |
  
  	self selectedMessageCategoryName ifNil:
  			[ self selectOriginalCategoryForCurrentMethod 	
  										ifFalse:["Select the '--all--' category"
  											self messageCategoryListIndex: 1]]. 
  
  
  	self selectedMessageCategoryName asSymbol = ClassOrganizer allCategory
  		ifTrue:
  			[ "User tried to save a method while the ALL category was selected"
- 			fallBackCategoryIndex := messageCategoryListIndex.
  			fallBackCategoryName := selectedMessageCategoryName.
  			fallBackMethodIndex := messageListIndex.
  			editSelection == #newMessage
  				ifTrue:
  					[ "Select the 'as yet unclassified' category"
- 					messageCategoryListIndex := 0.
  					selectedMessageCategoryName := nil.
  					(result := self defineMessageFrom: aText notifying: aController)
  						ifNil:
  							["Compilation failure:  reselect the original category & method"
- 							messageCategoryListIndex := fallBackCategoryIndex.
  							selectedMessageCategoryName := fallBackCategoryName.
  							messageListIndex := fallBackMethodIndex]
  						ifNotNil:
  							[self setSelector: result]]
  				ifFalse:
  					[originalSelectorName := self selectedMessageName.
  					self setOriginalCategoryIndexForCurrentMethod.
  					messageListIndex := fallBackMethodIndex := self messageList indexOf: originalSelectorName.			
  					(result := self defineMessageFrom: aText notifying: aController)
  						ifNotNil:
  							[self setSelector: result]
  						ifNil:
  							[ "Compilation failure:  reselect the original category & method"
- 							messageCategoryListIndex := fallBackCategoryIndex.
  							selectedMessageCategoryName := fallBackCategoryName.
  							messageListIndex := fallBackMethodIndex.
  							^ result notNil]].
  			self changed: #messageCategoryList.
  			^ result notNil]
  		ifFalse:
  			[ "User tried to save a method while the ALL category was NOT selected"
  			^ (self defineMessageFrom: aText notifying: aController) notNil]!

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.
  	selectedMessageCategoryName := nil.
  	self selectSystemCategory: nil.
  	selectedMessageName := nil.
  	selectedClassName := nil.
  	self setClassOrganizer.
  	self changed: #packageSelectionChanged.
  	self changed: #packageListIndex.	"update my selection"
  	self changed: #systemCategoryList.	"update the category list"
  	self selectSystemCategory: nil.	"update category list selection"
  !




More information about the Squeak-dev mailing list