"

 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:#MethodList

	instanceVariableNames:'classes selectedMethodNameIndices methodList lastSelectedMethods

		browserNameList variableFilter filterClassVars updateProcess

		lastShowClass lastShowCategory lastShowClassFirst

		showMethodInheritance lastMethodClass lastMethodClassesSubclasses

		classAndSelectorsRedefinedBySubclassesOfClass showClass

		showMethodComplexity showMethodTypeIcon

		showImageResourceMethodsImages'

	classVariableNames:'ShowComplexityValue'

	poolDictionaries:''

	category:'Interface-Browsers-New'

!

!MethodList 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.

"

! !

!MethodList class methodsFor:'interface specs'!

singleMethodWindowSpec

    "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:MethodList andSelector:#singleMethodWindowSpec

     MethodList new openInterface:#singleMethodWindowSpec

    "

    <resource: #canvas>

    ^ 

     #(#FullSpec

        #name: #singleMethodWindowSpec

        #window: 

       #(#WindowSpec

          #label: 'SingleSelectorList'

          #name: 'SingleSelectorList'

          #min: #(#Point 0 0)

          #max: #(#Point 1024 721)

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

        )

        #component: 

       #(#SpecCollection

          #collection: #(

           #(#LabelSpec

              #label: 'MethodName'

              #name: 'MethodLabel'

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

              #translateLabel: true

              #labelChannel: #methodLabelHolder

              #menu: #menuHolder

           )

           )

        )

      )

    "Modified: / 1.3.2000 / 20:50:15 / cg"

!

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:Tools::MethodList andSelector:#windowSpec

     Tools::MethodList new openInterface:#windowSpec

     Tools::MethodList open

    "

    <resource: #canvas>

    ^ 

     #(FullSpec

        name: windowSpec

        window: 

       (WindowSpec

          label: 'SelectorList'

          name: 'SelectorList'

          min: (Point 0 0)

          bounds: (Rectangle 0 0 300 300)

        )

        component: 

       (SpecCollection

          collection: (

           (SequenceViewSpec

              name: 'List'

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

              tabable: true

              model: selectedMethodNameIndices

              menu: menuHolder

              hasHorizontalScrollBar: true

              hasVerticalScrollBar: true

              miniScrollerHorizontal: true

              isMultiSelect: true

              valueChangeSelector: selectionChangedByClick

              useIndex: true

              sequenceList: browserNameList

              doubleClickChannel: doubleClickChannel

              properties: 

             (PropertyListDictionary

                canDropSelector: canDropContext:

                dragArgument: nil

                dropArgument: nil

                dropSelector: doDropContext:

              )

            )

           )

        )

      )

! !

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

        #methodCategoryHolder

        #packageFilter

        #selectedMethods

        #selectionChangeCondition

        #showCoverageInformation

        #showImageResourceMethodsImages

        #showMethodComplexity

        #showMethodInheritance

        #showMethodTypeIcon

        #sortBy

        #updateTrigger

        #variableFilter

      ).

! !

!MethodList methodsFor:'aspects'!

browserNameList

    browserNameList isNil ifTrue:[

        browserNameList := List new.

    ].

    ^ browserNameList.

    "Modified: / 31.1.2000 / 00:42:44 / cg"

    "Created: / 5.2.2000 / 22:38:32 / cg"

!

defaultSlaveModeValue

    ^ false.

!

filterClassVars

    filterClassVars isNil ifTrue:[

        filterClassVars := false asValue.

        filterClassVars addDependent:self

    ].

    ^  filterClassVars

!

filterClassVars:aValueHolder

    filterClassVars notNil ifTrue:[

        filterClassVars removeDependent:self

    ].

    filterClassVars := aValueHolder.

    filterClassVars notNil ifTrue:[

        filterClassVars addDependent:self

    ].

!

methodLabelHolder

    ^ self pseudoListLabelHolder

    "Created: / 1.3.2000 / 20:50:07 / cg"

!

methodList

    ^ methodList

!

selectedMethodNameIndices

    selectedMethodNameIndices isNil ifTrue:[

        selectedMethodNameIndices := ValueHolder new.

        selectedMethodNameIndices addDependent:self

    ].

    ^ selectedMethodNameIndices.

    "Modified: / 5.2.2000 / 00:31:48 / cg"

    "Created: / 5.2.2000 / 22:59:31 / cg"

