"{ Package: 'stx:goodies/monticello' }"!

!AbstractSourceCodeManager class methodsFor:'accessing'!

monticelloVersionInfoForPackage: package

    "Return Monticello version info (a kind og MCVersionInfo)

     for given package. 

     If this source code manager does not support exporting

     to Monticello, throw an error.

    "

    self error: ('%1 does not know how to create Monticello version info for %2'

                    bindWith: self name

                        with: package)

    "Created: / 29-06-2020 / 13:04:15 / Jan Vrany <jan.vrany@labware.com>"

! !

!Annotation class methodsFor:'instance creation'!

mctimestamp: aString

    ^MCTimestampAnnotation new timestamp: aString

    "Created: / 14-09-2010 / 15:35:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!AutomagicSourcePorter methodsFor:'porting-monticello'!

visitClassDefinition: anMCClassDefinition

    anMCClassDefinition className: (klassMap at: anMCClassDefinition className ifAbsent: [ anMCClassDefinition className ]).

    anMCClassDefinition superclassName: (klassMap at: anMCClassDefinition superclassName ifAbsent: [ anMCClassDefinition superclassName ]).

    anMCClassDefinition variables do: [:variable | 

        variable isPoolImport ifTrue: [ 

            variable name: (klassMap at: variable name ifAbsent: [ variable name ]).

        ].

    ].

    "Created: / 20-09-2022 / 16:59:54 / Jan Vrany <jan.vrany@labware.com>"

! !

!AutomagicSourcePorter methodsFor:'porting-monticello'!

visitMetaclassDefinition: aMCClassDefinition

! !

!AutomagicSourcePorter methodsFor:'porting-monticello'!

visitMethodDefinition: definition

    source := definition source.

    klass := definition actualClass.

    self rewrite.

    definition source: source.

    definition className: (klassMap at: definition className ifAbsent: [ definition className ])

    "Created: / 03-07-2020 / 00:49:28 / Jan Vrany <jan.vrany@labware.com>"

    "Modified: / 22-09-2022 / 11:45:02 / Jan Vrany <jan.vrany@labware.com>"

! !

!Behavior methodsFor:'*monticello-squeakCompatibility'!

traitCompositionString

        ^ '{}'

    "Created: / 26-08-2009 / 12:43:23 / Jaroslav Havlin <havlij6@fel.cvut.cz>"

! !

!Behavior methodsFor:'*monticello-squeakCompatibility'!

