--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/Tools__NamespaceList.st Wed Nov 19 22:41:20 2014 +0100
@@ -0,0 +1,568 @@
+"
+ 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.
+"
+!
+
+documentation
+"
+ I implement the namespace list in the new system browser
+"
+! !
+
+!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
+ )
+ )
+
+ )
+ )
+!
+
+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)
+ #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
+ #properties:
+ #(#PropertyListDictionary
+ #dragArgument: nil
+ #dropArgument: nil
+ #canDropSelector: #canDropContext:
+ #dropSelector: #doDropContext:
+ )
+ )
+ )
+
+ )
+ )
+
+ "Created: / 18.2.2000 / 01:06:05 / cg"
+ "Modified: / 18.2.2000 / 01:24:50 / cg"
+! !
+
+!NamespaceList class methodsFor:'queries-plugin'!
+
+aspectSelectors
+ ^ #(
+ environmentHolder
+ #(#doubleClickChannel #action )
+ immediateUpdate
+ selectedNamespaces
+ menuHolder
+ inGeneratorHolder
+ outGeneratorHolder
+ selectionChangeCondition
+ updateTrigger
+ forceGeneratorTrigger
+ hideUnloadedClasses
+ showAllClassesInNameSpaceOrganisation
+ organizerMode
+ slaveMode
+ )
+
+ "Created: / 18-02-2000 / 01:06:27 / cg"
+ "Modified: / 05-03-2007 / 16:47:45 / cg"
+ "Modified: / 24-02-2014 / 10:37:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!NamespaceList methodsFor:'aspects'!
+
+itemList
+ ^ self nameSpaceList value
+!
+
+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 == environment ifTrue:[
+ something == #classComment ifTrue:[^ self].
+ ].
+ self invalidateList.
+ ^ self
+ ].
+
+ changedObject == slaveMode ifTrue:[
+ listValid ~~ true ifTrue:[
+ self enqueueDelayedUpdateList
+ ].
+ "/ self invalidateList.
+ ^ self
+ ].
+
+ changedObject == environment 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 == environment ifTrue:[
+ something == #methodDictionary ifTrue:[
+ ^ self
+ ].
+ something == #methodTrap ifTrue:[
+ ^ self
+ ].
+ something == #methodCoverageInfo 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
+
+ "Modified: / 20-07-2011 / 18:55:12 / cg"
+! !
+
+!NamespaceList methodsFor:'drag & drop'!
+
+canDropContext:aDropContext
+ |objects nameSpace|
+
+ objects := aDropContext dropObjects collect:[:obj | obj theObject].
+ (objects conform:[:aMethodOrClass | aMethodOrClass isClass ]) ifFalse:[^ false].
+
+ nameSpace := self nameSpaceAtTargetPointOf:aDropContext.
+ nameSpace isNil ifTrue:[^ false].
+ nameSpace = self class nameListEntryForALL ifTrue:[^ false].
+
+ ^ (objects contains:[:aClass | aClass nameSpace name ~= nameSpace])
+!
+
+doDropContext:aDropContext
+ |nameSpaceName nameSpace objects|
+
+ objects := aDropContext dropObjects collect:[:aDropObject | aDropObject theObject].
+ (objects conform:[:something | something isClass]) ifTrue:[
+ nameSpaceName := self nameSpaceAtTargetPointOf:aDropContext.
+ (nameSpaceName notNil
+ and:[ nameSpaceName ~= self class nameListEntryForALL]) ifTrue:[
+ nameSpace := NameSpace name:nameSpaceName.
+ objects do:[:eachClassToMove |
+ |className|
+
+ className := eachClassToMove nameWithoutPrefix.
+ nameSpace == environment ifTrue:[
+ environment renameClass:eachClassToMove to:className asSymbol.
+ ] ifFalse:[
+ environment renameClass:eachClassToMove to:(nameSpace name , '::' , className) asSymbol.
+ nameSpace changed.
+ ].
+ ].
+ environment changed.
+ ].
+ ^ self
+ ].
+!
+
+nameSpaceAtTargetPointOf:aDropContext
+ |p targetView lineNr item|
+
+ p := aDropContext targetPoint.
+
+ targetView := aDropContext targetWidget.
+
+ lineNr := targetView yVisibleToLineNr:p y.
+ lineNr isNil ifTrue:[^ nil].
+
+ item := self itemList at:lineNr.
+ item isNil ifTrue:[^ nil].
+
+ ^ item
+! !
+
+!NamespaceList methodsFor:'generators'!
+
+makeGenerator
+ "return a generator which enumerates the classes from the selected namespace(s)."
+
+ |spaceNames hideUnloadedClasses showAllClasses showChangedClasses|
+
+ spaceNames := self selectedNamespaces value.
+ spaceNames size == 0 ifTrue:[
+ ^ #()
+ ].
+
+ hideUnloadedClasses := self hideUnloadedClasses value.
+ showAllClasses := self showAllClassesInNameSpaceOrganisation value.
+ showChangedClasses := spaceNames includes:(self class nameListEntryForChanged).
+
+ (showAllClasses or:[spaceNames includes:(self class nameListEntryForALL)]) ifTrue:[
+ hideUnloadedClasses ifTrue:[
+ ^ Iterator on:[:whatToDo |
+ environment allClassesDo:[:cls |
+ cls isLoaded ifTrue:[
+ cls isRealNameSpace ifFalse:[
+ whatToDo value:cls
+ ]
+ ]
+ ]
+ ]
+ ].
+ ^ Iterator on:[:whatToDo |
+ environment allClassesDo:whatToDo
+ ]
+ ].
+
+ (spaceNames size == 1
+ and:[spaceNames first = 'environment']) ifTrue:[
+ "/ somewhat tuned - quick look if classes name includes colons ...
+ ^ Iterator on:[:whatToDo |
+ environment allClassesDo:[:cls |
+ |includeIt|
+
+ includeIt := (cls name includes:$:) not.
+ includeIt := includeIt
+ or:[(cls isPrivate not
+ and:[(cls nameSpace == environment)])].
+ includeIt := includeIt
+ or:[(cls isPrivate
+ and:[(cls topOwningClass nameSpace == environment)])].
+
+ includeIt := includeIt
+ and:[hideUnloadedClasses not or:[cls isLoaded]].
+
+ includeIt := includeIt
+ or:[ cls extensions
+ contains:[:mthd |
+ |sel parts|
+ sel := mthd selector.
+ (sel isNameSpaceSelector
+ and:[ parts := sel nameSpaceSelectorParts.
+ spaceNames includes:parts first])
+ ]
+ ].
+
+ includeIt ifTrue:[
+ cls isRealNameSpace ifFalse:[
+ whatToDo value:cls
+ ]
+ ]
+ ]
+ ]
+ ].
+
+ ^ Iterator on:[:whatToDo |
+ |changedClasses|
+
+ showChangedClasses ifTrue:[ changedClasses := ChangeSet current changedClasses collect:[:cls | cls theNonMetaclass]].
+
+ environment 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 , '::')]].
+ includeIt ifFalse:[
+ (showChangedClasses and:[ (changedClasses includes:cls theNonMetaclass) ]) ifTrue:[
+ includeIt := true
+ ].
+ ].
+ hideUnloadedClasses ifTrue:[
+ includeIt := includeIt and:[cls isLoaded].
+ ].
+ includeIt ifTrue:[
+ cls isRealNameSpace ifFalse:[
+ whatToDo value:cls
+ ]
+ ]
+ ]
+ ]
+
+ "Created: / 18-02-2000 / 01:01:58 / cg"
+ "Modified: / 05-03-2007 / 23:01:21 / cg"
+! !
+
+!NamespaceList methodsFor:'private'!
+
+defaultSlaveModeValue
+ |mode|
+
+ mode := self topApplication perform:#initialOrganizerMode ifNotUnderstood:nil.
+ mode == OrganizerCanvas organizerModeNamespace ifTrue:[^ false].
+"/ self organizerMode value == OrganizerCanvas organizerModeCategory ifTrue:[^ true].
+"/ ^ false
+ mode isNil ifTrue:[^ false].
+ ^ true
+!
+
+initialOrganizerMode
+ ^ OrganizerCanvas organizerModeNamespace
+!
+
+listOfNamespaces
+ |allNamespaces showAllNamespaces generator|
+
+ showAllNamespaces := false. "/ only topLevel namespaces are shown
+ showAllNamespaces := true.
+
+ allNamespaces := IdentitySet new.
+
+ inGeneratorHolder isNil ifTrue:[
+ (self hideUnloadedClasses value) ifTrue:[
+ environment 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].
+ ].
+ "/JV@2011-12-04: Do not show java packages, they are all shown
+ "/when JAVA namespace is shown. Use #askFor: here, as eXept's libbasic
+ "/does not have #isJavaPackage
+ allNamespaces := allNamespaces reject:[:ns | ns askFor: #isJavaPackage ].
+
+ 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).
+ ].
+
+"/ for now: disabled, because it gets replicated into the nameSpace filter, which
+"/ does not (yet) handle it correctly
+"/ numClassesInChangeSet := ChangeSet current changedClasses size.
+"/ numClassesInChangeSet > 0 ifTrue:[
+"/ "/ dont include count - makeGenerator compares against the un-expanded nameListEntry (sigh - need two lists)
+"/ allNamespaces addFirst:((self class nameListEntryForChanged "bindWith:numClassesInChangeSet") allItalic).
+"/ ].
+
+ allNamespaces addFirst:(self class nameListEntryForALL allItalic).
+ ^ allNamespaces
+
+ "Created: / 18-02-2000 / 01:04:27 / cg"
+ "Modified: / 25-02-2000 / 22:11:29 / cg"
+ "Modified: / 04-12-2011 / 12:30:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+makeDependent
+ environment addDependent:self
+
+ "Created: / 18.2.2000 / 01:04:36 / cg"
+!
+
+makeIndependent
+ environment 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:[ (environment at:nm asSymbol) isNameSpace]
+ ].
+ newSelection ~= oldSelection ifTrue:[
+ selectedNamespacesHolder value:newSelection.
+ ]
+ ]
+ ].
+ self setListValid:true.
+! !
+
+!NamespaceList class methodsFor:'documentation'!
+
+version_CVS
+ ^ '$Header: /cvs/stx/stx/libtool/Tools__NamespaceList.st,v 1.23 2014-11-19 21:41:20 cg Exp $'
+! !
+