230 ^ wcroot |
222 ^ wcroot |
231 |
223 |
232 "Created: / 14-11-2012 / 23:51:05 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
224 "Created: / 14-11-2012 / 23:51:05 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
233 ! ! |
225 ! ! |
234 |
226 |
235 !SCMAbstractPackageModel methodsFor:'accessing - containers'! |
227 !SCMAbstractPackageModel methodsFor:'accessing-classes'! |
|
228 |
|
229 commitDialogClass |
|
230 self subclassResponsibility |
|
231 |
|
232 "Created: / 14-11-2012 / 22:29:10 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
233 ! |
|
234 |
|
235 commitTaskClass |
|
236 "raise an error: must be redefined in concrete subclass(es)" |
|
237 |
|
238 ^ self subclassResponsibility |
|
239 ! ! |
|
240 |
|
241 !SCMAbstractPackageModel methodsFor:'accessing-containers'! |
|
242 |
|
243 containerFilenameFor: containerName |
|
244 |
|
245 ^self temporaryWorkingCopyRoot / containerName |
|
246 |
|
247 "Created: / 09-10-2008 / 20:25:02 / Jan Vrany <vranyj1@fel.cvut.cz>" |
|
248 "Modified: / 01-12-2012 / 00:24:47 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
249 ! |
|
250 |
|
251 containerNameForClass:cls |
|
252 ^self |
|
253 containerNameForClassNamed: cls theNonMetaclass fullName |
|
254 language: cls programmingLanguage |
|
255 |
|
256 "Created: / 07-10-2012 / 10:36:46 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
257 "Modified: / 15-11-2012 / 00:46:24 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
258 ! |
|
259 |
|
260 containerNameForClassNamed: nm language: lang |
|
261 ^String streamContents:[:s| |
|
262 s nextPutAll: (nm copyReplaceAll:$: with: $_). |
|
263 s nextPut: $.. |
|
264 s nextPutAll: lang sourceFileSuffix |
|
265 ] |
|
266 |
|
267 "Created: / 15-11-2012 / 00:45:49 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
268 ! |
|
269 |
|
270 containerNameForExtensions |
|
271 ^self containerNameForExtensions: SmalltalkLanguage instance |
|
272 |
|
273 "Created: / 07-10-2012 / 10:37:33 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
274 ! |
|
275 |
|
276 containerNameForExtensions: aProgrammingLanguage |
|
277 ^'extensions.' , aProgrammingLanguage sourceFileSuffix |
|
278 |
|
279 "Created: / 07-10-2012 / 10:38:05 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
280 ! |
|
281 |
|
282 containerNameForExtensions: aProgrammingLanguage javaClass: aJavaClass |
|
283 | class classBinaryName comps | |
|
284 |
|
285 class := aJavaClass theNonMetaClass. |
|
286 "Sigh, make it compatible with old and new naming of Java classes |
|
287 |
|
288 old -> aJavaClass name == #'java/lang/Object' |
|
289 new -> aJavaClass name == JAVA::java::lang::Object |
|
290 aJavaClass binaryName == #'java/lang/Object' |
|
291 " |
|
292 classBinaryName := (class respondsTo: #binaryName) |
|
293 ifTrue:[ class binaryName ] |
|
294 ifFalse:[ class name ]. |
|
295 self assert: (classBinaryName includes: $:) not. |
|
296 |
|
297 ^ String streamContents:[:s| |
|
298 s nextPutAll: 'java/extensions'. |
|
299 comps := classBinaryName tokensBasedOn: $/. |
|
300 comps do:[:each| s nextPut: $/; nextPutAll: each ]. |
|
301 s nextPut: $.; nextPutAll: aProgrammingLanguage sourceFileSuffix. |
|
302 ]. |
|
303 |
|
304 "Created: / 24-09-2013 / 11:31:58 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
305 "Modified: / 09-10-2013 / 08:56:20 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
306 ! |
236 |
307 |
237 containerSuffixes |
308 containerSuffixes |
238 |
309 |
239 ^ProgrammingLanguage all collect:[:each|each sourceFileSuffix] |
310 ^ProgrammingLanguage all collect:[:each|each sourceFileSuffix] |
240 |
311 |
241 "Created: / 23-03-2009 / 18:53:56 / Jan Vrany <vranyj1@fel.cvut.cz>" |
312 "Created: / 23-03-2009 / 18:53:56 / Jan Vrany <vranyj1@fel.cvut.cz>" |
242 "Modified: / 30-12-2009 / 18:15:03 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
313 "Modified: / 30-12-2009 / 18:15:03 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
314 ! |
|
315 |
|
316 containerWriteStreamFor: containerName |
|
317 | filename directory | |
|
318 |
|
319 filename := self containerFilenameFor: containerName. |
|
320 (directory := filename directory) exists ifFalse:[ |
|
321 directory recursiveMakeDirectory |
|
322 ]. |
|
323 ^filename writeStream |
|
324 eolMode: #nl; |
|
325 yourself |
|
326 |
|
327 "Created: / 09-10-2008 / 20:24:44 / Jan Vrany <vranyj1@fel.cvut.cz>" |
|
328 "Modified: / 04-09-2012 / 23:44:36 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
329 ! |
|
330 |
|
331 containerWriteStreamForClass:cls |
|
332 ^self containerWriteStreamFor: (self containerNameForClass:cls) |
|
333 |
|
334 "Created: / 07-10-2012 / 10:27:46 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
335 ! |
|
336 |
|
337 containerWriteStreamForExtensions: aProgrammingLanguage |
|
338 ^self containerWriteStreamFor: (self containerNameForExtensions: aProgrammingLanguage) |
|
339 |
|
340 "Created: / 30-12-2009 / 18:14:09 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
341 "Modified: / 07-10-2012 / 10:54:27 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
342 ! |
|
343 |
|
344 containerWriteStreamForExtensions: aProgrammingLanguage javaClass: aJavaClass |
|
345 | container | |
|
346 |
|
347 container := self containerFilenameFor: (self containerNameForExtensions: aProgrammingLanguage javaClass: aJavaClass). |
|
348 container directory exists ifFalse:[ |
|
349 container directory recursiveMakeDirectory. |
|
350 ]. |
|
351 ^ container writeStream |
|
352 |
|
353 "Created: / 04-09-2012 / 23:17:41 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
354 "Modified: / 24-09-2013 / 12:07:00 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
243 ! |
355 ! |
244 |
356 |
245 containers |
357 containers |
246 |
358 |
247 | containers jextensions | |
359 | containers jextensions | |
263 ^ containers |
375 ^ containers |
264 |
376 |
265 "Created: / 23-03-2009 / 18:52:27 / Jan Vrany <vranyj1@fel.cvut.cz>" |
377 "Created: / 23-03-2009 / 18:52:27 / Jan Vrany <vranyj1@fel.cvut.cz>" |
266 "Modified: / 12-06-2009 / 21:44:06 / Jan Vrany <vranyj1@fel.cvut.cz>" |
378 "Modified: / 12-06-2009 / 21:44:06 / Jan Vrany <vranyj1@fel.cvut.cz>" |
267 "Modified: / 24-09-2013 / 12:39:19 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
379 "Modified: / 24-09-2013 / 12:39:19 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
268 ! ! |
|
269 |
|
270 !SCMAbstractPackageModel methodsFor:'accessing-classes'! |
|
271 |
|
272 commitDialogClass |
|
273 self subclassResponsibility |
|
274 |
|
275 "Created: / 14-11-2012 / 22:29:10 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
276 ! |
|
277 |
|
278 commitTaskClass |
|
279 "raise an error: must be redefined in concrete subclass(es)" |
|
280 |
|
281 ^ self subclassResponsibility |
|
282 ! ! |
|
283 |
|
284 !SCMAbstractPackageModel methodsFor:'accessing-containers'! |
|
285 |
|
286 containerFilenameFor: containerName |
|
287 |
|
288 ^self temporaryWorkingCopyRoot / containerName |
|
289 |
|
290 "Created: / 09-10-2008 / 20:25:02 / Jan Vrany <vranyj1@fel.cvut.cz>" |
|
291 "Modified: / 01-12-2012 / 00:24:47 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
292 ! |
|
293 |
|
294 containerNameForClass:cls |
|
295 ^self |
|
296 containerNameForClassNamed: cls theNonMetaclass fullName |
|
297 language: cls programmingLanguage |
|
298 |
|
299 "Created: / 07-10-2012 / 10:36:46 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
300 "Modified: / 15-11-2012 / 00:46:24 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
301 ! |
|
302 |
|
303 containerNameForClassNamed: nm language: lang |
|
304 ^String streamContents:[:s| |
|
305 s nextPutAll: (nm copyReplaceAll:$: with: $_). |
|
306 s nextPut: $.. |
|
307 s nextPutAll: lang sourceFileSuffix |
|
308 ] |
|
309 |
|
310 "Created: / 15-11-2012 / 00:45:49 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
311 ! |
|
312 |
|
313 containerNameForExtensions |
|
314 ^self containerNameForExtensions: SmalltalkLanguage instance |
|
315 |
|
316 "Created: / 07-10-2012 / 10:37:33 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
317 ! |
|
318 |
|
319 containerNameForExtensions: aProgrammingLanguage |
|
320 ^'extensions.' , aProgrammingLanguage sourceFileSuffix |
|
321 |
|
322 "Created: / 07-10-2012 / 10:38:05 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
323 ! |
|
324 |
|
325 containerNameForExtensions: aProgrammingLanguage javaClass: aJavaClass |
|
326 | class classBinaryName comps | |
|
327 |
|
328 class := aJavaClass theNonMetaClass. |
|
329 "Sigh, make it compatible with old and new naming of Java classes |
|
330 |
|
331 old -> aJavaClass name == #'java/lang/Object' |
|
332 new -> aJavaClass name == JAVA::java::lang::Object |
|
333 aJavaClass binaryName == #'java/lang/Object' |
|
334 " |
|
335 classBinaryName := (class respondsTo: #binaryName) |
|
336 ifTrue:[ class binaryName ] |
|
337 ifFalse:[ class name ]. |
|
338 self assert: (classBinaryName includes: $:) not. |
|
339 |
|
340 ^ String streamContents:[:s| |
|
341 s nextPutAll: 'java/extensions'. |
|
342 comps := classBinaryName tokensBasedOn: $/. |
|
343 comps do:[:each| s nextPut: $/; nextPutAll: each ]. |
|
344 s nextPut: $.; nextPutAll: aProgrammingLanguage sourceFileSuffix. |
|
345 ]. |
|
346 |
|
347 "Created: / 24-09-2013 / 11:31:58 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
348 "Modified: / 09-10-2013 / 08:56:20 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
349 ! |
|
350 |
|
351 containerWriteStreamFor: containerName |
|
352 | filename directory | |
|
353 |
|
354 filename := self containerFilenameFor: containerName. |
|
355 (directory := filename directory) exists ifFalse:[ |
|
356 directory recursiveMakeDirectory |
|
357 ]. |
|
358 ^filename writeStream |
|
359 eolMode: #nl; |
|
360 yourself |
|
361 |
|
362 "Created: / 09-10-2008 / 20:24:44 / Jan Vrany <vranyj1@fel.cvut.cz>" |
|
363 "Modified: / 04-09-2012 / 23:44:36 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
364 ! |
|
365 |
|
366 containerWriteStreamForClass:cls |
|
367 ^self containerWriteStreamFor: (self containerNameForClass:cls) |
|
368 |
|
369 "Created: / 07-10-2012 / 10:27:46 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
370 ! |
|
371 |
|
372 containerWriteStreamForExtensions: aProgrammingLanguage |
|
373 ^self containerWriteStreamFor: (self containerNameForExtensions: aProgrammingLanguage) |
|
374 |
|
375 "Created: / 30-12-2009 / 18:14:09 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
376 "Modified: / 07-10-2012 / 10:54:27 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
377 ! |
|
378 |
|
379 containerWriteStreamForExtensions: aProgrammingLanguage javaClass: aJavaClass |
|
380 | container | |
|
381 |
|
382 container := self containerFilenameFor: (self containerNameForExtensions: aProgrammingLanguage javaClass: aJavaClass). |
|
383 container directory exists ifFalse:[ |
|
384 container directory recursiveMakeDirectory. |
|
385 ]. |
|
386 ^ container writeStream |
|
387 |
|
388 "Created: / 04-09-2012 / 23:17:41 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
389 "Modified: / 24-09-2013 / 12:07:00 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
390 ! |
380 ! |
391 |
381 |
392 containersToKeep |
382 containersToKeep |
393 |
383 |
394 | containers extensions | |
384 | containers extensions | |
430 |
420 |
431 ^containers asSet. |
421 ^containers asSet. |
432 |
422 |
433 "Created: / 12-06-2009 / 21:27:12 / Jan Vrany <vranyj1@fel.cvut.cz>" |
423 "Created: / 12-06-2009 / 21:27:12 / Jan Vrany <vranyj1@fel.cvut.cz>" |
434 "Modified: / 24-09-2013 / 12:32:50 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
424 "Modified: / 24-09-2013 / 12:32:50 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
425 ! ! |
|
426 |
|
427 !SCMAbstractPackageModel methodsFor:'accessing-hierarchy'! |
|
428 |
|
429 children |
|
430 "Returns all my immediate children." |
|
431 |
|
432 | childNames nameSizePlus1 | |
|
433 |
|
434 nameSizePlus1 := name size + 1. |
|
435 childNames := Smalltalk allProjectIDs select:[:each | |
|
436 (each startsWith: name) |
|
437 and:[ each ~= name |
|
438 and:[ ((each at: nameSizePlus1) == $/ or:[ (each at: nameSizePlus1) == $: ]) |
|
439 and:[ (each indexOf: $/ startingAt: nameSizePlus1 + 1) == 0]]]]. |
|
440 ^ childNames collect:[:each | self childNamed: (each copyFrom: nameSizePlus1 + 1) ]. |
|
441 |
|
442 " |
|
443 (HGPackageModelRegistry packageNamed: 'stx:libscm') children |
|
444 " |
|
445 |
|
446 "Created: / 19-02-2014 / 23:43:09 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
447 ! |
|
448 |
|
449 childrenDo: aBlock |
|
450 "Evaluate a block for all immediate children of the receiver. |
|
451 Does NOT recurse." |
|
452 |
|
453 self children do: aBlock |
|
454 |
|
455 "Created: / 19-02-2014 / 23:47:36 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
456 ! |
|
457 |
|
458 parent |
|
459 "Returns the parent model. See class documentation for details on parents" |
|
460 |
|
461 ^parent |
|
462 |
|
463 "Created: / 01-12-2012 / 17:56:18 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
464 ! |
|
465 |
|
466 root |
|
467 "Returns the root of this package model hierarchy, i.e., grand-parent which itself has no parent. |
|
468 See class documentation for details on parents" |
|
469 |
|
470 | p | |
|
471 |
|
472 p := self. |
|
473 [ p parent notNil ] whileTrue:[ |
|
474 p := p parent. |
|
475 ]. |
|
476 ^ p |
|
477 |
|
478 "Created: / 19-02-2014 / 23:30:56 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
479 ! |
|
480 |
|
481 siblings |
|
482 "Returns all my siblings" |
|
483 |
|
484 ^ parent notNil |
|
485 ifTrue:[self parent children copy remove: self; yourself] |
|
486 ifFalse:[ #() ] |
|
487 |
|
488 " |
|
489 (HGPackageModelRegistry packageNamed: 'stx:libscm') siblings |
|
490 (HGPackageModelRegistry packageNamed: 'stx:libscm/common') siblings |
|
491 " |
|
492 |
|
493 "Created: / 20-02-2014 / 00:22:43 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
494 ! |
|
495 |
|
496 yourselfAndAllChildrenDo: aBlock |
|
497 "Evaluate a block for receiver and all its children, recursively." |
|
498 |
|
499 aBlock value: self. |
|
500 self children do:[:each | each yourselfAndAllChildrenDo: aBlock ] |
|
501 |
|
502 "Created: / 19-02-2014 / 23:49:27 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
435 ! ! |
503 ! ! |
436 |
504 |
437 !SCMAbstractPackageModel methodsFor:'accessing-private'! |
505 !SCMAbstractPackageModel methodsFor:'accessing-private'! |
438 |
506 |
439 childNamed: aString |
507 childNamed: aString |