[squeak-dev] The Trunk: Tools-rkrk.111.mcz

Andreas Raab uploaded a new version of Tools to project The Trunk:
http://source.squeak.org/trunk/Tools-rkrk.111.mcz

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

Name: Tools-rkrk.111
Author: rkrk
Time: 24 August 2009, 1:57:55 am
UUID: c7257f3c-6157-453d-b484-f15f0dd55c77
Ancestors: Tools-rss.110

Optionally order and indent classes by hierarchy in the Browser.

Enable with:
Preferences enable: #listClassesHierarchically.

=============== Diff against Tools-rss.110 ===============

Item was changed:
  ----- Method: Browser>>defineTrait:notifying: (in category 'traits') -----
  defineTrait: defString notifying: aController  
 
  | defTokens keywdIx envt oldTrait newTraitName trait |
  oldTrait := self selectedClassOrMetaClass.
  defTokens := defString findTokens: Character separators.
  keywdIx := defTokens findFirst: [:x | x = 'category'].
  envt := self selectedEnvironment.
  keywdIx := defTokens findFirst: [:x | x = 'named:'].
  newTraitName := (defTokens at: keywdIx+1) copyWithoutAll: '#()'.
  ((oldTrait isNil or: [oldTrait baseTrait name asString ~= newTraitName])
  and: [envt includesKey: newTraitName asSymbol]) ifTrue:
  ["Attempting to define new class/trait over existing one when
  not looking at the original one in this browser..."
  (self confirm: ((newTraitName , ' is an existing class/trait in this system.
  Redefining it might cause serious problems.
  Is this really what you want to do?') asText makeBoldFrom: 1 to: newTraitName size))
  ifFalse: [^ false]].
 
  trait := Compiler evaluate: defString notifying: aController logged: true.
  ^(trait isKindOf: TraitBehavior)
  ifTrue: [
  self changed: #classList.
+ self classListIndex: (self classListIndexOf: trait baseTrait name).
- self classListIndex: (self classList indexOf: trait baseTrait name).
  self clearUserEditFlag; editClass.
  true]
  ifFalse: [ false ]
  !

Item was added:
+ ----- Method: Browser>>classListIndexOf: (in category 'class list') -----
+ classListIndexOf: className
+
+ | classList |
+ classList := self classList.
+ Preferences listClassesHierarchically
+ ifTrue: [classList := classList collect: [:ea | ea withoutLeadingBlanks asSymbol]].
+ ^ classList indexOf: className.!

Item was changed:
  CodeHolder subclass: #Browser
  instanceVariableNames: 'systemOrganizer classOrganizer metaClassOrganizer systemCategoryListIndex classListIndex messageCategoryListIndex messageListIndex editSelection metaClassIndicated'
+ classVariableNames: 'ListClassesHierarchically RecentClasses'
- classVariableNames: 'RecentClasses'
  poolDictionaries: ''
  category: 'Tools-Browser'!
 
  !Browser commentStamp: '<historical>' prior: 0!
  I represent a query path into the class descriptions, the software of the system.!

Item was changed:
  ----- Method: HierarchyBrowser>>selectedClassName (in category 'initialization') -----
  selectedClassName
  "Answer the name of the class currently selected.   di
   bug fix for the case where name cannot be found -- return nil rather than halt"
 
  | aName |
+ aName := self classList at: classListIndex ifAbsent: [^ nil].
+ ^ (aName copyWithout: Character space) asSymbol!
- aName := super selectedClassName.
- ^ aName == nil
- ifTrue:
- [aName]
- ifFalse:
- [(aName copyWithout: $ ) asSymbol]!

Item was added:
+ ----- Method: Browser>>flattenHierarchyTree:on:indent: (in category 'class list') -----
+ flattenHierarchyTree: classHierarchy on: col indent: indent
+
+ | class childs plusIndent |
+ plusIndent := String space.
+ classHierarchy do: [:assoc |
+ class := assoc key.
+ col add: indent , class name.
+ childs := assoc value.
+ self
+ flattenHierarchyTree: childs
+ on: col
+ indent: indent , plusIndent].
+ ^ col!

Item was changed:
  ----- Method: Browser>>setClass:selector: (in category 'initialize-release') -----
  setClass: aBehavior selector: aSymbol
  "Set the state of a new, uninitialized Browser."
 
  | isMeta aClass messageCatIndex |
  aBehavior ifNil: [^ self].
  (aBehavior isKindOf: Metaclass)
  ifTrue: [
  isMeta := true.
  aClass := aBehavior soleInstance]
  ifFalse: [
  isMeta := false.
  aClass := aBehavior].
  self selectCategoryForClass: aClass.
+ self classListIndex: (self classListIndexOf: aClass name).
- self classListIndex: (
- (systemOrganizer listAtCategoryNamed: self selectedSystemCategoryName)
- indexOf: aClass name).
  self metaClassIndicated: isMeta.
  aSymbol ifNil: [^ self].
  messageCatIndex := aBehavior organization numberOfCategoryOfElement: aSymbol.
  self messageCategoryListIndex: (messageCatIndex > 0
  ifTrue: [messageCatIndex + 1]
  ifFalse: [0]).
  messageCatIndex = 0 ifTrue: [^ self].
  self messageListIndex: (
  (aBehavior organization listAtCategoryNumber: messageCatIndex)
  indexOf: aSymbol).!

Item was changed:
  ----- Method: Browser>>recent (in category 'class list') -----
  recent
  "Let the user select from a list of recently visited classes.  11/96 stp.
  12/96 di:  use class name, not classes themselves.
  : dont fall into debugger in empty case"
 
  | className class recentList |
  recentList := RecentClasses select: [:n | Smalltalk includesKey: n].
  recentList size == 0 ifTrue: [^ Beeper beep].
  className := UIManager default chooseFrom: recentList values: recentList.
  className == nil ifTrue: [^ self].
  class := Smalltalk at: className.
  self selectCategoryForClass: class.
+ self classListIndex: (self classListIndexOf: class name)!
- self classListIndex: (self classList indexOf: class name)!

Item was changed:
  ----- Method: Browser>>renameClass (in category 'class functions') -----
  renameClass
  | oldName newName obs |
  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].
  (Smalltalk includesKey: newName)
  ifTrue: [^ self error: newName , ' already exists'].
  self selectedClass rename: newName.
  self changed: #classList.
+ self classListIndex: (self classListIndexOf: newName).
- self
- classListIndex: ((systemOrganizer listAtCategoryNamed: self selectedSystemCategoryName)
- indexOf: newName).
  obs := self systemNavigation
  allCallsOn: (Smalltalk associationAt: newName).
  obs isEmpty
  ifFalse: [self systemNavigation
  browseMessageList: obs
  name: 'Obsolete References to ' , oldName
  autoSelect: oldName]!

Item was added:
+ ----- Method: Browser class>>listClassesHierarchically: (in category 'preferences') -----
+ listClassesHierarchically: aBool
+
+ ListClassesHierarchically := aBool!

Item was changed:
  ----- Method: Browser>>classList (in category 'class list') -----
  classList
- "Answer an array of the class names of the selected category. Answer an
- empty array if no selection exists."
 
+ ^ Preferences listClassesHierarchically
+ ifTrue: [self hierarchicalClassList]
+ ifFalse: [self defaultClassList].!
- systemCategoryListIndex = 0
- ifTrue: [^Array new]
- ifFalse: [^systemOrganizer listAtCategoryNumber: systemCategoryListIndex]!

Item was added:
+ ----- Method: Browser>>defaultClassList (in category 'class list') -----
+ defaultClassList
+ "Answer an array of the class names of the selected category. Answer an
+ empty array if no selection exists."
+
+ ^ systemCategoryListIndex = 0
+ ifTrue: [Array new]
+ ifFalse: [systemOrganizer listAtCategoryNumber: systemCategoryListIndex]!

Item was added:
+ ----- Method: Browser class>>listClassesHierarchically (in category 'preferences') -----
+ listClassesHierarchically
+ <preference: 'List classes hierarchically'
+ category: 'browsing'
+ description: 'When enabled, the class list in the browser is arranged and indented with regard to the class hierarchy.'
+ type: #Boolean>
+ ^ListClassesHierarchically ifNil: [false]
+ !

Item was added:
+ ----- Method: Browser>>createHierarchyTreeOf: (in category 'class list') -----
+ createHierarchyTreeOf: col
+
+ "Create a tree from a flat collection of classes"
+ | childs transformed val indexes |
+ transformed := col collect: [:ea |
+ childs := col select: [:class | class superclass = ea].
+ indexes := childs collect: [:child | col indexOf: child].
+ ea -> indexes].
+ transformed copy do: [:ea |
+ ea value: (ea value collect: [:idx |
+ val := transformed at: idx.
+ transformed at: idx put: nil.
+ val])].
+ ^ transformed select: [:ea | ea notNil].
+ !

Item was changed:
  ----- Method: Browser>>selectedClassName (in category 'class list') -----
  selectedClassName
- | aClassList |
- "Answer the name of the current class. Answer nil if no selection exists."
 
+ | className |
+ className := self classList
+ at: classListIndex
+ ifAbsent: [^ nil].
+ Preferences listClassesHierarchically ifTrue: [
+ className := className withoutLeadingBlanks asSymbol].
+ ^ className.!
- (classListIndex = 0 or: [classListIndex > (aClassList := self classList) size]) ifTrue: [^ nil].
- ^ aClassList at: classListIndex!

Item was added:
+ ----- Method: Browser>>hierarchicalClassList (in category 'class list') -----
+ hierarchicalClassList
+
+ "classNames are an arbitrary collection of classNames of the system.
+ Reorder those class names so that they are sorted and indended by inheritance"
+ | classes |
+ classes := self defaultClassList collect: [:sym | Smalltalk classNamed: sym].
+ ^ self
+ flattenHierarchyTree: (self createHierarchyTreeOf: classes)
+ on: OrderedCollection new
+ indent: ''.!

Item was changed:
  ----- Method: Browser>>selectClass: (in category 'class list') -----
  selectClass: classNotMeta
+
+ self classListIndex: (self classListIndexOf: classNotMeta name)!
- self classListIndex: (self classList indexOf: classNotMeta name)!