"

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

	instanceVariableNames:'variableList classHolder showClassVars sortVariablesByName

		selectedVariableEntries showWarningAboutMissingEntryInXmlSpec'

	classVariableNames:''

	poolDictionaries:''

	category:'Interface-Browsers-New'

!

Object subclass:#VariableEntry

	instanceVariableNames:'label application class name type icon sortingByNameHolder'

	classVariableNames:''

	poolDictionaries:''

	privateIn:VariableList

!

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

"

!

documentation

"

    I implement the variable list (below class list) in the new system browser

"

! !

!VariableList class methodsFor:'interface specs'!

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

     Tools::VariableList new openInterface:#windowSpec

     Tools::VariableList open

    "

    <resource: #canvas>

    ^ 

     #(FullSpec

        name: windowSpec

        window: 

       (WindowSpec

          label: 'VariableList'

          name: 'VariableList'

          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: selectedVariableEntries

              menu: menuHolder

              hasHorizontalScrollBar: true

              hasVerticalScrollBar: true

              miniScrollerHorizontal: true

              isMultiSelect: true

              valueChangeSelector: selectionChangedByClick

              useIndex: false

              sequenceList: variableList

              doubleClickChannel: doubleClickChannel

            )

           )

        )

      )

! !

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

        #classHolder

        #forceGeneratorTrigger

        #immediateUpdate

        #inGeneratorHolder

        #menuHolder

        #outGeneratorHolder

        #packageFilter

        #selectedVariables

        #selectionChangeCondition

        #updateTrigger

        #showClassVarsInVariableList

        #slaveMode

        #sortVariablesByName

      ).

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

! !

!VariableList methodsFor:'aspects'!

classHolder

    classHolder isNil ifTrue:[

	classHolder := #() asValue.

	classHolder addDependent:self

    ].

    ^ classHolder

!

classHolder:aValueHolder

    classHolder notNil ifTrue:[

        classHolder removeDependent:self

    ].

    classHolder := aValueHolder.

    classHolder notNil ifTrue:[

        classHolder isBehavior ifTrue:[self error:'should not happen'].

        classHolder addDependent:self

    ].

    "Modified: / 11-07-2011 / 17:04:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

defaultSlaveModeValue

    ^ false.

!

selectedVariableEntries

    <resource: #uiAspect>

    "automatically generated by UIPainter ..."

    "*** the code below creates a default model when invoked."

    "*** (which may not be the one you wanted)"

    "*** Please change as required and accept it in the browser."

    "*** (and replace this comment by something more useful ;-)"

    selectedVariableEntries isNil ifTrue:[

        selectedVariableEntries := #() asValue.

"/ if your app needs to be notified of changes, uncomment one of the lines below:

         selectedVariableEntries addDependent:self.

"/       selectedVariableEntries onChangeSend:#selectedVariableEntriesChanged to:self.

    ].

    ^ selectedVariableEntries.

    "Modified: / 12-04-2011 / 15:49:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

selectedVariables

    ^ self selectionHolder

!

selectedVariables:aValueHolder

    ^ self selectionHolder:aValueHolder

!

showClassVarsInVariableList

    showClassVars isNil ifTrue:[

	showClassVars := false asValue.

	showClassVars addDependent:self

    ].

    ^ showClassVars

!

showClassVarsInVariableList:aValueHolder

    showClassVars notNil ifTrue:[

	showClassVars removeDependent:self

    ].

    showClassVars := aValueHolder.

    showClassVars notNil ifTrue:[

	showClassVars addDependent:self

    ].

!

showingInheritedClassVars

    ^ false

    "/ ^ true

!

sortVariablesByName

    sortVariablesByName isNil ifTrue:[

	sortVariablesByName := false asValue.

	sortVariablesByName addDependent:self

    ].

    ^ sortVariablesByName

!

