The Inbox: Tools-fbs.302.mcz

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.
  !