typeOfClass

        "Answer a symbol uniquely describing the type of the receiver"

        "self instSpec = CompiledMethod instSpec ifTrue:[^#compiledMethod]." "Very special!!"

        self isBytes ifTrue:[^#bytes].

        (self isWords and:[self isPointers not]) ifTrue:[^#words].

        self isWeakPointers ifTrue:[^#weak].

        self isVariable ifTrue:[^#variable].

        ^#normal.

    "Created: / 26-08-2009 / 12:45:50 / Jaroslav Havlin <havlij6@fel.cvut.cz>"

! !

!Change methodsFor:'accessing'!

mcDefinition

    ^self objectAttributeAt: #mcDefinition

    "Created: / 08-11-2010 / 17:56:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!Change methodsFor:'accessing'!

mcDefinition: aMCDefinition

    ^self objectAttributeAt: #mcDefinition put: aMCDefinition

    "Created: / 08-11-2010 / 17:56:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!CharacterArray methodsFor:'*monticello-squeakCompatibility'!

asStringWithNativeLineEndings

    ^self copyReplaceAll:Character return with: Character cr

    "Created: / 12-09-2010 / 16:00:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 13-10-2010 / 17:27:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!CharacterArray methodsFor:'*monticello-squeakCompatibility'!

asStringWithSqueakLineEndings

    ^self copyReplaceAll:Character cr with: Character return

    "Created: / 12-09-2010 / 16:00:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 13-10-2010 / 17:28:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!CharacterArray methodsFor:'special string converting'!

spacesToTabs

    "For each line, convert each leading sequence of `numSpaces` spaces

     into a tab.

     Used to convert sources indentation from Smalltalk/X to Squeak-world.

    "     

    ^ self spacesToTabs: 4

    "Created: / 10-08-2020 / 12:03:56 / Jan Vrany <jan.vrany@labware.com>"

! !

!CharacterArray methodsFor:'special string converting'!

spacesToTabs: numSpaces

    "For each line, convert each leading sequence of `numSpaces` spaces

     into a tab.

     Used to convert sources indentation from spaces to tabs.

    "     

    | sz pos out crlf |

    crlf := String with: Character return with: Character linefeed.

    sz := self size.

    pos := 1.

    out := CharacterWriteStream new: self size.

    [ pos <= sz ] whileTrue: [

        | numSpacesFound end |

        "/ Search for leading consecutive `numSpaces` spaces.

        numSpacesFound := 0.

        [ (pos + numSpacesFound) <= sz and:[(self at: pos + numSpacesFound) == Character space ] ] whileTrue: [

            numSpacesFound := numSpacesFound + 1.            

        ].

        "/ Replace spaces with tabs

        (numSpacesFound // numSpaces) timesRepeat: [

            out nextPut: Character tab.

            pos := pos + numSpaces.

        ].

        "/ And finally, put rest of the line (if any)

        end := self indexOfAny: crlf startingAt: pos ifAbsent: sz.

        out nextPutAll: self startingAt: pos to: end.

        pos := end + 1.

    ].

    ^ out contents.

    "

    'hello' spacesToTabs: 4

    '    hello world' spacesToTabs: 4

    "

    "Created: / 06-08-2020 / 11:05:47 / Jan Vrany <jan.vrany@labware.com>"

    "Modified: / 10-08-2020 / 12:19:26 / Jan Vrany <jan.vrany@labware.com>"

! !

!CharacterArray methodsFor:'special string converting'!

tabsToSpaces

    "For each line, convert each leading tab into 4 spaces. 

     Used to convert sources from Squeak-world indentation to Smalltalk/X 

     indentation.

    "

    ^ self tabsToSpaces: 4

    "Created: / 10-08-2020 / 12:00:26 / Jan Vrany <jan.vrany@labware.com>"

! !

!CharacterArray methodsFor:'special string converting'!

tabsToSpaces: numSpaces

    "For each line, convert each leading tab into `numSpaces` spaces. 

     Used to convert sources indentation from tabs to spaces.

    "

    | sz pos out crlf |

    crlf := String with: Character return with: Character linefeed.

    sz := self size.

    pos := 1.

    out := CharacterWriteStream new: self size.

    [ pos <= sz ] whileTrue: [

        | end |

        "/ Search and replace leading tabs with `numSpaces` spaces

        [ pos <= sz and:[ (self at: pos) == Character tab ] ] whileTrue: [

            out next: numSpaces put: Character space.

            pos := pos + 1.

        ].

        "/ And finally, put rest of the line (if any)

        end := self indexOfAny: crlf startingAt: pos ifAbsent: sz.

        out nextPutAll: self startingAt: pos to: end.

        pos := end + 1.

    ].

    ^ out contents.

    "

    'hello' tabsToSpaces: 4

    (Character tab asString , Character tab asString , 'hello world') tabsToSpaces: 4

    "

    "Created: / 06-08-2020 / 11:04:49 / Jan Vrany <jan.vrany@labware.com>"

    "Modified: / 10-08-2020 / 12:18:40 / Jan Vrany <jan.vrany@labware.com>"

! !

!Class methodsFor:'*monticello'!

asClassDefinition

    ^ MCClassDefinition

        name: self name

        superclassName: (self superclass isNil ifTrue:['nil'] ifFalse:[self superclass name])

        traitComposition: self traitCompositionString

        classTraitComposition: self class traitCompositionString

        category: self category 

        instVarNames: self instVarNames

        classVarNames: self classVarNames

        poolDictionaryNames: self poolDictionaryNames

        classInstVarNames: self class instVarNames

        type: self typeOfClass

        comment: (self organization classComment ? '') asStringWithSqueakLineEndings

        commentStamp: self organization commentStamp

    "Modified: / 12-09-2010 / 17:19:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!Class methodsFor:'*monticello'!

classDefinitions

    self isLoaded ifFalse:[self autoload].

	^ Array with: self asClassDefinition

! !

!Class methodsFor:'*monticello'!

poolDictionaryNames

        ^ self sharedPoolNames

    "Modified: / 29-01-2021 / 08:42:46 / Jan Vrany <jan.vrany@labware.com>"

! !

!ClassDescription methodsFor:'*monticello-squeakCompatibility'!

mcDefinition

    |s|

    s := WriteStream on:(String new).

    self

        basicFileOutDefinitionOn:s

        withNameSpace:false

        withPackage:false.

    s position: s position - 1.

    ^ s contents

    "Created: / 11-09-2010 / 18:06:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!Method methodsFor:'converting'!

asMethodDefinition

    ^ self asMethodReference asMethodDefinition

    "Created: / 06-07-2020 / 21:37:03 / Jan Vrany <jan.vrany@labware.com>"

! !

!Method methodsFor:'converting'!

asMethodReference

    ^ MethodReference class: mclass selector: self selector

    "Created: / 06-07-2020 / 21:36:42 / Jan Vrany <jan.vrany@labware.com>"

! !

!Object methodsFor:'*monticello'!

isConflict

	^false

! !

!PackageInfo methodsFor:'testing'!

isMCStXPackageInfo

    ^ false

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

! !

!ProjectDefinition class methodsFor:'exporting'!

exportToMonticello:anMCRepository 

    "Export currently loaded revision of this package 

     to given Monticello repository."

    | mcpkg mcwc mcvi mcversion |

    Class tryLocalSourceFirst:true.

    mcpkg := MCPackage named:self package.

    mcwc := mcpkg workingCopy.

    mcvi := self monticelloVersionInfo.

    [

        mcversion := mcwc newVersion.

        mcversion snapshot options includeExtrasForSTX:true.

    ] on:MCVersionNameAndMessageRequest

            do:[:ex | ex resume:(Array with:mcvi name with:mcvi message) ].

    mcversion info:mcvi.

    anMCRepository storeVersion:mcversion.

    ^ mcversion

    "

    jv_libgdbs exportToMonticello: (MCDirectoryRepository directory:'/tmp/mc')

    labware_machinearithmetic exportToMonticello: (MCDirectoryRepository directory:'/tmp/mc')

    "

    "Created: / 24-06-2020 / 22:45:34 / Jan Vrany <jan.vrany@labware.com>"

    "Modified (comment): / 29-06-2020 / 13:24:04 / Jan Vrany <jan.vrany@labware.com>"

! !

!ProjectDefinition class methodsFor:'code generation'!

monticelloAncestry_code

    ^'#()'

    "Created: / 25-08-2011 / 16:49:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!ProjectDefinition class methodsFor:'accessing - monticello'!

monticelloName

    "Return name of the package for Monticello. 

     Historically, Monticello package membership is based on

     naming conventions. All classes whose category name starts with

     package name are considerer as belonging to the package, others

     do not. If classes' category does not match this naming convention,

     the package will fail to load back properly.

     Here, infer such prefix. Individual packages may override this method

     and return a string to enforce a particular name."

    | cats longest prefix index nm |

    cats := (self classes collect:[:each | each autoload; category ]) asSet.

    cats remove:#'* Projects & Packages *'.

    cats size == 1 ifTrue:[

        ^ cats anElement

    ].

    cats isEmpty ifTrue:[

        ^ 'Misc_Changes'

    ].

    longest := cats 

            inject:cats anElement

            into:[:cat :each | 

                each size > cat size ifTrue:[

                    each

                ] ifFalse:[ cat ]

            ].

    prefix := ''.

    [

        (index := longest indexOf:$- startingAt:prefix size + 2) ~~ 0

    ] whileTrue:[

        prefix := longest copyTo:index - 1.

        (cats allSatisfy:[:each | each startsWith:prefix ]) ifTrue:[

            nm := prefix.

        ].

    ].

    nm notNil ifTrue:[

        ^ nm

    ].

    ^ self package asString copyReplaceAny:':/' with:$_.

"/    self 

"/        error:'Cannot infer Monticello package name from class categories. Please define #mcName explicitly'

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

    "Modified: / 23-06-2013 / 21:12:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!ProjectDefinition class methodsFor:'accessing - monticello'!

monticelloNameForMCZ

    "Return the name of package used to build .mcz file.

     Override if needed. Defaults to sanitized monticelloName"

    ^self monticelloName asString copy replaceAll: $/ with: $_; replaceAll: $: with: $_

    "Created: / 07-06-2013 / 01:48:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified (comment): / 29-06-2020 / 13:11:52 / Jan Vrany <jan.vrany@labware.com>"

! !

!ProjectDefinition class methodsFor:'accessing - monticello'!

monticelloSplicemap

    "Return a splicemap for this package. This is used to forge a 

     'fake' ancestor when generating ancestry information out of 

     Mercurial (or anyt other) history. This should make merging 

     back into Squeak/Pharo a little easier as Monticello can (in theory)

     find a proper ancestor. 

     All this requires monticelloSplicemap being updated each time a code

     is merged from Monticello.

     The format of splicemap is a flat array of pairs 

     (commit id, MCVersionInfo to splice) as literal encoding.

     Override if needed and append an entry each time a 'foreign'

     Monticello version is merged in.

    "

    ^#()

    "Created: / 07-09-2015 / 18:11:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified (comment): / 29-06-2020 / 13:13:13 / Jan Vrany <jan.vrany@labware.com>"

! !

!ProjectDefinition class methodsFor:'code generation'!

monticelloSplicemap_code

    ^ self monticelloSplicemap_codeFor:self monticelloSplicemap

    "Created: / 07-09-2015 / 17:58:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!ProjectDefinition class methodsFor:'code generation'!

monticelloSplicemap_codeFor:splicemap 

    ^ String 

        streamContents:[:s | 

            s nextPutLine:'monticelloSplicemap'.

            s

                nextPutAll:'    "';

                nextPutAll:(self class superclass lookupMethodFor:#monticelloSplicemap) 

                            comment;

                nextPutLine:'"'.

            s nextPutLine:''.

            s nextPutLine:'    ^ #('.

            splicemap 

                pairWiseDo:[:changeset :mcversion | 

                    s nextPutAll:'        '.

                    changeset storeOn:s.

                    s space.

                    mcversion storeOn:s.

                    s

                        cr;

                        cr.

                ].

            s nextPutLine:'    )'

        ].

    "

     stx_goodies_petitparser_compiler monticelloSplicemap_code"

    "Created: / 07-09-2015 / 17:58:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!ProjectDefinition class methodsFor:'code generation'!

monticelloTimestamps_code

    <method: #monticelloTimestamps category: #'description - monticello' overwrite: true>

    | methodsWithTimestamp |

    methodsWithTimestamp := OrderedCollection new.