[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
|