!

selectedMethods

    ^ self selectionHolder

!

selectedMethods:aValueHolder

    ^ self selectionHolder:aValueHolder

!

showImageResourceMethodsImages

    showImageResourceMethodsImages isNil ifTrue:[

        showImageResourceMethodsImages := false asValue.

        showImageResourceMethodsImages addDependent:self

    ].

    ^  showImageResourceMethodsImages

!

showImageResourceMethodsImages:aValueHolder

    showImageResourceMethodsImages notNil ifTrue:[

        showImageResourceMethodsImages removeDependent:self

    ].

    showImageResourceMethodsImages := aValueHolder.

    showImageResourceMethodsImages notNil ifTrue:[

        showImageResourceMethodsImages addDependent:self

    ].

!

showMethodComplexity

    showMethodComplexity isNil ifTrue:[

        showMethodComplexity := false asValue.

        showMethodComplexity addDependent:self

    ].

    ^  showMethodComplexity

!

showMethodComplexity:aValueHolder

    showMethodComplexity notNil ifTrue:[

        showMethodComplexity removeDependent:self

    ].

    showMethodComplexity := aValueHolder.

    showMethodComplexity notNil ifTrue:[

        showMethodComplexity addDependent:self

    ].

!

showMethodInheritance

    showMethodInheritance isNil ifTrue:[

        showMethodInheritance := false asValue.

        showMethodInheritance addDependent:self

    ].

    ^  showMethodInheritance

!

showMethodInheritance:aValueHolder

    showMethodInheritance notNil ifTrue:[

        showMethodInheritance removeDependent:self

    ].

    showMethodInheritance := aValueHolder.

    showMethodInheritance notNil ifTrue:[

        showMethodInheritance addDependent:self

    ].

!

showMethodTypeIcon

    showMethodTypeIcon isNil ifTrue:[

        showMethodTypeIcon := true asValue.

        showMethodTypeIcon addDependent:self

    ].

    ^  showMethodTypeIcon

!

showMethodTypeIcon:aValueHolder

    showMethodTypeIcon notNil ifTrue:[

        showMethodTypeIcon removeDependent:self

    ].

    showMethodTypeIcon := aValueHolder.

    showMethodTypeIcon notNil ifTrue:[

        showMethodTypeIcon addDependent:self

    ].

!

variableFilter

    variableFilter isNil ifTrue:[

        variableFilter := nil asValue.

        variableFilter addDependent:self

    ].

    ^  variableFilter

!

variableFilter:aValueHolder

    variableFilter notNil ifTrue:[

        variableFilter removeDependent:self

    ].

    variableFilter := aValueHolder.

    variableFilter notNil ifTrue:[

        variableFilter addDependent:self

    ].

! !

!MethodList methodsFor:'change & update'!

