"

 COPYRIGHT (c) 2000 by eXept Software AG

 COPYRIGHT (c) 2016 Jan Vrany

              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 showSyntheticMethods'

	classVariableNames:'AdditionalEmptyCategoriesPerClassName MethodInfoCache

		MethodInfoCacheAccessLock'

	poolDictionaries:''

	category:'Interface-Browsers-New'

!

Object subclass:#CachedMethodInfo

	instanceVariableNames:'flags'

	classVariableNames:'FlagObsolete FlagSendsSuper FlagIsUncommented

		FlagIsDocumentationMethod FlagIsLongMethod FlagIsExtension

		FlagIsRedefine FlagIsRedefined FlagIsOverride

		FlagIsSubclassResponsibility FlagIsTest FlagIsAnnotated'

	poolDictionaries:''

	privateIn:MethodCategoryList

!

Method variableSubclass:#MissingMethod

	instanceVariableNames:'selector'

	classVariableNames:''

	poolDictionaries:''

	privateIn:MethodCategoryList

!

MethodCategoryList::MissingMethod variableSubclass:#MethodStubForTestResult

	instanceVariableNames:''

	classVariableNames:''

	poolDictionaries:''

	privateIn:MethodCategoryList

!

!MethodCategoryList class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 2000 by eXept Software AG

 COPYRIGHT (c) 2016 Jan Vrany

              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.

"

!

documentation

"

    I implement the method category (= protocol) list in the new system browser

"

! !

!MethodCategoryList class methodsFor:'initialization'!

flushMethodInfo

    MethodInfoCache := Dictionary new.

    "

     self flushMethodInfo

    "

!

initialize

    MethodInfoCache := Dictionary new.

    MethodInfoCacheAccessLock := RecursionLock new name:'MethodInfoCacheAccessLock'.

! !

!MethodCategoryList class methodsFor:'cleanup'!

lowSpaceCleanup

    self flushMethodInfo

    "Created: / 08-08-2011 / 19:15:25 / cg"

! !

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

          #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)."

    ^ #(

        environmentHolder

        #(#doubleClickChannel #action )

        #filterClassVars

        #forceGeneratorTrigger

        #immediateUpdate

        #inGeneratorHolder

        #menuHolder

        #noAllItem

        #showPseudoProtocols

        #outGeneratorHolder

        #packageFilter

        #packageFilterOnInput

        #selectedProtocols

        #selectionChangeCondition

        #updateTrigger

        #variableFilter

        #methodVisibilityHolder

        #showCoverageInformation

        #showSyntheticMethods

      ).

    "Modified: / 27-04-2010 / 16:40:39 / cg"

    "Modified: / 24-02-2014 / 10:37:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!MethodCategoryList class methodsFor:'queries'!

isPseudoCategory:cat

    ^ (super isPseudoCategory:cat)

    or:[ (cat startsWith:'* ')

        and:[ (cat endsWith:' *')

        and:[ (cat includesString:'%1') ]]]

! !

!MethodCategoryList methodsFor:'aspects'!

browserNameList

    ^ self protocolList 

!

defaultSlaveModeValue

    ^ false.

!

filterClassVars

    filterClassVars isNil ifTrue:[

        filterClassVars := ValueHolder with:false.

        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 := ValueHolder with:false.

        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 := ValueHolder with:false.

        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 := ValueHolder with:nil.

        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 := ValueHolder with:true.

        showPseudoProtocols addDependent:self

    ].

    ^  showPseudoProtocols

!

showPseudoProtocols:aValueHolder

    showPseudoProtocols notNil ifTrue:[

        showPseudoProtocols removeDependent:self

    ].

    showPseudoProtocols := aValueHolder.

    showPseudoProtocols notNil ifTrue:[

        showPseudoProtocols addDependent:self

    ].

!

showSyntheticMethods

    showSyntheticMethods isNil ifTrue:[

        showSyntheticMethods := ValueHolder with:true.

        showSyntheticMethods addDependent:self

    ].

    ^  showSyntheticMethods

!

showSyntheticMethods:aValueHolder

    showSyntheticMethods notNil ifTrue:[

        showSyntheticMethods removeDependent:self

    ].

    showSyntheticMethods := aValueHolder.

    showSyntheticMethods notNil ifTrue:[

        showSyntheticMethods addDependent:self

    ].

!

variableFilter

    variableFilter isNil ifTrue:[

        variableFilter := ValueHolder with:false.

        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.

                    newClass := Smalltalk at:nm.

                    oldClass isMeta ifTrue:[

                        newClass isNil ifTrue:[

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

                            newClass := oldClass

                        ] ifFalse:[

                            newClass := newClass theMetaclass

                        ]

                    ].

                    newClass ~~ oldClass ifTrue:[

                        anyChange := true.

                    ].

                    newClass

            ].

    classes := classes collect:[:oldClass | oldClass notNil ifTrue:[refetch value: oldClass] ifFalse:[nil]].

    leafClasses := leafClasses collect:[:oldClass | oldClass notNil ifTrue:[refetch value: oldClass] ifFalse:[nil]].

    anyChange ifTrue:[

        self updateOutputGenerator

    ].

    "Modified: / 06-07-2011 / 11:44:13 / cg"

    "Modified: / 15-10-2013 / 01:19:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

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 == environment 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.

                    listValid == true ifTrue:[ 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 enqueueDelayedUpdateOutputGenerator "/ 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