Tools_NamespaceList.st
author Claus Gittinger <cg@exept.de>
Thu, 26 Feb 2004 20:03:55 +0100
changeset 5592 d9730a8d7c52
parent 5591 273637686948
child 6675 ac1c07785aa2
permissions -rw-r--r--
*** empty log message ***

"
 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:#NamespaceList
	instanceVariableNames:'namespaceNameList namespaceList'
	classVariableNames:''
	poolDictionaries:''
	category:'Interface-Browsers-New'
!

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

!NamespaceList class methodsFor:'interface specs'!

singleNameSpaceWindowSpec
    "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:ClassCategoryList andSelector:#singleCategoryWindowSpec
     ClassCategoryList new openInterface:#singleCategoryWindowSpec
    "

    <resource: #canvas>

    ^ 
     #(#FullSpec
	#name: #singleNameSpaceWindowSpec
	#window: 
       #(#WindowSpec
	  #label: 'NameSpaceList'
	  #name: 'NameSpaceList'
	  #min: #(#Point 0 0)
	  #max: #(#Point 1024 721)
	  #bounds: #(#Rectangle 218 175 518 475)
	)
	#component: 
       #(#SpecCollection
	  #collection: #(
	   #(#LabelSpec
	      #label: 'NameSpaceName'
	      #name: 'NameSpaceLabel'
	      #layout: #(#LayoutFrame 0 0.0 0 0 0 1.0 25 0)
	      #translateLabel: true
	      #labelChannel: #nameSpaceLabelHolder
	      #menu: #menuHolder
	    )
	   )

	)
      )
!

singleNamespaceWindowSpec
    "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:ClassCategoryList andSelector:#singleCategoryWindowSpec
     ClassCategoryList new openInterface:#singleCategoryWindowSpec
    "

    <resource: #canvas>

    ^ 
     #(#FullSpec
	#name: #singleNamespaceWindowSpec
	#window: 
       #(#WindowSpec
	  #label: 'NamespaceList'
	  #name: 'NamespaceList'
	  #min: #(#Point 0 0)
	  #max: #(#Point 1024 721)
	  #bounds: #(#Rectangle 218 175 518 475)
	)
	#component: 
       #(#SpecCollection
	  #collection: #(
	   #(#LabelSpec
	      #label: 'NamespaceName'
	      #name: 'NamespaceLabel'
	      #layout: #(#LayoutFrame 0 0.0 0 0 0 1.0 25 0)
	      #translateLabel: true
	      #labelChannel: #nameSpaceLabelHolder
	      #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:ProjectList andSelector:#windowSpec
     ProjectList new openInterface:#windowSpec
     ProjectList open
    "

    <resource: #canvas>

    ^ 
     #(#FullSpec
	#name: #windowSpec
	#window: 
       #(#WindowSpec
	  #label: 'NamespaceList'
	  #name: 'NamespaceList'
	  #min: #(#Point 0 0)
	  #max: #(#Point 1024 721)
	  #bounds: #(#Rectangle 13 23 313 323)
	)
	#component: 
       #(#SpecCollection
	  #collection: #(
	   #(#SequenceViewSpec
	      #name: 'List'
	      #layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
	      #tabable: true
	      #model: #selectedNamespaces
	      #menu: #menuHolder
	      #hasHorizontalScrollBar: true
	      #hasVerticalScrollBar: true
	      #miniScrollerHorizontal: true
	      #isMultiSelect: true
	      #valueChangeSelector: #selectionChangedByClick
	      #useIndex: false
	      #sequenceList: #nameSpaceList
	      #doubleClickChannel: #doubleClickChannel
	    )
	   )

	)
      )

    "Created: / 18.2.2000 / 01:06:05 / cg"
    "Modified: / 18.2.2000 / 01:24:50 / cg"
! !

!NamespaceList class methodsFor:'queries-plugin'!

aspectSelectors
    ^ #( 
	#(#doubleClickChannel #action )
	immediateUpdate 
	selectedNamespaces 
	menuHolder 
	inGeneratorHolder 
	outGeneratorHolder 
	selectionChangeCondition 
	updateTrigger
	forceGeneratorTrigger
	hideUnloadedClasses
	organizerMode
	slaveMode
       )

    "Created: / 18.2.2000 / 01:06:27 / cg"
    "Modified: / 25.2.2000 / 22:32:20 / cg"
