[squeak-dev] The Trunk: Tools-rkrk.111.mczcommits at source.squeak.org commits at source.squeak.orgMon Aug 24 03:57:38 UTC 2009
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)!
More information about the Squeak-dev mailing list |