--- a/Tools_ProjectList.st Mon Aug 21 12:20:39 2006 +0200
+++ b/Tools_ProjectList.st Mon Aug 21 12:21:32 2006 +0200
@@ -15,7 +15,7 @@
"{ NameSpace: Tools }"
BrowserList subclass:#ProjectList
- instanceVariableNames:'projectList'
+ instanceVariableNames:'projectList projectNameList selectionIndexHolder'
classVariableNames:'AdditionalEmptyProjects'
poolDictionaries:''
category:'Interface-Browsers-New'
@@ -114,15 +114,15 @@
#name: 'List'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#tabable: true
- #model: #selectedProjects
+ #model: #selectionIndexHolder
#menu: #menuHolder
#hasHorizontalScrollBar: true
#hasVerticalScrollBar: true
#miniScrollerHorizontal: true
#isMultiSelect: true
#valueChangeSelector: #selectionChangedByClick
- #useIndex: false
- #sequenceList: #projectList
+ #useIndex: true
+ #sequenceList: #projectNameList
#doubleClickChannel: #doubleClickChannel
#properties:
#(#PropertyListDictionary
@@ -179,6 +179,16 @@
"Created: / 17.2.2000 / 23:39:32 / cg"
!
+projectNameList
+ projectNameList isNil ifTrue:[
+ projectNameList := ValueHolder new.
+ "/ projectNameList addDependent:self.
+ ].
+ ^ projectNameList
+
+ "Created: / 17.2.2000 / 23:39:32 / cg"
+!
+
selectedProjects
^ self selectionHolder
@@ -187,73 +197,108 @@
selectedProjects:aValueHolder
^ self selectionHolder:aValueHolder
+!
+
+selectionIndexHolder
+ selectionIndexHolder isNil ifTrue:[
+ selectionIndexHolder := 0 asValue.
+ selectionIndexHolder addDependent:self.
+ ].
+ ^ selectionIndexHolder
+
+ "Created: / 17.2.2000 / 23:39:32 / cg"
! !
!ProjectList methodsFor:'change & update'!
delayedUpdate:something with:aParameter from:changedObject
- |cls sel pkg mthd|
+ |cls sel pkg mthd newSel|
self inSlaveModeOrInvisible
"/ (self slaveMode value == true)
ifTrue:[
- changedObject == Smalltalk ifTrue:[ listValid := false].
- something == #projectOrganization ifTrue:[ listValid := false].
- ^ self
+ (changedObject == Smalltalk
+ or:[ something == #projectOrganization ]) ifTrue:[
+ listValid := false
+ ].
+ ^ self
+ ].
+
+ changedObject == self selectionIndexHolder ifTrue:[
+ listValid ifFalse:[
+ self updateList.
+ ].
+ newSel := changedObject value collect:[:idx | projectList value at:idx].
+ newSel ~= self selectedProjects value ifTrue:[
+ self selectedProjects value:newSel.
+ ].
+ ^ self.
+ ].
+ changedObject == self selectionHolder ifTrue:[
+ listValid == true ifFalse:[
+ self updateList.
+ ].
+ newSel := changedObject value collect:[:val | projectList value indexOf:val].
+ newSel ~= self selectionIndexHolder value ifTrue:[
+ self selectionIndexHolder value:newSel
+ ].
].
changedObject == slaveMode ifTrue:[
- listValid ~~ true ifTrue:[
- self enqueueDelayedUpdateList
- ].
- "/ self invalidateList.
- ^ self
+ listValid ~~ true ifTrue:[
+ self enqueueDelayedUpdateList
+ ].
+ "/ self invalidateList.
+ ^ self
].
+ changedObject == self projectList ifTrue:[
+ ^ self
+ ].
changedObject == Smalltalk ifTrue:[
- something == #projectOrganization ifTrue:[
- self invalidateList.
- self enqueueDelayedUpdateOutputGenerator.
- ^ self.
- ].
- something == #methodInClass ifTrue:[
- listValid == true ifTrue:[
- cls := aParameter at:1.
- sel := aParameter at:2.
- mthd := cls compiledMethodAt:sel.
- mthd notNil ifTrue:[
- pkg := mthd package.
- (projectList value includes:pkg) ifFalse:[
- self invalidateList.
- ]
- ].
- ].
- ^ self
- ].
+ something == #projectOrganization ifTrue:[
+ self invalidateList.
+ self enqueueDelayedUpdateOutputGenerator.
+ ^ self.
+ ].
+ something == #methodInClass ifTrue:[
+ listValid == true ifTrue:[
+ cls := aParameter at:1.
+ sel := aParameter at:2.
+ mthd := cls compiledMethodAt:sel.
+ mthd notNil ifTrue:[
+ pkg := mthd package.
+ (projectList value includes:pkg) ifFalse:[
+ self invalidateList.
+ ]
+ ].
+ ].
+ ^ self
+ ].
- (something == #classDefinition
- or:[something == #newClass]) ifTrue:[
- listValid == true ifTrue:[
- cls := aParameter.
- pkg := cls package.
- (projectList value includes:pkg) ifFalse:[
- self invalidateList.
- ] ifTrue:[
- self enqueueDelayedUpdateOutputGenerator
- ].
- ] ifFalse:[
- self invalidateList
- ].
- ^ self
- ].
- (something == #classRemove) ifTrue:[
- listValid == true ifTrue:[
- cls := aParameter.
- pkg := cls package.
- ].
- ].
- ^ self
+ (something == #classDefinition
+ or:[something == #newClass]) ifTrue:[
+ listValid == true ifTrue:[
+ cls := aParameter.
+ pkg := cls package.
+ (projectList value includes:pkg) ifFalse:[
+ self invalidateList.
+ ] ifTrue:[
+ self enqueueDelayedUpdateOutputGenerator
+ ].
+ ] ifFalse:[
+ self invalidateList
+ ].
+ ^ self
+ ].
+ (something == #classRemove) ifTrue:[
+ listValid == true ifTrue:[
+ cls := aParameter.
+ pkg := cls package.
+ ].
+ ].
+ ^ self
].
"/ something == #projectOrganization ifTrue:[
@@ -268,8 +313,8 @@
(organizerMode notNil
and:[organizerMode value ~~ #project]) ifTrue:[
- self invalidateList.
- ^ self
+ self invalidateList.
+ ^ self
].
super delayedUpdate:something with:aParameter from:changedObject
@@ -286,24 +331,24 @@
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.
- ].
+ 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
! !
@@ -471,21 +516,8 @@
!ProjectList methodsFor:'private'!
-defaultSlaveModeValue
- |mode|
-
- mode := self topApplication perform:#initialOrganizerMode ifNotUnderstood:nil.
- mode == OrganizerCanvas organizerModeProject ifTrue:[^ false].
- mode isNil ifTrue:[^ false].
- ^ true
-!
-
-initialOrganizerMode
- ^ OrganizerCanvas organizerModeProject
-!
-
-listOfProjects
- |allProjects generator indent prevC|
+allShownProjects
+ |allProjects generator|
allProjects := IdentitySet new.
@@ -499,7 +531,7 @@
cls isPrivate ifTrue:[
cls := cls topOwningClass
].
- pkg := cls package.
+ pkg := cls package ? '__NoProject__'.
pkg withoutSeparators size > 0 ifTrue:[
allProjects add:pkg asSymbol.
] ifFalse:[
@@ -531,8 +563,27 @@
generator := inGeneratorHolder value.
generator isNil ifTrue:[^ #() ].
generator do:[:prj | allProjects add:prj].
- allProjects := allProjects asOrderedCollection.
].
+ ^ allProjects asOrderedCollection.
+!
+
+defaultSlaveModeValue
+ |mode|
+
+ mode := self topApplication perform:#initialOrganizerMode ifNotUnderstood:nil.
+ mode == OrganizerCanvas organizerModeProject ifTrue:[^ false].
+ mode isNil ifTrue:[^ false].
+ ^ true
+!
+
+initialOrganizerMode
+ ^ OrganizerCanvas organizerModeProject
+!
+
+listOfProjects
+ |allProjects|
+
+ allProjects := self allShownProjects.
allProjects sort.
allProjects size == 1 ifTrue:[
@@ -580,6 +631,60 @@
Smalltalk removeDependent:self.
!
+nameListFor:aProjectList
+ "
+ self basicNew
+ nnameListFor:#(
+ 'bosch:dapasx'
+ 'bosch:dapasx/a'
+ 'bosch:dapasx/b'
+ 'bosch:dapasx/b/1'
+ 'bosch:dapasx/b/2'
+ 'bosch:dapasx/c/1'
+ 'bosch:dapasx/c/2'
+ 'bosch:dapasy/d/1'
+ 'bosch:dapasy/d/2'
+ )
+ "
+
+ |stack|
+
+ stack := OrderedCollection new.
+
+ ^ aProjectList collect:[:this |
+ |thisC entry rawEntry prefix indent|
+
+ thisC := this asCollectionOfSubstringsSeparatedByAny:':/'.
+
+ [
+ |stackTop|
+
+ stack notEmpty
+ and:[
+ stackTop := stack last.
+ (thisC startsWith:stackTop) ifFalse:[
+ stack removeLast.
+ true
+ ] ifTrue:[
+ false
+ ]]
+ ] whileTrue.
+ prefix := stack notEmpty ifTrue:[ stack last ] ifFalse:[ #() ].
+ indent := stack size * 4.
+ stack addLast:thisC.
+ prefix isEmpty ifTrue:[
+ rawEntry := thisC first , ':' , ((thisC copyFrom:2) asStringWith:$/).
+ ] ifFalse:[
+ rawEntry := (thisC copyFrom:prefix size+1) asStringWith:$/.
+ ].
+ entry := (String new:indent) , rawEntry.
+ entry.
+ ].
+
+ "Created: / 17-02-2000 / 23:43:05 / cg"
+ "Modified: / 17-08-2006 / 15:08:42 / cg"
+!
+
release
super release.
@@ -587,24 +692,30 @@
!
updateList
- |newList oldSelection newSelection selectedProjectsHolder|
+ |newList oldList newNameList oldNameList oldSelection newSelection selectedProjectsHolder|
selectedProjectsHolder := self selectedProjects.
oldSelection := selectedProjectsHolder value.
newList := self listOfProjects.
- newList ~= projectList value ifTrue:[
+ oldList := projectList value.
+ newNameList := self nameListFor:newList.
+ oldNameList := self projectNameList value.
+ (newList ~= oldList
+ or:[ newNameList ~= oldNameList]) ifTrue:[
"/ oldSelection size > 0 ifTrue:[
"/ selectedProjectsHolder removeDependent:self.
"/ selectedProjectsHolder value:#().
"/ selectedProjectsHolder addDependent:self.
"/ ].
- self projectList value:newList.
+ self projectList value:newList.
+ listValid := true.
+ self projectNameList value:newNameList.
- oldSelection size > 0 ifTrue:[
- newSelection := oldSelection select:[:prj | newList includes:prj].
- selectedProjectsHolder value:newSelection.
- ]
+ oldSelection size > 0 ifTrue:[
+ newSelection := oldSelection select:[:prj | newList includes:prj].
+ selectedProjectsHolder value:newSelection.
+ ]
].
listValid := true.
@@ -614,10 +725,10 @@
!ProjectList methodsFor:'special'!
addAdditionalProject:aProject
- "/ those are simulated - in ST/X, empty categories do not
+ "/ those are simulated - in ST/X, empty projects do not
"/ really exist; however, during browsing, it makes sense.
AdditionalEmptyProjects isNil ifTrue:[
- AdditionalEmptyProjects := Set new.
+ AdditionalEmptyProjects := Set new.
].
AdditionalEmptyProjects add:aProject.
@@ -642,5 +753,5 @@
!ProjectList class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/Tools_ProjectList.st,v 1.10 2006-08-17 14:09:47 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_ProjectList.st,v 1.11 2006-08-21 10:21:32 cg Exp $'
! !