sortVariablesByName:aValueHolder

    "/ self assert:(aValueHolder value isBoolean).

    sortVariablesByName notNil ifTrue:[

        sortVariablesByName removeDependent:self

    ].

    sortVariablesByName := aValueHolder.

    sortVariablesByName notNil ifTrue:[

        sortVariablesByName addDependent:self

    ].

!

variableList

    variableList isNil ifTrue:[

	variableList := ValueHolder new

    ].

    ^ variableList

! !

!VariableList methodsFor:'change & update'!

delayedUpdate:something with:aParameter from:changedObject

    |selectedClasses changedClass anyChange|

    self inSlaveModeOrInvisible ifTrue:[self invalidateList. ^ self].

    changedObject == slaveMode ifTrue:[

        listValid ~~ true ifTrue:[

            self enqueueDelayedUpdateList

        ].

        "/ self invalidateList.

        ^  self

    ].

    changedObject == classHolder ifTrue:[

        self invalidateList.

        ^  self

    ].

    changedObject == showClassVars ifTrue:[

        self invalidateList.

        ^ self.

    ].

    changedObject == sortVariablesByName ifTrue:[

        self invalidateList.

        ^ self.

    ].

    changedObject == environment ifTrue:[

        (something == #projectOrganization) ifTrue:[^ self].

        (something == #currentChangeSet) ifTrue:[^ self].

        (something == #aboutToAutoloadClass) ifTrue:[^ self].

        (something == #classDefinition

        or:[ (something == #newClass)

        or:[ something == #classVariables and:[showClassVars value == true]]])

        ifTrue:[

            changedClass := aParameter.

            selectedClasses := classHolder value.

            selectedClasses notNil ifTrue:[

                selectedClasses isSequenceable ifFalse:[

                    selectedClasses := selectedClasses asOrderedCollection

                ].

                selectedClasses keysAndValuesDo:[:idx :cls | |nm|

                    cls notNil ifTrue:[

                        cls isObsolete ifTrue:[

                            cls isMeta ifTrue:[

                                nm := cls theNonMetaclass name.

                                selectedClasses at:idx put:(environment at:nm) class.

                            ] ifFalse:[

                                nm := cls name.

                                selectedClasses at:idx put:(environment at:nm).

                            ].

                            anyChange := true.

                        ] ifFalse:[

                            (cls == aParameter 

                            or:[something == #classVariables 

                                and:[showClassVars value == true

                                and:[cls theNonMetaclass == aParameter theNonMetaclass]]]) ifTrue:[

                                anyChange := true.

                            ]

                        ]

                    ]

                ].

                (selectedClasses includes:nil) ifTrue:[

                    "/ can happen, if a selected class is removed...

                    "/ self halt:'should this happen ?'.

                    "/ fix it ...

                    selectedClasses := selectedClasses select:[:each | each notNil].

                    classHolder value:selectedClasses.

                    anyChange := true.

                ].

                anyChange == true ifTrue:[

                    self invalidateList.

                    ^  self

                ].

            ].

            ^  self

        ].

    ] ifFalse:[

        changedObject isBehavior ifTrue:[

            anyChange := false.

            selectedClasses := classHolder value.

            selectedClasses notNil ifTrue:[

                selectedClasses keysAndValuesDo:[:idx :cls | |nm|

                    cls isObsolete ifTrue:[

                        nm := cls name.

                        selectedClasses at:idx put:(environment at:nm).

                        anyChange := true.

                    ]

                ].

                anyChange == true ifTrue:[

                    self invalidateList.

                    ^  self

                ].

                (selectedClasses includesIdentical:something) ifTrue:[    

                    self invalidateList.

                    ^  self

                ].

            ].

            ^  self

        ].

    ].

    super delayedUpdate:something with:aParameter from:changedObject

    "Modified: / 01-03-2012 / 09:18:11 / cg"

!

enqueueDelayedUpdateList

    super enqueueDelayedUpdateList

!

makeDependent

    environment addDependent:self

!

makeIndependent

    environment removeDependent:self

!

selectionChangedByClick

    "we are not interested in that - get another notification

     via the changed valueHolder"

!

update:something with:aParameter from:changedObject

    "/ ^ self delayedUpdate:something with:aParameter from:changedObject.

    changedObject == environment ifTrue:[

        something == #methodDictionary ifTrue:[

            ^ self 

        ].

        something == #methodTrap ifTrue:[

            ^ self

        ].

        something == #methodCoverageInfo ifTrue:[

            ^ self

        ].

        something == #methodInClass ifTrue:[

            ^ self

        ].

        something == #methodInClassRemoved ifTrue:[

            ^ self

        ].

        something == #classComment ifTrue:[

            ^ self.

        ].

        something == #lastTestRunResult ifTrue:[

            ^ self

        ].

        something isNil ifTrue:[

            ^ self

        ].

    ].

