14 	 instanceVariableNames:'myProject toggle'

    14 	instanceVariableNames:'myProject toggle'

    15 	 classVariableNames:'ActiveProjectView'

    15 	classVariableNames:'ActiveProjectView'

    16 	 poolDictionaries:''

    16 	poolDictionaries:''

    17 	 category:'Interface-Smalltalk'

    17 	category:'Interface-Smalltalk'

    41 	(I am not sure, if this is really a useful feature, now that we

    41         (I am not sure, if this is really a useful feature, now that we

    42 	 have modern windowManagers which have multiple desktops as well).

    42          have modern windowManagers which have multiple desktops as well).

    43 

    43 

    44 	All views as created while some project was active are remembered

    44         All views as created while a project is active are remembered

    45 	and can be hidden/shown altogether.

    45         and can be hidden/shown altogether.

    46 	(this has nothing to do with windowGroups)

    46         (this has nothing to do with windowGroups)

    47 

    47 

    48 	Also, it is possible to close down all those windows (by destroying the project).

    48         Also, it is possible to close down all those windows (by destroying the project).

    51 		- the fileOut directory (i.e. where the SystemBrowser creates fileOut sources)

    51                 - the fileOut directory (i.e. where the SystemBrowser creates fileOut sources)

    52 

    52 

    53 		- keep the source module/package

    53                 - keep the source module/package

    54 		    thats the default offered when classes are checkedIn the very first time

    54                     thats the default offered when classes are checkedIn the very first time

    55 

    55 

    56 		- keep a default package-identifier assigned when classes/methods are created/modified.

    56                 - keep a default package-identifier assigned when classes/methods are created/modified.

    57 		    thats mostly useful to browse all classes/methods that have been touched

    57                     thats mostly useful to browse all classes/methods that have been touched

    58 		    in a projects context

    58                     in a projects context

    59 

    59 

    60 		- keep a per-project changeList

    60                 - keep a per-project changeList

    61 

    62       - allow opening a browser on all classes/methods which were created or modified

    63         while a project was active.

    64 

    65       - allow opening a browser on this projects changeList (which contains the subset of changes

    66          which were done while this project was active)

    67 

    68       - allow removal of all classes/methods which have the current projects packageIdentifier

   109 	labels := #(

   117         labels := #(

   110 			'rename ...'

   118                         'rename ...'

   111 			'-'

   119                         '-'

   112 			'changes'

   120                         'changes'

   113 			'browse'

   121                         'browse'

   114 			'-'

   122                         '-'

   115 			'fileOut directory ...'

   123                         'fileOut directory ...'

   116 			'package name ...'

   124                         'package name ...'

   117 			'-'

   125                         '-'

   118 			'show'

   126                         'show'

   119 			'hide'

   127                         'hide'

   120 			'-'

   128                         '-'

   121 			'remove package classes/methods'

   129                         'remove package classes/methods'

   122 			'destroy'

   130                         'remove project'

   123 		   ).

   131                    ).

   124 

   132 

   125 	 selectors := #(        

   133          selectors := #(        

   126 			renameProject

   134                         renameProject

   127 			nil

   135                         nil

   128 			browseChanges

   136                         browseChanges

   129 			browsePackage

   137                         browsePackage

   130 			nil

   138                         nil

   131 			projectDirectory

   139                         projectDirectory

   132 			projectPackage

   140                         projectPackage

   133 			nil

   141                         nil

   134 			showProject

   142                         showProject

   135 			hideProject

   143                         hideProject

   136 			nil

   144                         nil

   137 			removePackage

   145                         removePackage

   138 			destroy

   146                         destroy

   139 		    )

   147                     )

   141 	labels := #(

   149         labels := #(

   142 			'rename ...'

   150                         'rename ...'

   143 			'-'

   151                         '-'

   144 			'changes'

   152                         'changes'

   145 			'browse'

   153                         'browse'

   146 			'-'

   154                         '-'

   147 			'fileOut directory ...'

   155                         'fileOut directory ...'

   148 			'repository module ...'

   156                         'repository module ...'

   149 			'repository directory ...'

   157                         'repository directory ...'

   150 			'package name ...'

   158                         'package name ...'

   154 			'-'

   162                         '-'

   155 			'show'

   163                         'show'

   156 			'hide'

   164                         'hide'

   157 			'-'

   165                         '-'

   158 			'remove package code'

   166                         'remove package code'

   159 			'destroy'

   167                         'remove project'

   160 		   ).

   168                    ).

   161 

   169 

   162 	 selectors := #(        

   170          selectors := #(        

   163 			renameProject

   171                         renameProject

   164 			nil

   172                         nil

   165 			browseChanges

   173                         browseChanges

   166 			browsePackage

   174                         browsePackage

   167 			nil

   175                         nil

   168 			projectDirectory

   176                         projectDirectory

   169 			projectModule

   177                         projectModule

   170 			projectRepository

   178                         projectRepository

   171 			projectPackage

   179                         projectPackage

   175 			nil

   183                         nil

   176 			showProject

   184                         showProject

   177 			hideProject

   185                         hideProject

   178 			nil

   186                         nil

   179 			removePackage

   187                         removePackage

   180 			destroy

   188                         destroy

   181 		    )

   189                     )

   185 	PopUpMenu

   193         PopUpMenu

   186 		labels:labels

   194                 labels:(resources array:labels)

   187 		selectors:selectors

   195                 selectors:selectors

   188 		receiver:self

   196                 receiver:self

   192     "Modified: 10.12.1995 / 00:05:41 / cg"

   200     "Modified: 12.12.1995 / 16:48:31 / cg"

   201     b label:'Changes in ' , myProject name

   209     b label:(resources string:'Changes in %1' with:myProject name)

   205     "launch browsers for all classes/methods which are defined in this package"

   213     "launch browsers for all classes/methods which are defined in this package

   214      (i.e. whose packageIdentifier is the same as my Projects packageIdentifier)"

   208 	|classes packageName methods methodList|

   217         |classes packageName methods methodList anyClasses anyMethods ignoredClasses|

   209 

   218 

   210 	packageName := myProject packageName.

   219         anyMethods := anyClasses := false.

   211 	classes := myProject classes.

   220 

   212 	(classes notNil and:[classes notEmpty]) ifTrue:[

   221         packageName := myProject packageName.

   213 	    SystemBrowser browseClasses:classes

   222         classes := myProject classes.

   214 				  title:'classes in package ' , packageName.

   223         (classes notNil and:[classes notEmpty]) ifTrue:[

   215 

   224             anyClasses := true.

   216 	    classes := classes asIdentitySet.

   225         ].

   217 	    classes addAll:(classes collect:[:c | c class]).

   226 

   218 	] ifFalse:[

   227         methods := myProject individualMethods.

   219 	    classes := #()

   228         methods notEmpty ifTrue:[

   220 	].

   229             anyMethods := true.

   221 "/        SystemBrowser browseMethodsWhere:[:cls :mthd :sel |

   230             SystemBrowser browseMethods:methods

   222 "/                                    mthd package = packageName

   231                                   title:(resources string:'individual methods in package %1' with:packageName).

   223 "/                                    and:[(classes includes:cls) not]

   232         ].

   224 "/                                  ] 

   233         anyClasses ifTrue:[

   225 "/                            title:'individual methods in package ' , packageName.

   234             SystemBrowser browseClasses:classes

   226 

   235                                   title:(resources string:'classes in package %1' with:packageName).

   227 	methods := myProject individualMethods.

   236         ].

   228 	methodList := methods collect:[:m | 

   237         (anyClasses or:[anyMethods]) ifFalse:[

   229 					|who|

   238             self information:(resources string:'no classes or methods in this project (yet)')

   230 

   239         ]

   231 					who := m who.

   232 					(who at:1) name , ' ' , (who at:2)

   233 				      ].

   234 	methodList notEmpty ifTrue:[

   235 	    SystemBrowser browseMethods:methodList

   236 				  title:'individual methods in package ' , packageName.

   237 	]

   263 	|box|

   266         |box|

   264 

   267 

   265 	box := YesNoBox new.

   268         box := YesNoBox new.

   266 	box title:'Destroying a project will discard all changes made

   269         box title:(resources string:'PROJECT_DESTROY') withCRs.

   267 for that project and destroy all views opened for it.

   270         box okText:(resources string:'yes').

   268 

   271         (box confirm) ifFalse:[^ self]

   269 Do you really want to do this ?'.

   270 	box okText:'yes'.

   271 	(box confirm) ifFalse:[^ self]

   275 !

   275 

   276 

   276     "Modified: 12.12.1995 / 16:44:54 / cg"

   277 destroyProject

   278     |box|

   279 

   280     box := YesNoBox new.

   281     box title:'Destroying a project will discard all changes made

   282 for that project and destroy all views opened for it.

   283 

   284 Do you really want to do this ?'.

   285     box okText:'yes'.

   286     box yesAction:[

   287 	self doDestroyProject

   288     ].

   289     box showAtPointer

   310     box title:(resources string:'Directory of project (fileOuts will go there):').

   297     box title:(resources string:'PROJECT_DIRECTPORY') withCRs.

   312 	box initialText:d

   299         box initialText:d

   315 	(OperatingSystem isDirectory:dirName) ifFalse:[

   302         (OperatingSystem isDirectory:dirName) ifFalse:[

   316 	    (OperatingSystem isValidPath:dirName) ifTrue:[

   303             (OperatingSystem isValidPath:dirName) ifTrue:[

   317 		self warn:(resources string:'%1 is not a valid directory' with:dirName).

   304                 self warn:(resources string:'%1 is not a valid directory' with:dirName).

   318 		^ self

   305                 ^ self

   319 	    ].

   306             ].

   320 	    (self confirm:(resources string:'%1 does not exist\\create ?' with:dirName) withCRs) ifTrue:[

   307             (self confirm:(resources string:'%1 does not exist\\create ?' with:dirName) withCRs) ifTrue:[

   321 		(OperatingSystem recursiveCreateDirectory:dirName) ifFalse:[

   308                 (OperatingSystem recursiveCreateDirectory:dirName) ifFalse:[

   322 		    self warn:(resources string:'cannot create %1' with:dirName)

   309                     self warn:(resources string:'cannot create %1' with:dirName)

   323 		]

   310                 ]

   324 	    ].

   311             ].

   325 	].

   312         ].

   326 	"did it work ?"

   313         "did it work ?"

   327 	(OperatingSystem isDirectory:dirName) ifTrue:[

   314         (OperatingSystem isDirectory:dirName) ifTrue:[

   328 	    myProject directory:dirName

   315             myProject directory:dirName

   329 	].

   316         ].

   339     box title:(resources string:'Module in repository (new source containers / packages will go there):').

   326     box title:(resources string:'PROJECT_MODULEDIR') withCRs.

   341 	box initialText:d

   328         box initialText:d

   344 	myProject repositoryModule:dirName

   331         myProject repositoryModule:dirName

   354 	|box p existingPackages allClasses|

   341         |box p existingPackages allClasses|

   355 

   342 

   356 	existingPackages := Set new.

   343         existingPackages := Set new.

   357 	(allClasses := Smalltalk allClasses) do:[:aClass |

   344         (allClasses := Smalltalk allClasses) do:[:aClass |

   358 	    |p|

   345             |p|

   359 

   346 

   360 	    (p := aClass package) notNil ifTrue:[

   347             (p := aClass package) notNil ifTrue:[

   361 		existingPackages add:(p asString)

   348                 existingPackages add:(p asString)

   362 	    ].

   349             ].

   363 	    aClass methodArray do:[:aMethod |

   350             aClass methodArray do:[:aMethod |

   364 		(p := aMethod package) notNil ifTrue:[

   351                 (p := aMethod package) notNil ifTrue:[

   365 		    existingPackages add:(p asString)

   352                     existingPackages add:(p asString)

   366 		]

   353                 ]

   367 	    ].

   354             ].

   368 	    aClass class methodArray do:[:aMethod |

   355             aClass class methodArray do:[:aMethod |

   369 		(p := aMethod package) notNil ifTrue:[

   356                 (p := aMethod package) notNil ifTrue:[

   370 		    existingPackages add:(p asString)

   357                     existingPackages add:(p asString)

   371 		]

   358                 ]

   372 	    ].

   359             ].

   373 	].

   360         ].

   374 

   361 

   375 	box := ListSelectionBox title:'Package (new classes/methods will be put into that):'.

   362         box := ListSelectionBox title:(resources string:'PROJECT_PACKAGENAME') withCRs.

   376 	box list:(existingPackages asOrderedCollection sort).

   363         box list:(existingPackages asOrderedCollection sort).

   377 	(p := myProject packageName) notNil ifTrue:[

   364         (p := myProject packageName) notNil ifTrue:[

   378 	    box initialText:p

   365             box initialText:p

   379 	].

   366         ].

   380 	box action:[:packageName |

   367         box action:[:packageName |

   381 	    |someClass module directory|

   368             |someClass module directory|

   382 

   369 

   383 	    "/ (try) to extract the module & repository directory from someClass which

   370             "/ (try) to extract the module & repository directory from someClass which

   384 	    "/ is already contained in that package

   371             "/ is already contained in that package

   385 

   372 

   386 	    Smalltalk allClasses 

   373             Smalltalk allClasses 

   387 		detect:[:cls | 

   374                 detect:[:cls | 

   388 				|info|

   375                                 |info|

   389 

   376 

   390 				(cls package = packageName) ifTrue:[

   377                                 (cls package = packageName) ifTrue:[

   391 				    (info := cls packageSourceCodeInfo) notNil ifTrue:[

   378                                     (info := cls packageSourceCodeInfo) notNil ifTrue:[

   392 					module := info at:#module ifAbsent:nil.

   379                                         module := info at:#module ifAbsent:nil.

   393 					directory := info at:#directory ifAbsent:nil.

   380                                         directory := info at:#directory ifAbsent:nil.

   394 				    ]

   381                                     ]

   395 				].

   382                                 ].

   396 				module notNil and:[directory notNil].

   383                                 module notNil and:[directory notNil].

   397 			]

   384                         ]

   398 		ifNone:nil.

   385                 ifNone:nil.

   399 

   386 

   400 	    module notNil ifTrue:[

   387             module notNil ifTrue:[

   401 		myProject repositoryModule:module

   388                 myProject repositoryModule:module

   402 	    ].

   389             ].

   403 	    directory notNil ifTrue:[

   390             directory notNil ifTrue:[

   404 		myProject repositoryDirectory:directory

   391                 myProject repositoryDirectory:directory

   405 	    ].

   392             ].

   406 	    myProject packageName:packageName.

   393             myProject packageName:packageName.

   407 

   394 

   408 	].

   395         ].

   409 	box showAtPointer

   396         box showAtPointer

   421     box title:(resources string:'Relative path of package in repository (new source containers will go there):').

   408     box title:(resources string:'PROJECT_PACKAGEDIR') withCRs.

   423 	box initialText:d

   410         box initialText:d

   426 	myProject repositoryDirectory:dirName

   413         myProject repositoryDirectory:dirName

   445 	self warn:'No current package'.

   432         self warn:(resources string:'No current package.').

   446 	^ self

   433         ^ self

   453 	|p|

   440         |p|

   454 

   441 

   455 	(p := aClass package) notNil ifTrue:[

   442         (p := aClass package) notNil ifTrue:[

   456 	    p = theProject  ifTrue:[

   443             p = theProject  ifTrue:[

   457 		classesToRemove add:aClass

   444                 classesToRemove add:aClass

   458 	    ]

   445             ]

   459 	].

   446         ].

   462 	|p|

   449         |p|

   463 

   450 

   464 	(classesToRemove includes:aClass) ifFalse:[

   451         (classesToRemove includes:aClass) ifFalse:[

   465 	    aClass methodArray do:[:aMethod |

   452             aClass methodArray do:[:aMethod |

   466 		(p := aMethod package) notNil ifTrue:[

   453                 (p := aMethod package) notNil ifTrue:[

   467 		    p = theProject  ifTrue:[

   454                     p = theProject  ifTrue:[

   468 			methodsToRemove add:aMethod

   455                         methodsToRemove add:aMethod

   469 		    ]

   456                     ]

   470 		]

   457                 ]

   471 	    ].

   458             ].

   472 	    aClass class methodArray do:[:aMethod |

   459             aClass class methodArray do:[:aMethod |

   473 		(p := aMethod package) notNil ifTrue:[

   460                 (p := aMethod package) notNil ifTrue:[

   474 		    p = theProject  ifTrue:[

   461                     p = theProject  ifTrue:[

   475 			methodsToRemove add:aMethod

   462                         methodsToRemove add:aMethod

   476 		    ]

   463                     ]

   477 		]

   464                 ]

   478 	    ].

   465             ].

   479 	].

   466         ].

   484 	self warn:('Nothing found in ' , theProject).

   471         self warn:(resources string:'No classes or methods found in %1' with:theProject).

   485 	^ self

   472         ^ self

   486     ].

   473     ].

   487 

   474 

   488     (self confirm:('About to remove '

   475     (self confirm:(resources

   489 		 , classesToRemove size printString

   476                         string:'About to remove %1 classes and %2 additional methods.\\Are you certain you want this ?'

   490 		 , ' classes and '

   477                         with:classesToRemove size printString

   491 		 , methodsToRemove size printString

   478                         with:methodsToRemove size printString) withCRs)

   492 		 , ' additional methods.\\Are you certain you want this ?') withCRs)

   479         ifTrue:[

   493 	ifTrue:[

   480             classesToRemove do:[:aClass |

   494 	    classesToRemove do:[:aClass |

   481                 ('PROJECT: removing ' , aClass name) infoPrintNL.

   495 		('PROJECT: removing ' , aClass name) infoPrintNL.

   482                 Smalltalk removeClass:aClass.   

   496 		Smalltalk removeClass:aClass.   

   483             ].

   497 	    ].

   484             methodsToRemove do:[:aMethod |

   498 	    methodsToRemove do:[:aMethod |

   485                 |where|

   499 		|where|

   486 

   500 

   487                 ('PROJECT: removing ' , aMethod displayString) infoPrintNL.

   501 		('PROJECT: removing ' , aMethod displayString) infoPrintNL.

   488                 where := aMethod who.

   502 		where := aMethod who.

   489                 where isNil ifTrue:[

   503 		where isNil ifTrue:[

   490                     'PROJECT: oops, some method is gone' infoPrintNL.

   504 		    'PROJECT: oops, some method is gone' infoPrintNL.

   491                 ] ifFalse:[

   505 		] ifFalse:[

   492                     (where at:1) removeSelector:(where at:2)

   506 		    (where at:1) removeSelector:(where at:2)

   493                 ]

   507 		]

   494             ]

   508 	    ]

   516     box title:'new name of project:'.

   502     box title:(resources string:'new name of project:').

   517     box okText:'rename'.

   503     box okText:(resources string:'rename').

   520 	myProject name:newName.

   506         myProject name:newName.

   521 	self setProject:myProject.

   507         self setProject:myProject.

   522 	self windowGroup process name:'Project: ' , newName.

   508         self windowGroup process name:'Project: ' , newName.

   577 ^ '$Header: /cvs/stx/stx/libtool/ProjectView.st,v 1.24 1995-12-12 12:23:08 cg Exp $'! !

   565 ^ '$Header: /cvs/stx/stx/libtool/ProjectView.st,v 1.25 1995-12-12 15:53:46 cg Exp $'! !