"
 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'
	classVariableNames:''
	poolDictionaries:''
	category:'Interface-Browsers-New'
!

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

!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:VariableList andSelector:#windowSpec
     VariableList new openInterface:#windowSpec
     VariableList open
    "

    <resource: #canvas>

    ^ 
     #(#FullSpec
	#name: #windowSpec
	#window: 
       #(#WindowSpec
	  #label: 'VariableList'
	  #name: 'VariableList'
	  #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: #selectedVariables
	      #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)."

    ^ #(
	#(#doubleClickChannel #action )
	#classHolder
	#forceGeneratorTrigger
	#immediateUpdate
	#inGeneratorHolder
	#menuHolder
	#outGeneratorHolder
	#packageFilter
	#selectedVariables
	#selectionChangeCondition
	#updateTrigger
	#showClassVarsInVariableList
	#slaveMode
	#sortVariablesBy
      ).
! !

!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 halt:'should not happen'].
	classHolder addDependent:self
    ].
!

defaultSlaveModeValue
    ^ false.
!

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
    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].
    "/ slaveMode value == true ifTrue:[^ 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 == Smalltalk ifTrue:[
	(something == #classDefinition
	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:(Smalltalk at:nm) class.
			    ] ifFalse:[
				nm := cls name.
				selectedClasses at:idx put:(Smalltalk 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:(Smalltalk 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
!

makeDependent
    Smalltalk addDependent:self

!

makeIndependent
    Smalltalk 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 == Smalltalk ifTrue:[
	something == #methodDictionary ifTrue:[
	    ^ self 
	].
	something == #methodTrap ifTrue:[
	    ^ self
	].
	something == #methodInClass ifTrue:[
	    ^ self
	].
	something == #methodInClassRemoved ifTrue:[
	    ^ self
	].
	something == #classComment ifTrue:[
	    ^ self.
	].
    ].
"/    self window sensor isNil ifTrue:[
"/        "/ I am not visible ...
"/        self invalidateList.
"/        ^ self
"/    ].
    super update:something with:aParameter from:changedObject

    "Modified: / 20.11.2001 / 21:55:22 / cg"
! !

!VariableList methodsFor:'generators'!

makeGenerator



! !

!VariableList methodsFor:'private'!

commonPostBuildWith:aBuilder
    |list|

    super commonPostBuildWith:aBuilder.

    list := aBuilder 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
!

listOfVariables
    |nameList numClasses classes class commonSubclass showingClassVars
     sortByName|

    classHolder isNil ifTrue:[
	"/ testing
	^ #()
    ].

    showingClassVars := showClassVars value == true.
    sortByName := sortVariablesByName value.

    classes := classHolder value.
    (numClasses := classes size) == 0 ifTrue:[^ #() ].
    numClasses > 1 ifTrue:[
	"/ multiple classes - see if there is a common subclass ...
	commonSubclass := self commonSubClassIn:classes.
	commonSubclass notNil ifTrue:[
	    "/ yes - treat like a single class
	    classes := Array with:(commonSubclass).
	    numClasses := 1.
	].
    ].

    numClasses > 1 ifTrue:[
	"/ multiple classes - sort alphabetically ...
	"/ unless there is a common subclass ...
	nameList := Set new.
	classes do:[:class |
	    showingClassVars ifTrue:[
		self showingInheritedClassVars ifTrue:[
		    class theNonMetaclass withAllSuperclassesDo:[:cls|
			nameList addAll:(cls classVarNames)
		    ]
		] ifFalse:[
		    nameList addAll:(class classVarNames)
		]
	    ] ifFalse:[
		class withAllSuperclassesDo:[:cls|
		    nameList addAll:(cls instVarNames)
		]
	    ]
	].
	nameList := nameList asOrderedCollection.
    ] ifFalse:[
	"/ only a single class - sort by inheritance
	class := classes first.

	nameList := OrderedCollection new.
	class notNil ifTrue:[
	    showingClassVars ifTrue:[
		class := class theNonMetaclass 
	    ].
	    class withAllSuperclassesDo:[:cls| 
		|varNames|

		varNames := showingClassVars ifTrue:[ cls classVarNames ] ifFalse:[ cls instVarNames ].
		varNames copy reverse do:[:varName|
			nameList addFirst:varName.
		].
		sortByName ifFalse:[
		    nameList addFirst:'----- ' , cls nameInBrowser , ' -----'.
		]
	    ].
	].
    ].

    (numClasses > 1 or:[sortByName]) ifTrue:[
	nameList sort.
    ].
    ^ nameList

    "Created: / 5.2.2000 / 13:42:11 / cg"
    "Modified: / 26.2.2000 / 01:05:36 / cg"
!

postBuildWith:aBuilder
    |listView|

    (listView := aBuilder componentAt:#List) notNil ifTrue:[
	listView scrollWhenUpdating:#end
    ].
    super postBuildWith:aBuilder

!

release
    super release.

    classHolder removeDependent:self.
    showClassVars removeDependent:self.
!

selectionChangeAllowed:index
    ^ ((variableList value at:index) startsWith:'---') not.
!

updateList
    | prevSelection newSelection newList oldList selectedVariablesHolder|

    oldList := self variableList value copy.
    newList := self listOfVariables.

    newList ~= variableList value ifTrue:[
	selectedVariablesHolder := self selectedVariables.
	prevSelection := (selectedVariablesHolder value copy) ? #().
	variableList value:newList.

	newSelection := prevSelection select:[:item | newList includes:item].

	newSelection size > 0 ifTrue:[
	    "/ force change (for dependents)
	    selectedVariablesHolder value:nil.
	    selectedVariablesHolder value:newSelection.
	] ifFalse:[
	    prevSelection := selectedVariablesHolder value.
	    selectedVariablesHolder value:nil.
	].
	(prevSelection size > 0 or:[newSelection size > 0]) ifTrue:[
	    self updateOutputGenerator.
	].
    ].
    listValid := true.
! !

!VariableList class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libtool/Attic/Tools_VariableList.st,v 1.2 2004-02-26 19:03:55 cg Exp $'
! !