"

 COPYRIGHT (c) 2000 by eXept Software AG

	      All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

"{ Package: 'stx:libtool' }"

"{ NameSpace: Tools }"

BrowserList subclass:#MethodCategoryList

	instanceVariableNames:'variableFilter filterClassVars lastSelectedProtocols classes

		leafClasses protocolList rawProtocolList selectedProtocolIndices

		lastGeneratedProtocols packageFilterOnInput

		methodVisibilityHolder noAllItem noPseudoItems

		showPseudoProtocols'

	classVariableNames:'AdditionalEmptyCategoriesPerClassName MethodInfoCache

		MethodInfoCacheAccessLock'

	poolDictionaries:''

	category:'Interface-Browsers-New'

!

Object subclass:#CachedMethodInfo

	instanceVariableNames:'flags'

	classVariableNames:'FlagObsolete FlagSendsSuper FlagIsUncommented

		FlagIsDocumentationMethod FlagIsLongMethod FlagIsExtension

		FlagIsRedefine FlagIsOverride'

	poolDictionaries:''

	privateIn:MethodCategoryList

!

!MethodCategoryList class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 2000 by eXept Software AG

	      All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

! !

!MethodCategoryList class methodsFor:'initialization'!

flushMethodInfo

    MethodInfoCache := Dictionary new.

    "

     self flushMethodInfo

    "

!

initialize

    MethodInfoCache := Dictionary new.

    MethodInfoCacheAccessLock := RecursionLock new.

! !

!MethodCategoryList class methodsFor:'interface specs'!

singleProtocolWindowSpec

    "This resource specification was automatically generated

     by the UIPainter of ST/X."

    "Do not manually edit this!! If it is corrupted,

     the UIPainter may not be able to read the specification."

    "

     UIPainter new openOnClass:MethodCategoryList andSelector:#singleProtocolWindowSpec

     MethodCategoryList new openInterface:#singleProtocolWindowSpec

    "

    <resource: #canvas>

    ^ 

     #(#FullSpec

	#name: #singleProtocolWindowSpec

	#window: 

       #(#WindowSpec

	  #label: 'ProtocolList'

	  #name: 'ProtocolList'

	  #min: #(#Point 0 0)

	  #max: #(#Point 1024 721)

	  #bounds: #(#Rectangle 12 22 312 322)

	)

	#component: 

       #(#SpecCollection

	  #collection: #(

	   #(#LabelSpec

	      #label: 'ProtocolName'

	      #name: 'ProtocolLabel'

	      #layout: #(#LayoutFrame 0 0.0 0 0 0 1.0 25 0)

	      #translateLabel: true

	      #labelChannel: #protocolLabelHolder

	      #menu: #menuHolder

	    )

	   )

	)

      )

!

windowSpec

    "This resource specification was automatically generated

     by the UIPainter of ST/X."

    "Do not manually edit this!! If it is corrupted,

     the UIPainter may not be able to read the specification."

    "

     UIPainter new openOnClass:MethodCategoryList andSelector:#windowSpec

     MethodCategoryList new openInterface:#windowSpec

     MethodCategoryList open

    "

    <resource: #canvas>

    ^ 

     #(#FullSpec

        #name: #windowSpec

        #window: 

       #(#WindowSpec

          #label: 'ProtocolList'

          #name: 'ProtocolList'

          #min: #(#Point 0 0)

          #max: #(#Point 1024 721)

          #bounds: #(#Rectangle 16 46 316 346)

        )

        #component: 

       #(#SpecCollection

          #collection: #(

           #(#SequenceViewSpec

              #name: 'List'

              #layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)

              #tabable: true

              #model: #selectedProtocolIndices

              #menu: #menuHolder

              #hasHorizontalScrollBar: true

              #hasVerticalScrollBar: true

              #miniScrollerHorizontal: true

              #isMultiSelect: true

              #valueChangeSelector: #selectionChangedByClick

              #useIndex: true

              #sequenceList: #protocolList

              #doubleClickChannel: #doubleClickChannel

              #properties: 

             #(#PropertyListDictionary

                #dragArgument: nil

                #dropArgument: nil

                #canDropSelector: #canDropContext:

                #dropSelector: #doDropContext:

              )

            )

           )

        )

      )

! !

!MethodCategoryList class methodsFor:'plugIn spec'!

aspectSelectors

    "This resource specification was automatically generated

     by the UIPainter of ST/X."

    "Do not manually edit this. If it is corrupted,

     the UIPainter may not be able to read the specification."

    "Return a description of exported aspects;

     these can be connected to aspects of an embedding application

     (if this app is embedded in a subCanvas)."

    ^ #(

        #(#doubleClickChannel #action )

        #filterClassVars

        #forceGeneratorTrigger

        #immediateUpdate

        #inGeneratorHolder

        #menuHolder

        #noAllItem

        #showPseudoProtocols

        #outGeneratorHolder

        #packageFilter

        #packageFilterOnInput

        #selectedProtocols

        #selectionChangeCondition

        #updateTrigger

        #variableFilter

        #methodVisibilityHolder

      ).