! !

!NamespaceList methodsFor:'aspects'!

nameSpaceLabelHolder
    ^ self pseudoListLabelHolder
!

nameSpaceList
    namespaceList isNil ifTrue:[
	namespaceList := ValueHolder new
    ].
    ^ namespaceList

    "Created: / 18.2.2000 / 00:59:01 / cg"
!

selectedNamespaces
    ^ self selectionHolder

!

selectedNamespaces:aValueHolder
    ^ self selectionHolder:aValueHolder

! !

!NamespaceList methodsFor:'change & update'!

delayedUpdate:something with:aParameter from:changedObject

    self inSlaveModeOrInvisible 
    ifTrue:[
	changedObject == Smalltalk ifTrue:[
	    something == #classComment ifTrue:[^ self].
	].
	self invalidateList.
	^ self
    ].

    changedObject == slaveMode ifTrue:[
	listValid ~~ true ifTrue:[
	    self enqueueDelayedUpdateList
	].
	"/ self invalidateList.
	^  self
    ].

    changedObject == Smalltalk ifTrue:[
	something == #newClass ifTrue:[
	    listValid == true ifTrue:[
		aParameter isNameSpace ifTrue:[
		    (namespaceList value includes:aParameter name) ifFalse:[
			self invalidateList.
		    ]
		].
	    ].
	    ^ self
	].
	something == #classRemove ifTrue:[
	    listValid == true ifTrue:[
		aParameter isNameSpace ifTrue:[
		    self invalidateList.
		].
	    ].
	    ^ self
	].
	^ self
    ].

    super delayedUpdate:something with:aParameter from:changedObject

    "Created: / 18.2.2000 / 01:00:07 / cg"
    "Modified: / 26.2.2000 / 01:10:46 / cg"
!

selectionChangedByClick
    "we are not interested in that - get another notification
     via the changed valueHolder"

    "Created: / 18.2.2000 / 01:00:14 / cg"
!

update:something with:aParameter from:changedObject
    changedObject == Smalltalk ifTrue:[
	something == #methodDictionary ifTrue:[
	    ^ self 
	].
	something == #methodTrap ifTrue:[
	    ^ self
	].
	something == #methodInClass ifTrue:[
	    ^ self
	].
	something == #classVariables ifTrue:[
	    ^ self
	].
	something == #classComment ifTrue:[
	    ^ self.
	].
	something == #methodInClassRemoved ifTrue:[
	    ^ self.
	].
    ].
    super update:something with:aParameter from:changedObject
! !

!NamespaceList methodsFor:'generators'!

makeGenerator
    "return a generator which enumerates the classes from the selected namespace(s)."

    |spaceNames hideUnloadedClasses|

    spaceNames := self selectedNamespaces value.
    spaceNames size == 0 ifTrue:[
	^ #()
    ].

    hideUnloadedClasses := self hideUnloadedClasses value.

    (spaceNames includes:(self class nameListEntryForALL)) ifTrue:[
	hideUnloadedClasses ifTrue:[
	    ^ Iterator on:[:whatToDo |
			       Smalltalk allClassesDo:[:cls |
				   cls isLoaded ifTrue:[
				       cls isNameSpace ifFalse:[
					   whatToDo value:cls
				       ]
				   ]
			       ]
			  ]
	].
	^ Iterator on:[:whatToDo |
			   Smalltalk allClassesDo:whatToDo
		      ]
    ].

    (spaceNames size == 1 
     and:[spaceNames first = 'Smalltalk']) ifTrue:[
	"/ somewhat tuned - quick look if classes name
	"/ includes colons ...
	^ Iterator on:[:whatToDo |
		       Smalltalk allClassesDo:[:cls |
			   |includeIt|

			   includeIt := (cls name includes:$:) not.
			   includeIt := includeIt
					or:[(cls isPrivate not 
					    and:[(cls nameSpace == Smalltalk)])].
			   includeIt := includeIt
					or:[(cls isPrivate  
					    and:[(cls topOwningClass nameSpace == Smalltalk)])].

			   includeIt := includeIt
					and:[hideUnloadedClasses not
					      or:[cls isLoaded]].
			   includeIt ifTrue:[
			       cls isNameSpace ifFalse:[
				   whatToDo value:cls
			       ]
			   ]
		       ]
		      ]
    ].

    ^ Iterator on:[:whatToDo |
		       Smalltalk allClassesDo:[:cls |
			   |spaceOfClass spaceNameOfClass includeIt|

			   spaceOfClass := cls isPrivate ifTrue:[cls topOwningClass nameSpace] ifFalse:[cls nameSpace].
			   spaceNameOfClass := spaceOfClass name.

			   includeIt := spaceNames contains:[:nm | nm = spaceNameOfClass
								   or:[spaceNameOfClass startsWith:(nm , '::')]].

			   hideUnloadedClasses ifTrue:[
			       includeIt := includeIt and:[cls isLoaded].
			   ].
			   includeIt ifTrue:[
			       cls isNameSpace ifFalse:[
				   whatToDo value:cls
			       ]
			   ]
		       ]
		  ]

    "Created: / 18.2.2000 / 01:01:58 / cg"
    "Modified: / 24.2.2000 / 13:42:58 / cg"
