"

 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 noAllItem packageFilterOnInput

		methodVisibilityHolder'

	classVariableNames:'AdditionalEmptyCategoriesPerClassName'

	poolDictionaries:''

	category:'Interface-Browsers-New'

!

!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:'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: #canDrop:

		#dropSelector: #doDrop:

	      )

	    )

	   )

	)

      )

! !

!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

	#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

!

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.

		    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.

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

		    self invalidateList.

		    "/ self updateOutputGenerator.

		    self slaveMode value == true ifFalse:[

			self enqueueDelayedUpdateOutputGenerator.

		    ]

		].

		^ self.

	    ].

	    something == #classOrganization ifTrue:[

		cls := aParameter.

		(classes includesIdentical:cls) ifTrue:[

		    self invalidateList.

		] ifFalse:[

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

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

		    ]

		].

		^ self.

	    ].

	    something == #projectOrganization ifTrue:[

		aParameter notNil ifTrue:[

		    cls := aParameter at:1.

		    cls notNil ifTrue:[

			((classes includes:cls theMetaclass)

			or:[(classes includes:cls theNonMetaclass)]) ifTrue:[

			    self invalidateList.

			    self slaveMode value == true ifFalse:[

				self enqueueDelayedUpdateOutputGenerator.

			    ]

			].

		    ].

		] ifFalse:[

		    self invalidateList.

		].

		^ self

	    ].

	    (something == #classDefinition or:[something == #classVariables])

	    ifTrue:[

		self classDefinitionChanged:aParameter.

		^ self

	    ].

	    "/ everything else is ignored    

	    "/ self halt.

	].

	^ self

    ].

    changedObject == self selectedProtocolIndices ifTrue:[

	oldSelectedProtocols := selectedProtocolsHolder value ? #().

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

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

	newSelectedProtocols := self getSelectedProtocolsFromIndices.

	oldSelectedProtocols ~= newSelectedProtocols ifTrue:[

	    selectedProtocolsHolder value:newSelectedProtocols.

	].

	newSelectedProtocols size > 1 ifTrue:[

	    (newSelectedProtocols includes:(self class nameListEntryForALL)) ifTrue:[

		rawProtocolList := rawProtocolListHolder value.

		idx := rawProtocolList indexOf: (newSelectedProtocols copy remove:(self class nameListEntryForALL); yourself) first.

		idx ~~ 0 ifTrue:[

		    (listView := self builder componentAt:#List) notNil ifTrue:[

			listView makeLineVisible:idx.

		    ]

		]

	    ]

	].

	^ self

    ].

    changedObject == selectedProtocolsHolder ifTrue:[

	rawProtocolList := rawProtocolListHolder value.

	rawProtocolList size == 0 ifTrue:[

	    self updateList.

	    rawProtocolList := rawProtocolListHolder value.

	].

	rawProtocolList notNil ifTrue:[

	    selectedCategories := selectedProtocolsHolder value ? #().

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