! !

!MethodCategoryList methodsFor:'aspects'!

browserNameList

    ^ self protocolList 

!

defaultSlaveModeValue

    ^ false.

!

filterClassVars

    filterClassVars isNil ifTrue:[

	filterClassVars := false asValue.

	filterClassVars addDependent:self

    ].

    ^  filterClassVars

    "Modified: / 31.1.2000 / 00:56:31 / cg"

    "Created: / 5.2.2000 / 13:42:10 / cg"

!

filterClassVars:aValueHolder

    filterClassVars notNil ifTrue:[

	filterClassVars removeDependent:self

    ].

    filterClassVars := aValueHolder.

    filterClassVars notNil ifTrue:[

	filterClassVars addDependent:self

    ].

    "Modified: / 31.1.2000 / 00:56:31 / cg"

    "Created: / 5.2.2000 / 13:42:10 / cg"

!

methodVisibilityHolder

    methodVisibilityHolder isNil ifTrue:[

	methodVisibilityHolder := false asValue.

	methodVisibilityHolder addDependent:self

    ].

    ^  methodVisibilityHolder

!

methodVisibilityHolder:aValueHolder

    methodVisibilityHolder notNil ifTrue:[

	methodVisibilityHolder removeDependent:self

    ].

    methodVisibilityHolder := aValueHolder.

    methodVisibilityHolder notNil ifTrue:[

	methodVisibilityHolder addDependent:self

    ].

    "Modified: / 31.1.2000 / 00:56:31 / cg"

    "Created: / 5.2.2000 / 13:42:10 / cg"

!

noAllItem

    noAllItem isNil ifTrue:[

	noAllItem := false asValue.

	noAllItem addDependent:self

    ].

    ^  noAllItem

!

noAllItem:aValueHolder

    noAllItem notNil ifTrue:[

	noAllItem removeDependent:self

    ].

    noAllItem := aValueHolder.

    noAllItem notNil ifTrue:[

	noAllItem addDependent:self

    ].

!

packageFilterOnInput

    packageFilterOnInput isNil ifTrue:[

	packageFilterOnInput := nil asValue.

	packageFilterOnInput addDependent:self

    ].

    ^  packageFilterOnInput

!

packageFilterOnInput:aValueHolder

    |prevFilter|

    prevFilter := packageFilterOnInput value.

    packageFilterOnInput notNil ifTrue:[

	packageFilterOnInput removeDependent:self

    ].

    packageFilterOnInput := aValueHolder.

    packageFilterOnInput notNil ifTrue:[

	packageFilterOnInput addDependent:self

    ].

    prevFilter ~= packageFilterOnInput value ifTrue:[

	self enqueueDelayedUpdateList

    ].

!

protocolLabelHolder

    ^ self pseudoListLabelHolder

!

protocolList

    protocolList isNil ifTrue:[

	protocolList := List new. "/ ValueHolder new

    ].

    ^ protocolList

    "Modified: / 31.1.2000 / 00:56:31 / cg"

    "Created: / 5.2.2000 / 13:42:10 / cg"

!

rawProtocolList

    rawProtocolList isNil ifTrue:[

	rawProtocolList := List new.

    ].

    ^ rawProtocolList

!

selectedProtocolIndices

    selectedProtocolIndices isNil ifTrue:[

	selectedProtocolIndices := ValueHolder new.

	selectedProtocolIndices addDependent:self

    ].

    ^ selectedProtocolIndices.

!

selectedProtocols

    ^ self selectionHolder

!

selectedProtocols:aValueHolder

    ^ self selectionHolder:aValueHolder

!

showPseudoProtocols

    showPseudoProtocols isNil ifTrue:[

        showPseudoProtocols := true asValue.

        showPseudoProtocols addDependent:self

    ].

    ^  showPseudoProtocols

!

showPseudoProtocols:aValueHolder

    showPseudoProtocols notNil ifTrue:[

        showPseudoProtocols removeDependent:self

    ].

    showPseudoProtocols := aValueHolder.

    showPseudoProtocols notNil ifTrue:[

        showPseudoProtocols addDependent:self

    ].

!

variableFilter

    variableFilter isNil ifTrue:[

	variableFilter := false asValue.

	variableFilter addDependent:self

    ].

    ^  variableFilter

    "Modified: / 31.1.2000 / 00:56:31 / cg"

    "Created: / 5.2.2000 / 13:42:10 / cg"

!

variableFilter:aValueHolder

    variableFilter notNil ifTrue:[

	variableFilter removeDependent:self

    ].

    variableFilter := aValueHolder.

    variableFilter notNil ifTrue:[

	variableFilter addDependent:self

    ].

    "Modified: / 31.1.2000 / 00:56:31 / cg"

    "Created: / 5.2.2000 / 13:42:10 / cg"

