MCStXPackageInfo.st
author Jan Vrany <jan.vrany@labware.com>
Tue, 11 Jul 2023 12:59:07 +0100
branchjv
changeset 1174 f0a16c301971
parent 1162 9a3834b9152a
permissions -rw-r--r--
Make `ProjectDefinition >> #monticelloTimestamps_code` an extension in `stx:goodies/monticello` ...and convert it to use (not so) new annotation-based extension mechanism.

"
COPYRIGHT (c) 2020-2022 LabWare
"
"{ Package: 'stx:goodies/monticello' }"

"{ NameSpace: Smalltalk }"

PackageInfo subclass:#MCStXPackageInfo
	instanceVariableNames:'classes extensions'
	classVariableNames:''
	poolDictionaries:''
	category:'SCM-Monticello-St/X support'
!

!MCStXPackageInfo class methodsFor:'documentation'!

copyright
"
COPYRIGHT (c) 2020-2022 LabWare


"
! !

!MCStXPackageInfo methodsFor:'accessing'!

classes
    classes isNil ifTrue:[
        classes := ProjectDefinition searchForClassesWithProject: name.
        "/ cg: not true; the projectDefinition is part of the package; at least for st/x packages.
        "/ classes remove: self projectDefinition ifAbsent:[].

        (classes includes:nil) ifTrue:[
            "/ some classes are not present - usually, these are architecture spcific classes
            "/ which are not present in this image (such as XWorkstation vs. WinWorkstation).
            "/ should do a query signal here, to get this info, instead of doing UI here..
            (Dialog confirm:'Not all classes as defined in the package are present in your image.\Typically, these are architecture or OS specific classes.\If you proceed, those classes will be missing in the enerated package file.\\Proceed?' withCRs)
            ifFalse:[
                AbortSignal raise
            ].
            classes := classes select:[:cls | cls notNil].
        ].
    ].
    ^classes

    "Created: / 23-08-2011 / 11:55:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 02-12-2011 / 15:56:35 / cg"
    "Modified: / 05-08-2020 / 15:53:27 / Jan Vrany <jan.vrany@labware.com>"
!

coreMethodsForClass:aClass
    "/ sorry: that's the kind of code which is hard to understand...
"/    ^ ((aClass selectors difference: (aClass isMetaclass ifTrue:[#(#version_MC)] ifFalse:[#()]))
"/        difference:((self foreignExtensionMethodsForClass:aClass) 
"/                collect:[:r | r methodSymbol ])) 
"/            asArray collect:[:sel | self referenceForMethod:sel ofClass:aClass ]

    | methods |

    methods := Set new.
    aClass selectorsAndMethodsDo:[ :sel :mth |
        mth package = name ifTrue: [ 
            methods add: (self referenceForMethod: sel ofClass: aClass)
        ].
    ].
    ^ methods

    "Created: / 02-09-2022 / 13:35:05 / Jan Vrany <jan.vrany@labware.com>"
!

extensionMethods
    extensions isNil ifTrue: [
        extensions := (ProjectDefinition searchForExtensionsWithProject: name)  
                        collect:[:mthd|
                            self assert:mthd notNil.
                            self
                                referenceForMethod: mthd selector
                                ofClass:mthd mclass
                        ]
    ].
    ^ extensions

    "Created: / 23-08-2011 / 11:58:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 27-08-2012 / 12:12:55 / cg"
    "Modified: / 05-08-2020 / 15:55:10 / Jan Vrany <jan.vrany@labware.com>"
!

projectDefinition
    "Return Smalltalk/X project definition class (possibly
     a kind of PackageManifest)"

    ^ self classes detect: [:each | each isProjectDefinition ]

    "Created: / 19-07-2022 / 13:01:55 / Jan Vrany <jan.vrany@labware.com>"
!

systemCategories
    | cats |

    cats := self classes collect:[:cls | cls category] as: Set.
    cats remove: #'* Projects & Packages *' ifAbsent: [].
    ^cats

    "Created: / 23-08-2011 / 13:45:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 03-10-2014 / 02:23:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 05-08-2020 / 15:56:02 / Jan Vrany <jan.vrany@labware.com>"
! !

!MCStXPackageInfo methodsFor:'listing'!

methods
    ^ super methods reject: [ :methodRef | methodRef compiledMethod isSynthetic ]

    "Created: / 05-10-2021 / 14:05:05 / Jan Vrany <jan.vrany@labware.com>"
! !

!MCStXPackageInfo methodsFor:'testing'!

isMCStXPackageInfo
    ^ true

    "Created: / 29-05-2013 / 01:08:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!MCStXPackageInfo class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/goodies/monticello/MCStXPackageInfo.st,v 1.8 2014-10-03 01:23:23 vrany Exp $'
!

version_CVS
    ^ '$Header: /cvs/stx/stx/goodies/monticello/MCStXPackageInfo.st,v 1.8 2014-10-03 01:23:23 vrany Exp $'
!

version_HG

    ^ '$Changeset: <not expanded> $'
!

version_MC
    ^ '$stx:goodies/monticello-cg.3 4e70fe70-f030-11e1-ac62-001f3bda2d09 2012-08-27T12:16:46 cg$'
! !