! !

!NamespaceList methodsFor:'private'!

defaultSlaveModeValue
    self topApplication initialOrganizerMode == #namespace ifTrue:[^ false].
"/    self organizerMode value == #category ifTrue:[^ true].
"/    ^ false
    ^ true
!

initialOrganizerMode
    ^ #namespace
!

listOfNamespaces
    |allNamespaces showAllNamespaces generator|

showAllNamespaces := false.
    allNamespaces := IdentitySet new.

    inGeneratorHolder isNil ifTrue:[
	(self hideUnloadedClasses value) ifTrue:[
	    Smalltalk allClassesDo:[:eachClass |
		eachClass isLoaded ifTrue:[
		    allNamespaces add:(eachClass theNonMetaclass topNameSpace)
		].
	    ]
	] ifFalse:[
	    allNamespaces := NameSpace allNamespaces.
	].

	showAllNamespaces ifFalse:[
	    "/ only topLevel namespaces are shown
	    "/ i.e. ignore subspaces 

	    allNamespaces := allNamespaces select:[:ns | ns isTopLevelNameSpace].
	].
	allNamespaces := allNamespaces collect:[:ns | ns name].
    ] ifFalse:[
	generator := inGeneratorHolder value.
	generator isNil ifTrue:[^ #() ].
	generator do:[:ns | allNamespaces add:ns].
    ].

    allNamespaces := allNamespaces asOrderedCollection.
    allNamespaces sort.
    allNamespaces size == 1 ifTrue:[
	self nameSpaceLabelHolder value:(LabelAndIcon icon:(self class nameSpaceIcon) string:allNamespaces first).
    ].
    allNamespaces addFirst:(self class nameListEntryForALL).
    ^ allNamespaces

    "Created: / 18.2.2000 / 01:04:27 / cg"
    "Modified: / 25.2.2000 / 22:11:29 / cg"
!

makeDependent
    Smalltalk addDependent:self

    "Created: / 18.2.2000 / 01:04:36 / cg"
!

makeIndependent
    Smalltalk removeDependent:self.

    "Created: / 18.2.2000 / 01:04:42 / cg"
!

updateList
    |newList oldSelection newSelection selectedNamespacesHolder|

    selectedNamespacesHolder := self selectedNamespaces.
    oldSelection := selectedNamespacesHolder value.
    newList := self listOfNamespaces.
    newList ~= namespaceList value ifTrue:[
"/        oldSelection size > 0 ifTrue:[
"/            selectedNamespacesHolder removeDependent:self.
"/            selectedNamespacesHolder value:#().
"/            selectedNamespacesHolder addDependent:self.
"/        ].
	self nameSpaceList value:newList.

	oldSelection size > 0 ifTrue:[
	    newSelection := oldSelection select:[:nm | 
				(nm = self class nameListEntryForALL) 
				or:[ (Smalltalk at:nm asSymbol) isNameSpace]
			    ].
	    newSelection ~= oldSelection ifTrue:[
		selectedNamespacesHolder value:newSelection.
	    ]
	]
    ].
    listValid := true.
! !

!NamespaceList class methodsFor:'documentation'!

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