! !

!MethodCategoryList methodsFor:'change & update'!

classDefinitionChanged:aClass

    |refetch anyChange|

    anyChange := false.

    refetch := [:oldClass | 

		    |nm cls newClass|

		    nm := oldClass theNonMetaclass name.

		    oldClass isMeta ifTrue:[

			newClass := Smalltalk at:nm.

			newClass isNil ifTrue:[

			    Transcript showCR:'oops - browser lost class ' , nm.

			    newClass := oldClass

			] ifFalse:[

			    newClass := newClass theMetaclass

			]

		    ] ifFalse:[

			newClass := Smalltalk at:nm

		    ].

		    newClass ~~ oldClass ifTrue:[

			anyChange := true.

		    ].

		    newClass

	    ].

    classes := classes collect:refetch.

    leafClasses := leafClasses collect:refetch.

    anyChange ifTrue:[

	self updateOutputGenerator

    ].

!

delayedUpdate:something with:aParameter from:changedObject

    |sel oldMethod newMethod mthd selectedCategories selectedProtocolsHolder oldProtocol newProtocol

     rawProtocolListHolder rawProtocolList oldSelectedProtocols newSelectedProtocols newIndices idx cls listView|

    selectedProtocolsHolder := self selectedProtocols.

    rawProtocolListHolder := self rawProtocolList.

    changedObject == Smalltalk ifTrue:[

        classes notNil ifTrue:[

            something == #methodCategory ifTrue:[

                cls := aParameter at:1.

                (cls notNil and:[classes includesIdentical:cls]) ifTrue:[

                    mthd := aParameter at:2.

                    newProtocol := mthd category.

                    oldProtocol := aParameter at:3.

                    self invalidateList.

                    selectedCategories := selectedProtocolsHolder value.

                    selectedCategories size > 0 ifTrue:[

                        selectedCategories := selectedCategories collect:[:each | each ifNil:[self class nameListEntryForNILCategory]].

                        selectedCategories := selectedCategories collect:[:each | each string].

                        ((selectedCategories includes:oldProtocol)

                        or:[ (selectedCategories includes:newProtocol)

                        or:[ selectedCategories includes:(self class nameListEntryForALL) ]])

                        ifTrue:[

                            self updateOutputGenerator.

                        ].

                    ].

                ].

                ^ self

            ].

            something == #methodInClass ifTrue:[

                "/ a method has been added/removed/changed

                cls := aParameter at:1.

                (classes includesIdentical:cls) ifTrue:[

                    sel := aParameter at:2.

                    self flushMethodInfoForClassNamed:cls name selector:sel.

                    oldMethod := aParameter at:3.

                    newMethod := cls compiledMethodAt:sel.

                    oldMethod notNil ifTrue:[

                        variableFilter value size > 0 ifTrue:[

                            "/ sigh - must invalidate

                            self invalidateList.

                        ].

                        ^ self.

                    ].

                    "/ method was added - update the methodList

                    "/ Q: is this needed (methodCategoryList should send me a new inGenerator)

                    self invalidateList.

                    "/ if its category is selected, updateOutputGenerator

                    selectedCategories := selectedProtocolsHolder value.

                    selectedCategories size > 0 ifTrue:[

                        selectedCategories := selectedCategories collect:[:each | each ifNil:[self class nameListEntryForNILCategory]].

                        selectedCategories := selectedCategories collect:[:each | each string].

                        ((oldMethod notNil and:[selectedCategories includes:(oldMethod category)])

                        or:[ (newMethod notNil and:[selectedCategories includes:(newMethod category)])])

                        ifTrue:[

                            self updateOutputGenerator.

                        ].

                    ].

                ].

                ^ self.

            ].

            something == #methodInClassRemoved ifTrue:[

                cls := aParameter at:1.

                (classes includesIdentical:cls) ifTrue:[

                    sel := aParameter at:2.

                    self flushMethodInfoForClassNamed:cls name selector:sel.

                    "/ method was removed - update the list and output generator

                    self invalidateList.

                    "/ self updateOutputGenerator.

                    self slaveMode value == true ifFalse:[

                        self enqueueDelayedUpdateOutputGenerator.

                    ]

                ].

                ^ self.

            ].

            (something == #classOrganization

            or:[ something == #methodCategoryAdded

            or:[ something == #methodCategoryRemoved

            or:[ something == #methodCategoriesRemoved

            or:[ something == #methodCategoryRenamed ]]]]) ifTrue:[

                cls := (something == #classOrganization) ifTrue:aParameter ifFalse:[aParameter first].

                (classes includesIdentical:cls) ifTrue:[

                    self invalidateList.

                ] ifFalse:[

                    (classes contains:[:aClass | aClass name = cls name]) ifTrue:[

                        self invalidateList.

                        "/ self error:'obsolete class: should not happen'.

                    ]

                ].

                ^ self.