"/    self window sensor isNil ifTrue:[

"/        "/ I am not visible ...

"/        self invalidateList.

"/        ^ self

"/    ].

    changedObject == selectedVariableEntries ifTrue:[

        self selectedVariables value:

            ((selectedVariableEntries value ? #())

                select:[:e| e isString not]         "filter out class name header strings"

                thenCollect:[:e|e name]).

        ^self.

    ].

    super update:something with:aParameter from:changedObject

    "Modified: / 12-04-2011 / 15:54:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 20-07-2011 / 18:52:44 / cg"

! !

!VariableList methodsFor:'generators'!

makeGenerator

! !

!VariableList methodsFor:'private'!

commonPostBuild

    |list|

    super commonPostBuild.

    list := builder componentAt:#List.

    list notNil ifTrue:[

        list selectConditionBlock:[:item | self selectionChangeAllowed:item].

        list ignoreReselect:false.

    ].

!

commonSubClassIn:classes

    "return true if there is a common subclass"

    |theCommonSubClass "classesByInheritance"|

    theCommonSubClass := nil.

    classes do:[:eachClass |

	theCommonSubClass isNil ifTrue:[

	    theCommonSubClass := eachClass

	] ifFalse:[

	    (eachClass isSubclassOf:theCommonSubClass) ifTrue:[

		theCommonSubClass := eachClass    

	    ] ifFalse:[

		(theCommonSubClass isSubclassOf:eachClass) ifFalse:[

		    ^ nil

		]

	    ]

	]

    ].

    ^ theCommonSubClass.

"/    classesByInheritance := classes topologicalSort:[:a :b | a isSubclassOf:b].

"/    classesByInheritance keysAndValuesDo:[:index :eachClass |

"/        "/ all classes after that one must be superclasses ...

"/        classesByInheritance from:index+1 to:classesByInheritance size do:[:otherClass |

"/            (eachClass isSubclassOf:otherClass) ifFalse:[

"/                ^ nil.

"/            ]

"/        ].

"/    ].

"/    ^ classesByInheritance first

!

iconInBrowserForVariable:varName in:aClass

    "variables for which an entry is found in the xml-spec (if any) are marked

     with an <xml>-icon."

    (Expecco::ExpeccoXMLDecoder notNil 

    and:[aClass canUnderstand: #xmlSpecForObject:]) ifTrue:[

        Error handle:[:ex |

        ] do:[

            (Expecco::ExpeccoXMLDecoder xmlSpecForObject:aClass basicNew)

                do:[:spec | spec getter = varName ifTrue:[

                                ^ SystemBrowser instVarOverlayXmlSpec

                            ]

                ].

        ].

    ].

    ^ nil

    "Created: / 12-04-2011 / 19:58:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 15-07-2011 / 18:32:47 / cg"

    "Modified: / 22-06-2012 / 13:17:28 / sr"

!

listEntryForClass: cls name:name

  "  (showWarningAboutMissingEntryInXmlSpec not