delayedUpdate:something with:aParameter from:changedObject

    |cls sel oldMethod newMethod methods newSelection

     selectionHolder selection needSelectionChange|

    selectionHolder := self selectedMethods.

    selection := selectionHolder value.

    changedObject == Smalltalk ifTrue:[

        classes notNil ifTrue:[

            something == #classDefinition ifTrue:[

                cls := aParameter.

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

                    ^ self   "/ I dont care for that class

                ].

                classes := classes collect:[:eachClass | eachClass isMeta ifTrue:[

                                                             (Smalltalk at:eachClass theNonMetaclass name) class 

                                                         ] ifFalse:[

                                                             Smalltalk at:eachClass name

                                                         ]

                                           ].

                self invalidateList.

"/                self updateList.

                ^ self.

            ].

            something == #methodCategory ifTrue:[

                "/ ignore here - methodCategoryList will tell me if required

                ^ self

            ].

            (something == #classOrganization

            or:[ something == #methodCategoryAdded

            or:[ something == #methodCategoryRemoved

            or:[ something == #methodCategoriesRemoved

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

                "/ ignore here - methodCategoryList will tell me if required

                ^ self

            ].

            something == #methodInClass ifTrue:[

                "/ a method has been added/changed

                cls := aParameter at:1.

                (classes includesIdentical:cls) ifTrue:[

                    sel := aParameter at:2.

                    oldMethod := aParameter at:3.

                    newMethod := cls compiledMethodAt:sel.

                    (oldMethod notNil and:[newMethod notNil]) ifTrue:[

                        "a method was changed & acccepted;

                         No need for a rescan of the methodDictionary;

                         however, ensure that the refs to the old method are updated

                        "

                        methods := selection.

                        methods size > 0 ifTrue:[

                            (methods includesIdentical:oldMethod) ifTrue:[

                                needSelectionChange := true.

                            ]

                        ].

                        methodList replaceAllIdentical:oldMethod with:newMethod.

                        lastSelectedMethods notNil ifTrue:[

                            lastSelectedMethods replaceAllIdentical:oldMethod with:newMethod

                        ].

                        methods size > 0 ifTrue:[

                            methods := methods asOrderedCollection.

                            methods replaceAllIdentical:oldMethod with:newMethod.

                        ].

                        needSelectionChange == true ifTrue:[

                            selectionHolder setValue:methods.

                            "/ self enqueueDelayedMethodsSelectionChanged.

                            "/ need this to inform my browser that method was changed

                            "/ by someone else.

                            selectionHolder changed.

                        ].

                        "/JV@2011-07-22: Update always - I need to see immediately that

                        "/the method has changed. Also, add/remove breakpoint etc.

"/                        (variableFilter value size > 0

"/                        or:[oldMethod package ~= newMethod package

"/                        or:[oldMethod resources ~= newMethod resources

"/                        or:[showMethodComplexity value == true]]])

                        true

                        ifTrue:[

                            "/ only update that methods entry

                            self updateListEntryFor:newMethod.    

                            "/ 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.

                ].

                ^ self.

            ].

            something == #methodInClassRemoved ifTrue:[

                cls := aParameter at:1.

                (classes includesIdentical:cls) ifTrue:[

                    sel := aParameter at:2.

                    "/ method was removed - update the methodList

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

                    self invalidateList.

                ].

                ^ self.

            ].

            something == #methodCoverageInfo ifTrue:[

                "/ already checked if it is one of my classes

                listValid == true ifTrue:[

                    self invalidateList.

                ].

                ^ self.

            ].

            (something == #methodTrap 

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

                cls := aParameter at:1.

                sel := aParameter at:2.

                (classes includesIdentical:cls) ifFalse:[ ^ self].

                newMethod := cls compiledMethodAt:sel.

                newMethod isNil ifTrue:[

                    self invalidateList.

                    ^ self

                ].

                (something == #privacyOfMethod) ifTrue:[

                    self updateListEntryFor:newMethod.    

                ].

                (something == #methodTrap) ifTrue:[ 

                    newMethod isWrapped ifTrue:[

                        oldMethod := newMethod originalMethod

                    ] ifFalse:[

                        selection size > 0 ifTrue:[

                            oldMethod := selection detect:[:each | each isWrapped and:[each originalMethod == newMethod]] ifNone:nil.

                        ]

                    ].

                    selection size > 0 ifTrue:[

                        (selection includesIdentical:oldMethod) ifTrue:[

                            needSelectionChange := true.

                        ]

                    ].

                    methodList replaceAllIdentical:oldMethod with:newMethod.

                    lastSelectedMethods notNil ifTrue:[

                        lastSelectedMethods replaceAllIdentical:oldMethod with:newMethod

                    ].

                    selection size > 0 ifTrue:[

                        selection := selection asOrderedCollection.

                        selection replaceAllIdentical:oldMethod with:newMethod.

                    ].

                    needSelectionChange == true ifTrue:[

                        selectionHolder changed.

                    ].

                    "/ actually, could just change that single item ...

                    "/ ... might be cheaper, if list is huge.

                    "/ only update that methods entry

                    self updateListEntryFor:newMethod.    

                    "/ self invalidateList.

                ].

                ^ self

            ].

            (something == #projectOrganization

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

                aParameter notNil ifTrue:[

                    cls := aParameter at:1.

                    cls notNil ifTrue:[

                        ((classes includesIdentical:cls theNonMetaclass)

                        or:[(classes includesIdentical:cls theMetaclass)]) ifTrue:[

                            self invalidateList.

                        ].

                    ].

                ] ifFalse:[

                    self invalidateList.

                ].

                ^ self

            ].

            "/ everything else is ignored

            "/ self halt.

        ].

        ^ self

    ].

"/    something == #organization ifTrue:[

"/self halt:'no longer'.

"/^ self.

"/        "/ a methods cateory has changed

"/        (classes includesIdentical:changedObject) ifTrue:[