Tools_ProjectList.st
changeset 6923 ac5a126a3107
parent 6907 494f26b3bb45
child 6930 abe5e981e9d1
equal deleted inserted replaced
6922:31056869a2f4 6923:ac5a126a3107
    13 "{ Package: 'stx:libtool' }"
    13 "{ Package: 'stx:libtool' }"
    14 
    14 
    15 "{ NameSpace: Tools }"
    15 "{ NameSpace: Tools }"
    16 
    16 
    17 BrowserList subclass:#ProjectList
    17 BrowserList subclass:#ProjectList
    18 	instanceVariableNames:'projectList'
    18 	instanceVariableNames:'projectList projectNameList selectionIndexHolder'
    19 	classVariableNames:'AdditionalEmptyProjects'
    19 	classVariableNames:'AdditionalEmptyProjects'
    20 	poolDictionaries:''
    20 	poolDictionaries:''
    21 	category:'Interface-Browsers-New'
    21 	category:'Interface-Browsers-New'
    22 !
    22 !
    23 
    23 
   112           #collection: #(
   112           #collection: #(
   113            #(#SequenceViewSpec
   113            #(#SequenceViewSpec
   114               #name: 'List'
   114               #name: 'List'
   115               #layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
   115               #layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
   116               #tabable: true
   116               #tabable: true
   117               #model: #selectedProjects
   117               #model: #selectionIndexHolder
   118               #menu: #menuHolder
   118               #menu: #menuHolder
   119               #hasHorizontalScrollBar: true
   119               #hasHorizontalScrollBar: true
   120               #hasVerticalScrollBar: true
   120               #hasVerticalScrollBar: true
   121               #miniScrollerHorizontal: true
   121               #miniScrollerHorizontal: true
   122               #isMultiSelect: true
   122               #isMultiSelect: true
   123               #valueChangeSelector: #selectionChangedByClick
   123               #valueChangeSelector: #selectionChangedByClick
   124               #useIndex: false
   124               #useIndex: true
   125               #sequenceList: #projectList
   125               #sequenceList: #projectNameList
   126               #doubleClickChannel: #doubleClickChannel
   126               #doubleClickChannel: #doubleClickChannel
   127               #properties: 
   127               #properties: 
   128              #(#PropertyListDictionary
   128              #(#PropertyListDictionary
   129                 #dragArgument: nil
   129                 #dragArgument: nil
   130                 #dropArgument: nil
   130                 #dropArgument: nil
   177     ^ projectList
   177     ^ projectList
   178 
   178 
   179     "Created: / 17.2.2000 / 23:39:32 / cg"
   179     "Created: / 17.2.2000 / 23:39:32 / cg"
   180 !
   180 !
   181 
   181 
       
   182 projectNameList
       
   183     projectNameList isNil ifTrue:[
       
   184         projectNameList := ValueHolder new.
       
   185         "/ projectNameList addDependent:self.
       
   186     ].
       
   187     ^ projectNameList
       
   188 
       
   189     "Created: / 17.2.2000 / 23:39:32 / cg"
       
   190 !
       
   191 
   182 selectedProjects
   192 selectedProjects
   183     ^ self selectionHolder
   193     ^ self selectionHolder
   184 
   194 
   185     "Created: / 17.2.2000 / 23:39:57 / cg"
   195     "Created: / 17.2.2000 / 23:39:57 / cg"
   186 !
   196 !
   187 
   197 
   188 selectedProjects:aValueHolder
   198 selectedProjects:aValueHolder
   189     ^ self selectionHolder:aValueHolder
   199     ^ self selectionHolder:aValueHolder
       
   200 !
       
   201 
       
   202 selectionIndexHolder
       
   203     selectionIndexHolder isNil ifTrue:[
       
   204         selectionIndexHolder := 0 asValue.
       
   205         selectionIndexHolder addDependent:self.
       
   206     ].
       
   207     ^ selectionIndexHolder
       
   208 
       
   209     "Created: / 17.2.2000 / 23:39:32 / cg"
   190 ! !
   210 ! !
   191 
   211 
   192 !ProjectList methodsFor:'change & update'!
   212 !ProjectList methodsFor:'change & update'!
   193 
   213 
   194 delayedUpdate:something with:aParameter from:changedObject
   214 delayedUpdate:something with:aParameter from:changedObject
   195     |cls sel pkg mthd|
   215     |cls sel pkg mthd newSel|
   196 
   216 
   197     self inSlaveModeOrInvisible 
   217     self inSlaveModeOrInvisible 
   198     "/ (self slaveMode value == true) 
   218     "/ (self slaveMode value == true) 
   199     ifTrue:[
   219     ifTrue:[
   200 	changedObject == Smalltalk ifTrue:[ listValid := false].
   220         (changedObject == Smalltalk
   201 	something == #projectOrganization ifTrue:[ listValid := false].
   221         or:[ something == #projectOrganization ]) ifTrue:[ 
   202 	^ self
   222             listValid := false
       
   223         ].
       
   224         ^ self
       
   225     ].
       
   226 
       
   227     changedObject == self selectionIndexHolder ifTrue:[
       
   228         listValid ifFalse:[
       
   229              self updateList.
       
   230         ].
       
   231         newSel := changedObject value collect:[:idx | projectList value at:idx].
       
   232         newSel ~= self selectedProjects value ifTrue:[
       
   233             self selectedProjects value:newSel.
       
   234         ].
       
   235         ^ self.
       
   236     ].
       
   237     changedObject == self selectionHolder ifTrue:[
       
   238         listValid == true ifFalse:[
       
   239              self updateList.
       
   240         ].
       
   241         newSel := changedObject value collect:[:val | projectList value indexOf:val].
       
   242         newSel ~= self selectionIndexHolder value ifTrue:[
       
   243             self selectionIndexHolder value:newSel
       
   244         ].
   203     ].
   245     ].
   204 
   246 
   205     changedObject == slaveMode ifTrue:[
   247     changedObject == slaveMode ifTrue:[
   206 	listValid ~~ true ifTrue:[
   248         listValid ~~ true ifTrue:[
   207 	    self enqueueDelayedUpdateList
   249             self enqueueDelayedUpdateList
   208 	].
   250         ].
   209 	"/ self invalidateList.
   251         "/ self invalidateList.
   210 	^  self
   252         ^  self
   211     ].
   253     ].
   212 
   254 
       
   255     changedObject == self projectList ifTrue:[
       
   256         ^  self
       
   257     ].
   213 
   258 
   214     changedObject == Smalltalk ifTrue:[
   259     changedObject == Smalltalk ifTrue:[
   215 	something == #projectOrganization ifTrue:[
   260         something == #projectOrganization ifTrue:[
   216 	    self invalidateList.
   261             self invalidateList.
   217 	    self enqueueDelayedUpdateOutputGenerator.
   262             self enqueueDelayedUpdateOutputGenerator.
   218 	    ^ self.
   263             ^ self.
   219 	].
   264         ].
   220 	something == #methodInClass ifTrue:[
   265         something == #methodInClass ifTrue:[
   221 	    listValid == true ifTrue:[
   266             listValid == true ifTrue:[
   222 		cls := aParameter at:1.
   267                 cls := aParameter at:1.
   223 		sel := aParameter at:2.
   268                 sel := aParameter at:2.
   224 		mthd := cls compiledMethodAt:sel.
   269                 mthd := cls compiledMethodAt:sel.
   225 		mthd notNil ifTrue:[
   270                 mthd notNil ifTrue:[
   226 		    pkg := mthd package.
   271                     pkg := mthd package.
   227 		    (projectList value includes:pkg) ifFalse:[
   272                     (projectList value includes:pkg) ifFalse:[
   228 			self invalidateList.
   273                         self invalidateList.
   229 		    ]
   274                     ]
   230 		].
   275                 ].
   231 	    ].
   276             ].
   232 	    ^ self
   277             ^ self
   233 	].
   278         ].
   234 
   279 
   235 	(something == #classDefinition
   280         (something == #classDefinition
   236 	or:[something == #newClass]) ifTrue:[
   281         or:[something == #newClass]) ifTrue:[
   237 	    listValid == true ifTrue:[
   282             listValid == true ifTrue:[
   238 		cls := aParameter.
   283                 cls := aParameter.
   239 		pkg := cls package.
   284                 pkg := cls package.
   240 		(projectList value includes:pkg) ifFalse:[
   285                 (projectList value includes:pkg) ifFalse:[
   241 		    self invalidateList.
   286                     self invalidateList.
   242 		] ifTrue:[
   287                 ] ifTrue:[
   243 		    self enqueueDelayedUpdateOutputGenerator
   288                     self enqueueDelayedUpdateOutputGenerator
   244 		].
   289                 ].
   245 	    ] ifFalse:[
   290             ] ifFalse:[
   246 		self invalidateList
   291                 self invalidateList
   247 	    ].
   292             ].
   248 	    ^ self
   293             ^ self
   249 	].
   294         ].
   250 	(something == #classRemove) ifTrue:[
   295         (something == #classRemove) ifTrue:[
   251 	    listValid == true ifTrue:[
   296             listValid == true ifTrue:[
   252 		cls := aParameter.
   297                 cls := aParameter.
   253 		pkg := cls package.
   298                 pkg := cls package.
   254 	    ].
   299             ].
   255 	].
   300         ].
   256 	^ self
   301         ^ self
   257     ].
   302     ].
   258 
   303 
   259 "/    something == #projectOrganization ifTrue:[
   304 "/    something == #projectOrganization ifTrue:[
   260 "/        aParameter isSymbol ifTrue:[
   305 "/        aParameter isSymbol ifTrue:[
   261 "/                    "/ a single method has changed
   306 "/                    "/ a single method has changed
   266 "/        ^ self
   311 "/        ^ self
   267 "/    ].
   312 "/    ].
   268 
   313 
   269     (organizerMode notNil
   314     (organizerMode notNil
   270     and:[organizerMode value ~~ #project]) ifTrue:[
   315     and:[organizerMode value ~~ #project]) ifTrue:[
   271 	self invalidateList.
   316         self invalidateList.
   272 	^ self
   317         ^ self
   273     ].
   318     ].
   274     super delayedUpdate:something with:aParameter from:changedObject
   319     super delayedUpdate:something with:aParameter from:changedObject
   275 
   320 
   276     "Created: / 17.2.2000 / 23:41:02 / cg"
   321     "Created: / 17.2.2000 / 23:41:02 / cg"
   277     "Modified: / 26.2.2000 / 01:21:49 / cg"
   322     "Modified: / 26.2.2000 / 01:21:49 / cg"
   284     "Created: / 17.2.2000 / 23:41:17 / cg"
   329     "Created: / 17.2.2000 / 23:41:17 / cg"
   285 !
   330 !
   286 
   331 
   287 update:something with:aParameter from:changedObject
   332 update:something with:aParameter from:changedObject
   288     changedObject == Smalltalk ifTrue:[
   333     changedObject == Smalltalk ifTrue:[
   289 	something == #methodDictionary ifTrue:[
   334         something == #methodDictionary ifTrue:[
   290 	    ^ self 
   335             ^ self 
   291 	].
   336         ].
   292 	something == #methodTrap ifTrue:[
   337         something == #methodTrap ifTrue:[
   293 	    ^ self
   338             ^ self
   294 	].
   339         ].
   295 	something == #methodInClass ifTrue:[
   340         something == #methodInClass ifTrue:[
   296 	    ^ self
   341             ^ self
   297 	].
   342         ].
   298 	something == #classVariables ifTrue:[
   343         something == #classVariables ifTrue:[
   299 	    ^ self
   344             ^ self
   300 	].
   345         ].
   301 	something == #classComment ifTrue:[
   346         something == #classComment ifTrue:[
   302 	    ^ self.
   347             ^ self.
   303 	].
   348         ].
   304 	something == #methodInClassRemoved ifTrue:[
   349         something == #methodInClassRemoved ifTrue:[
   305 	    ^ self.
   350             ^ self.
   306 	].
   351         ].
   307     ].
   352     ].
   308     super update:something with:aParameter from:changedObject
   353     super update:something with:aParameter from:changedObject
   309 ! !
   354 ! !
   310 
   355 
   311 !ProjectList methodsFor:'drag & drop'!
   356 !ProjectList methodsFor:'drag & drop'!
   469     "Modified: / 17-08-2006 / 15:08:32 / cg"
   514     "Modified: / 17-08-2006 / 15:08:32 / cg"
   470 ! !
   515 ! !
   471 
   516 
   472 !ProjectList methodsFor:'private'!
   517 !ProjectList methodsFor:'private'!
   473 
   518 
   474 defaultSlaveModeValue
   519 allShownProjects
   475     |mode|
   520     |allProjects generator|
   476 
       
   477     mode := self topApplication perform:#initialOrganizerMode ifNotUnderstood:nil.
       
   478     mode == OrganizerCanvas organizerModeProject ifTrue:[^ false].
       
   479     mode isNil ifTrue:[^ false].
       
   480     ^ true
       
   481 !
       
   482 
       
   483 initialOrganizerMode
       
   484     ^ OrganizerCanvas organizerModeProject
       
   485 !
       
   486 
       
   487 listOfProjects
       
   488     |allProjects generator indent prevC|
       
   489 
   521 
   490     allProjects := IdentitySet new.
   522     allProjects := IdentitySet new.
   491 
   523 
   492     inGeneratorHolder isNil ifTrue:[
   524     inGeneratorHolder isNil ifTrue:[
   493         (self hideUnloadedClasses value) ifTrue:[
   525         (self hideUnloadedClasses value) ifTrue:[
   497                 eachClass isLoaded ifTrue:[
   529                 eachClass isLoaded ifTrue:[
   498                     cls := eachClass theNonMetaclass.
   530                     cls := eachClass theNonMetaclass.
   499                     cls isPrivate ifTrue:[
   531                     cls isPrivate ifTrue:[
   500                         cls := cls topOwningClass
   532                         cls := cls topOwningClass
   501                     ].
   533                     ].
   502                     pkg := cls package.
   534                     pkg := cls package ? '__NoProject__'.
   503                     pkg withoutSeparators size > 0 ifTrue:[
   535                     pkg withoutSeparators size > 0 ifTrue:[
   504                         allProjects add:pkg asSymbol.
   536                         allProjects add:pkg asSymbol.
   505                     ] ifFalse:[
   537                     ] ifFalse:[
   506                         "/ for now, nameSpaces are not in any package;
   538                         "/ for now, nameSpaces are not in any package;
   507                         "/ this might change. Then, 0-sized packages are
   539                         "/ this might change. Then, 0-sized packages are
   529         ].
   561         ].
   530     ] ifFalse:[
   562     ] ifFalse:[
   531         generator := inGeneratorHolder value.
   563         generator := inGeneratorHolder value.
   532         generator isNil ifTrue:[^ #() ].
   564         generator isNil ifTrue:[^ #() ].
   533         generator do:[:prj | allProjects add:prj].
   565         generator do:[:prj | allProjects add:prj].
   534         allProjects := allProjects asOrderedCollection.
   566     ].
   535     ].
   567     ^ allProjects asOrderedCollection.
       
   568 !
       
   569 
       
   570 defaultSlaveModeValue
       
   571     |mode|
       
   572 
       
   573     mode := self topApplication perform:#initialOrganizerMode ifNotUnderstood:nil.
       
   574     mode == OrganizerCanvas organizerModeProject ifTrue:[^ false].
       
   575     mode isNil ifTrue:[^ false].
       
   576     ^ true
       
   577 !
       
   578 
       
   579 initialOrganizerMode
       
   580     ^ OrganizerCanvas organizerModeProject
       
   581 !
       
   582 
       
   583 listOfProjects
       
   584     |allProjects|
       
   585 
       
   586     allProjects := self allShownProjects.
   536 
   587 
   537     allProjects sort.
   588     allProjects sort.
   538     allProjects size == 1 ifTrue:[
   589     allProjects size == 1 ifTrue:[
   539         "/ self projectLabelHolder value:(allProjects first , ' [Project]').
   590         "/ self projectLabelHolder value:(allProjects first , ' [Project]').
   540         self projectLabelHolder value:(LabelAndIcon icon:(self class packageIcon) string:allProjects first).
   591         self projectLabelHolder value:(LabelAndIcon icon:(self class packageIcon) string:allProjects first).
   578 
   629 
   579 makeIndependent
   630 makeIndependent
   580     Smalltalk removeDependent:self.
   631     Smalltalk removeDependent:self.
   581 !
   632 !
   582 
   633 
       
   634 nameListFor:aProjectList
       
   635     "
       
   636      self basicNew
       
   637          nnameListFor:#(
       
   638             'bosch:dapasx'
       
   639             'bosch:dapasx/a'
       
   640             'bosch:dapasx/b'
       
   641             'bosch:dapasx/b/1'
       
   642             'bosch:dapasx/b/2'
       
   643             'bosch:dapasx/c/1'
       
   644             'bosch:dapasx/c/2'
       
   645             'bosch:dapasy/d/1'
       
   646             'bosch:dapasy/d/2'
       
   647         )
       
   648     "
       
   649 
       
   650     |stack|
       
   651 
       
   652     stack := OrderedCollection new.
       
   653 
       
   654     ^ aProjectList collect:[:this |
       
   655         |thisC entry rawEntry prefix indent|
       
   656 
       
   657         thisC := this asCollectionOfSubstringsSeparatedByAny:':/'.
       
   658 
       
   659         [
       
   660             |stackTop|
       
   661 
       
   662             stack notEmpty
       
   663             and:[
       
   664                 stackTop := stack last.
       
   665                 (thisC startsWith:stackTop) ifFalse:[
       
   666                     stack removeLast.
       
   667                     true
       
   668                 ] ifTrue:[
       
   669                     false
       
   670                 ]]
       
   671         ] whileTrue.
       
   672         prefix := stack notEmpty ifTrue:[ stack last ] ifFalse:[ #() ].
       
   673         indent := stack size * 4.
       
   674         stack addLast:thisC.
       
   675         prefix isEmpty ifTrue:[
       
   676             rawEntry := thisC first , ':' , ((thisC copyFrom:2) asStringWith:$/).
       
   677         ] ifFalse:[
       
   678             rawEntry := (thisC copyFrom:prefix size+1) asStringWith:$/.
       
   679         ].
       
   680         entry := (String new:indent) , rawEntry.
       
   681         entry.
       
   682     ].
       
   683 
       
   684     "Created: / 17-02-2000 / 23:43:05 / cg"
       
   685     "Modified: / 17-08-2006 / 15:08:42 / cg"
       
   686 !
       
   687 
   583 release
   688 release
   584     super release.
   689     super release.
   585 
   690 
   586     projectList removeDependent:self.
   691     projectList removeDependent:self.
   587 !
   692 !
   588 
   693 
   589 updateList
   694 updateList
   590     |newList oldSelection newSelection selectedProjectsHolder|
   695     |newList oldList newNameList oldNameList oldSelection newSelection selectedProjectsHolder|
   591 
   696 
   592     selectedProjectsHolder := self selectedProjects.
   697     selectedProjectsHolder := self selectedProjects.
   593     oldSelection := selectedProjectsHolder value.
   698     oldSelection := selectedProjectsHolder value.
   594     newList := self listOfProjects.
   699     newList := self listOfProjects.
   595     newList ~= projectList value ifTrue:[
   700     oldList := projectList value.
       
   701     newNameList := self nameListFor:newList.
       
   702     oldNameList := self projectNameList value.
       
   703     (newList ~= oldList
       
   704     or:[ newNameList ~= oldNameList]) ifTrue:[
   596 "/        oldSelection size > 0 ifTrue:[
   705 "/        oldSelection size > 0 ifTrue:[
   597 "/            selectedProjectsHolder removeDependent:self.
   706 "/            selectedProjectsHolder removeDependent:self.
   598 "/            selectedProjectsHolder value:#().
   707 "/            selectedProjectsHolder value:#().
   599 "/            selectedProjectsHolder addDependent:self.
   708 "/            selectedProjectsHolder addDependent:self.
   600 "/        ].
   709 "/        ].
   601 
   710 
   602 	self projectList value:newList.
   711         self projectList value:newList.
   603 
   712         listValid := true.
   604 	oldSelection size > 0 ifTrue:[
   713         self projectNameList value:newNameList.
   605 	    newSelection := oldSelection select:[:prj | newList includes:prj].
   714 
   606 	    selectedProjectsHolder value:newSelection.
   715         oldSelection size > 0 ifTrue:[
   607 	]
   716             newSelection := oldSelection select:[:prj | newList includes:prj].
       
   717             selectedProjectsHolder value:newSelection.
       
   718         ]
   608     ].
   719     ].
   609     listValid := true.
   720     listValid := true.
   610 
   721 
   611     "Modified: / 25.2.2000 / 23:10:01 / cg"
   722     "Modified: / 25.2.2000 / 23:10:01 / cg"
   612 ! !
   723 ! !
   613 
   724 
   614 !ProjectList methodsFor:'special'!
   725 !ProjectList methodsFor:'special'!
   615 
   726 
   616 addAdditionalProject:aProject
   727 addAdditionalProject:aProject
   617     "/ those are simulated - in ST/X, empty categories do not
   728     "/ those are simulated - in ST/X, empty projects do not
   618     "/ really exist; however, during browsing, it makes sense.
   729     "/ really exist; however, during browsing, it makes sense.
   619     AdditionalEmptyProjects isNil ifTrue:[
   730     AdditionalEmptyProjects isNil ifTrue:[
   620 	AdditionalEmptyProjects := Set new.
   731         AdditionalEmptyProjects := Set new.
   621     ].
   732     ].
   622     AdditionalEmptyProjects add:aProject.
   733     AdditionalEmptyProjects add:aProject.
   623 
   734 
   624     Smalltalk changed:#projectOrganization   "/ not really ... to force update
   735     Smalltalk changed:#projectOrganization   "/ not really ... to force update
   625 
   736 
   640 ! !
   751 ! !
   641 
   752 
   642 !ProjectList class methodsFor:'documentation'!
   753 !ProjectList class methodsFor:'documentation'!
   643 
   754 
   644 version
   755 version
   645     ^ '$Header: /cvs/stx/stx/libtool/Tools_ProjectList.st,v 1.10 2006-08-17 14:09:47 cg Exp $'
   756     ^ '$Header: /cvs/stx/stx/libtool/Tools_ProjectList.st,v 1.11 2006-08-21 10:21:32 cg Exp $'
   646 ! !
   757 ! !