Tools_ImplementingClassList.st
author Claus Gittinger <cg@exept.de>
Thu, 26 Feb 2004 19:57:02 +0100
changeset 5591 273637686948
child 5592 d9730a8d7c52
permissions -rw-r--r--
initial checkin

"{ Package: 'stx:__NoProject__' }"

"{ NameSpace: Tools }"

MethodList subclass:#ImplementingClassList
	instanceVariableNames:''
	classVariableNames:''
	poolDictionaries:''
	category:'Interface-Browsers-New'
!

!ImplementingClassList class methodsFor:'documentation'!

documentation
"
    Like a ClassList, but shows classes hierarchical.

    If topClassHolders value is non-nil, only that classes hierarchy
    is shown.

    embeddable application displaying the classes as listed by
    the inputGenerator.
    Provides an outputGenerator, which enumerates the classes and
    their protocols (method-categories) in the selected classes.

    [author:]
	Claus Gittinger (cg@exept.de)
"


! !

!ImplementingClassList methodsFor:'private'!

listOfMethodNames
    |methods entries newNameList 
     allCategories classUses allSelectors generator 
     "theMethod"|

    generator := inGeneratorHolder value.
    generator isNil ifTrue:[^ #() ].

    classUses := Bag identityNew.
    allSelectors := IdentitySet new.
    allCategories := Set new.
    entries := OrderedCollection new.

    "/ generator generates nil-selector entries
    "/ to pass multiple-class and multiple-protocol info
    generator do:[:cls :cat :sel :mthd | 
			sel notNil ifTrue:[
			    entries add:(Array with:cls with:sel with:mthd).
			    classUses add:cls.
			    allSelectors add:sel.
			    allCategories add:mthd category.
			]
		 ].

    entries sort:[:a :b | |clsNmA clsNmB|
			   clsNmA := (a at:1) name.
			   clsNmB := (b at:1) name.
			   clsNmA < clsNmB
		 ].

    newNameList := entries collect:[:entry | 
					|class nm|

					class := (entry at:1).
					nm := class name.
					((allSelectors size > 1)
					or:[(classUses occurrencesOf:class) > 1]) ifTrue:[
					    nm := nm , ' ' , (entry at:2)
					].
					allCategories size > 1 ifTrue:[
					    nm := nm , ' {' , (entry at:3) category , '}'
					].
"/                                        class name , ' ' , (entry at:2)
					nm
				   ].
    methods := entries collect:[:entry | (entry at:3)].
    methodList := methods.
"/    methods size == 1 ifTrue:[
"/        theMethod := methods first.
"/        self methodLabelHolder value:(theMethod mclass name , ' ' , theMethod selector).
"/    ].
    ^ newNameList.

    "Created: / 5.2.2000 / 22:43:40 / cg"
    "Modified: / 1.3.2000 / 21:00:26 / cg"
! !

!ImplementingClassList class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libtool/Tools_ImplementingClassList.st,v 1.1 2004-02-26 18:56:02 cg Exp $'
! !