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

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


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

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

Name: Tools-fbs.302
Author: fbs
Time: 4 March 2011, 9:10:08.31 pm
UUID: 99464465-0012-bd46-8dcd-515f8382c4fe
Ancestors: Tools-fbs.301

A start on dyking out classListIndex and messageCategoryListIndex.

=============== Diff against Tools-fbs.301 ===============

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 oldIndex newName |
  	self okToChange ifFalse: [^ self].
+ 	self hasClassSelected ifFalse: [^ self].
- 	classListIndex = 0 ifTrue: [^ 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.
  	newName isEmpty
  		ifTrue: [^ self]
  		ifFalse: [newName := newName asSymbol].
  	self classOrMetaClassOrganizer
  		addCategory: newName
  		before: (messageCategoryListIndex = 0
  				ifTrue: [nil]
  				ifFalse: [self selectedMessageCategoryName]).
  	self changed: #messageCategoryList.
  	self messageCategoryListIndex:
  		(oldIndex = 0
  			ifTrue: [self classOrMetaClassOrganizer categories size + 1]
  			ifFalse: [oldIndex]).
  	self changed: #messageCategoryList.
  !

Item was changed:
  ----- Method: Browser>>alphabetizeMessageCategories (in category 'message category functions') -----
  alphabetizeMessageCategories
+ 	self hasClassSelected ifFalse: [^ false].
- 	classListIndex = 0 ifTrue: [^ false].
  	self okToChange ifFalse: [^ false].
  	self classOrMetaClassOrganizer sortCategories.
  	self clearUserEditFlag.
  	self editClass.
  	self classListIndex: classListIndex.
  	^ true!

Item was changed:
  ----- Method: Browser>>copyClass (in category 'class functions') -----
  copyClass
  	| originalClass originalName copysName |
+ 	self hasClassSelected ifFalse: [^ self].
- 	classListIndex = 0 ifTrue: [^ self].
  	self okToChange ifFalse: [^ self].
  	originalClass := self selectedClass.
  	originalName := originalClass name.
  	copysName := self request: 'Please type new class name' initialAnswer: originalName.
  	copysName = '' ifTrue: [^ self].  " Cancel returns '' "
  	copysName := copysName asSymbol.
  	copysName = originalName ifTrue: [^ self].
  	(Smalltalk hasClassNamed: copysName)
  		ifTrue: [^ self error: copysName , ' already exists'].
  	Cursor wait showWhile: [
  		| newDefinition newMetaDefinition newClass |
  		newDefinition := originalClass definition
  			copyReplaceAll: originalName printString
  			with: copysName printString.
  		newClass := Compiler evaluate: newDefinition logged: true.
  		newMetaDefinition := originalClass class definition
  			copyReplaceAll: originalClass class name
  			with: newClass class name.
  		Compiler evaluate: newMetaDefinition logged: true.
  		newClass copyAllCategoriesFrom: originalClass.
  		newClass class copyAllCategoriesFrom: originalClass class.
  		originalClass hasComment ifTrue: [
  			newClass comment: originalClass comment ] ].
  	self classListIndex: 0.
  	self changed: #classList!

Item was changed:
  ----- Method: Browser>>editClass (in category 'class functions') -----
  editClass
  	"Retrieve the description of the class definition."
  
+ 	self hasClassSelected ifFalse: [^ self].
- 	classListIndex = 0 ifTrue: [^ self].
  	self okToChange ifFalse: [^ self].
  	self messageCategoryListIndex: 0.
  	self editSelection: #editClass.
  	self changed: #contents.
  	self changed: #classCommentText.
  !

Item was changed:
  ----- Method: Browser>>editComment (in category 'class functions') -----
  editComment
  	"Retrieve the description of the class comment."
  
+ 	self hasClassSelected ifFalse: [^ self].
- 	classListIndex = 0 ifTrue: [^ self].
  	self okToChange ifFalse: [^ self].
  	self messageCategoryListIndex: 0.
  	metaClassIndicated := false.
  	self editSelection: #editComment.
  	self changed: #classSelectionChanged.
  	self changed: #messageCategoryList.
  	self changed: #messageList.
  	self decorateButtons.
  	self contentsChanged
  !

Item was changed:
  ----- Method: Browser>>editMessageCategories (in category 'message category functions') -----
  editMessageCategories
  	"Indicate to the receiver and its dependents that the message categories of 
  	the selected class have been changed."
  
  	self okToChange ifFalse: [^ self].
+ 	self hasClassSelected
- 	classListIndex ~= 0
  		ifTrue: 
  			[self messageCategoryListIndex: 0.
  			self editSelection: #editMessageCategories.
  			self changed: #editMessageCategories.
  			self contentsChanged]!

Item was changed:
  ----- Method: Browser>>fileOutClass (in category 'class functions') -----
  fileOutClass
  	"Print a description of the selected class onto a file whose name is the 
  	category name followed by .st."
  
  Cursor write showWhile:
+ 		[self hasClassSelected ifTrue: [self selectedClass fileOut]]!
- 		[classListIndex ~= 0 ifTrue: [self selectedClass fileOut]]!

Item was added:
+ ----- Method: Browser>>hasClassSelected (in category 'class list') -----
+ hasClassSelected
+ 	^ classListIndex ~= 0.!

Item was added:
+ ----- Method: Browser>>hasMessageCategorySelected (in category 'message category list') -----
+ hasMessageCategorySelected
+ 	^ self selectedMessageCategoryName notNil.!

Item was changed:
  ----- Method: Browser>>hierarchy (in category 'class functions') -----
  hierarchy
  	"Display the inheritance hierarchy of the receiver's selected class."
  
+ 	self hasClassSelected ifFalse: [^ self].
- 	classListIndex = 0 ifTrue: [^ self].
  	self okToChange ifFalse: [^ self].
  	self messageCategoryListIndex: 0.
  	self editSelection: #hierarchy.
  	self changed: #editComment.
  	self contentsChanged.
  	^ self!

Item was changed:
  ----- Method: Browser>>messageCategoryList (in category 'message category list') -----
  messageCategoryList
  	"Answer the selected category of messages."
  
+ 	self hasClassSelected
+ 		ifTrue: [^ (Array with: ClassOrganizer allCategory), self classOrMetaClassOrganizer categories]
+ 		ifFalse: [^ Array new]!
- 	classListIndex = 0
- 		ifTrue: [^ Array new]
- 		ifFalse: [^ (Array with: ClassOrganizer allCategory), self classOrMetaClassOrganizer categories]!

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
- 		[self editSelection: (classListIndex = 0
- 			ifTrue: [metaClassIndicated
  				ifTrue: [#none]
  				ifFalse: [#newClass]]
+ 			ifTrue: [#editClass])].
- 			ifFalse: [#editClass])].
  	messageCategoryListIndex := 0.
  	messageListIndex := 0.
  	contents := nil.
  	self changed: #classSelectionChanged.
  	self changed: #messageCategoryList.
  	self changed: #messageList.
  	self changed: #contents.
  	self changed: #annotation.
  	self decorateButtons
  !

Item was changed:
  ----- Method: Browser>>noteSelectionIndex:for: (in category 'accessing') -----
  noteSelectionIndex: anInteger for: aSymbol
  	aSymbol == #systemCategoryList
  		ifTrue:
  			[self systemCategoryListIndex: anInteger].
  	aSymbol == #classList
  		ifTrue:
+ 			[self classListIndex: anInteger].
- 			[classListIndex := anInteger].
  	aSymbol == #messageCategoryList
  		ifTrue:
+ 			[self messageCategoryListIndex: anInteger].
- 			[messageCategoryListIndex := anInteger].
  	aSymbol == #messageList
  		ifTrue:
+ 			[self messageListIndex: anInteger].!
- 			[messageListIndex := anInteger].!

Item was changed:
  ----- Method: Browser>>plusButtonHit (in category 'class functions') -----
  plusButtonHit
  	"Cycle among definition, comment, and hierachy"
  
  	editSelection == #editComment
  		ifTrue: [self hierarchy. ^ self].
  	editSelection == #hierarchy
  		ifTrue: [self editSelection: #editClass.
+ 			self hasClassSelected ifFalse: [^ self].
- 			classListIndex = 0 ifTrue: [^ self].
  			self okToChange ifFalse: [^ self].
  			self changed: #editComment.
  			self contentsChanged.
  			^ self].
  	self editComment!

Item was changed:
  ----- Method: Browser>>printOutClass (in category 'class functions') -----
  printOutClass
  	"Print a description of the selected class onto a file whose name is the 
  	category name followed by .html."
  
  Cursor write showWhile:
+ 		[self hasClassSelected ifTrue: [self selectedClass fileOutAsHtml: true]]!
- 		[classListIndex ~= 0 ifTrue: [self selectedClass fileOutAsHtml: true]]!

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

Item was changed:
  ----- Method: Browser>>renameCategory (in category 'message category functions') -----
  renameCategory
  	"Prompt for a new category name and add it before the
  	current selection, or at the end if no current selection"
  	| oldIndex oldName newName |
+ 	self hasClassSelected ifFalse: [^ self].
- 	classListIndex = 0 ifTrue: [^ self].
  	self okToChange ifFalse: [^ self].
  	(oldIndex := messageCategoryListIndex) = 0 ifTrue: [^ self].
  	oldName := self selectedMessageCategoryName.
  	newName := self
  		request: 'Please type new category name'
  		initialAnswer: oldName.
  	newName isEmpty
  		ifTrue: [^ self]
  		ifFalse: [newName := newName asSymbol].
  	newName = oldName ifTrue: [^ self].
  	self classOrMetaClassOrganizer
  		renameCategory: oldName
  		toBe: newName.
  	self classListIndex: classListIndex.
  	self messageCategoryListIndex: oldIndex.
  	self changed: #messageCategoryList.
  !

Item was changed:
  ----- Method: Browser>>renameClass (in category 'class functions') -----
  renameClass
  	| oldName newName obs |
+ 	self hasClassSelected ifFalse: [^ self].
- 	classListIndex = 0
- 		ifTrue: [^ self].
  	self okToChange
  		ifFalse: [^ self].
  	oldName := self selectedClass name.
  	newName := self request: 'Please type new class name' initialAnswer: oldName.
  	newName = ''
  		ifTrue: [^ self].
  	"Cancel returns ''"
  	newName := newName asSymbol.
  	newName = oldName
  		ifTrue: [^ self].
  	(self selectedClass environment includesKey: newName)
  		ifTrue: [^ self error: newName , ' already exists'].
  	self selectedClass rename: newName.
  	self changed: #classList.
  	self classListIndex: (self classListIndexOf: newName).
  	obs := self systemNavigation
  				allCallsOn: (self selectedClass environment associationAt: newName).
  	obs isEmpty
  		ifFalse: [self systemNavigation
  				browseMessageList: obs
  				name: 'Obsolete References to ' , oldName
  				autoSelect: oldName]!

Item was changed:
  ----- Method: Browser>>setClassOrganizer (in category 'metaclass') -----
  setClassOrganizer
  	"Install whatever organization is appropriate"
  	| theClass |
  	classOrganizer := nil.
  	metaClassOrganizer := nil.
+ 	self hasClassSelected ifFalse: [^ self].
- 	classListIndex = 0 ifTrue: [^ self].
  	theClass := self selectedClass ifNil: [ ^self ].
  	classOrganizer := theClass organization.
  	metaClassOrganizer := theClass classSide organization.!

Item was removed:
- ----- Method: Browser>>toggleClassListIndex: (in category 'class list') -----
- toggleClassListIndex: anInteger 
- 	"If anInteger is the current class index, deselect it. Else make it the 
- 	current class selection."
- 
- 	self classListIndex: 
- 		(classListIndex = anInteger
- 			ifTrue: [0]
- 			ifFalse: [anInteger])!

Item was removed:
- ----- Method: Browser>>toggleMessageCategoryListIndex: (in category 'message category list') -----
- toggleMessageCategoryListIndex: anInteger 
- 	"If the currently selected message category index is anInteger, deselect 
- 	the category. Otherwise select the category whose index is anInteger."
- 
- 	self messageCategoryListIndex: 
- 		(messageCategoryListIndex = anInteger
- 			ifTrue: [0]
- 			ifFalse: [anInteger])!

Item was removed:
- ----- Method: Browser>>toggleMessageListIndex: (in category 'message list') -----
- toggleMessageListIndex: anInteger 
- 	"If the currently selected message index is anInteger, deselect the message 
- 	selector. Otherwise select the message selector whose index is anInteger."
- 
- 	self messageListIndex: 
- 		(messageListIndex = anInteger
- 			ifTrue: [0]
- 			ifFalse: [anInteger])!

Item was changed:
  ----- Method: FileContentsBrowser>>removeClass (in category 'removing') -----
  removeClass
  	| class |
+ 	self hasClassSelected ifFalse: [^ self].
- 	classListIndex = 0 ifTrue: [^ self].
  	class := self selectedClass.
  	(self confirm:'Are you certain that you
  want to delete the class ', class name, '?') ifFalse:[^self].
  	self selectedPackage removeClass: class.
  	self classListIndex: 0.
  	self changed: #classList.!

Item was changed:
  ----- Method: FileContentsBrowser>>renameClass (in category 'class list') -----
  renameClass
  	| oldName newName |
+ 	self hasClassSelected ifFalse: [^ self].
- 	classListIndex = 0 ifTrue: [^ self].
  	self okToChange ifFalse: [^ self].
  	oldName := self selectedClass name.
  	newName := (self request: 'Please type new class name'
  						initialAnswer: oldName) asSymbol.
  	(newName isEmpty or:[newName = oldName]) ifTrue: [^ self].
  	(self selectedPackage classes includesKey: newName)
  		ifTrue: [^ self error: newName , ' already exists in the package'].
  	systemOrganizer classify: newName under: self selectedSystemCategory.
  	systemOrganizer removeElement: oldName.
  	self selectedPackage renameClass: self selectedClass to: newName.
  	self changed: #classList.
  	self classListIndex: ((systemOrganizer listAtCategoryNamed: self selectedSystemCategory) indexOf: newName).
  !

Item was changed:
  ----- Method: FileContentsBrowser>>setClassOrganizer (in category 'metaclass') -----
  setClassOrganizer
  	"Install whatever organization is appropriate"
  	| theClass |
  	classOrganizer := nil.
  	metaClassOrganizer := nil.
+ 	self hasClassSelected ifFalse: [^ self].
- 	classListIndex = 0 ifTrue: [^ self].
  	classOrganizer := (theClass := self selectedClass) organization.
  	metaClassOrganizer := theClass metaClass organization.
  !




More information about the Squeak-dev mailing list