"{ 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

    | methodsWithTimestamp |
    methodsWithTimestamp := OrderedCollection new.

    self classes do:[:cls|
        cls methodsDo:[:mthd|
            (mthd hasAnnotation: #mctimestamp:) ifTrue:[
                methodsWithTimestamp add: mthd
            ]
        ].
    ].
    self extensionMethods do:[:mthd|
        (mthd hasAnnotation: #mctimestamp:) ifTrue:[
            methodsWithTimestamp add: mthd                
        ]
    ].

    ^self monticelloTimestamps_codeFor: methodsWithTimestamp

    "
        stx_goodies_mondrian_core monticelloTimestamps_code
    "

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

!ProjectDefinition class methodsFor:'code generation'!

monticelloTimestamps_codeFor: methods

    | code |
    code := String new writeStream.
    code nextPutAll:'monticelloTimestamps

    ^#('.
    methods do:[:mthd|
     code
        tab; tab; 
        nextPut:$(;
        nextPutAll: mthd mclass fullName;
        space;
        nextPutAll: mthd selector;
        space;
        nextPutAll: (mthd annotationAt: #mctimestamp:) timestamp storeString;        
        nextPut:$); 
        cr.
    ].
    code nextPutAll:'
    )'.

    ^code contents

    "
        stx_goodies_mondrian_core mcTimestamps_code
    "

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

!ProjectDefinition class methodsFor:'accessing - monticello'!

monticelloVersionInfo
    "Return Monticello version info (a kind og MCVersionInfo)
     for this package.

     This method is used by #exportToMonticello: Do not override.
    "
    | scm |

    scm := AbstractSourceCodeManager managerForPackage: self package.
    ^ scm monticelloVersionInfoForPackage: self package.

    "
    jv_libgdbs monticelloVersionInfo
    "

    "Created: / 29-06-2020 / 12:56:46 / Jan Vrany <jan.vrany@labware.com>"
! !

!SequenceableCollection methodsFor:'*monticello-squeakCompatibility'!

copyReplaceAll: oldSubstring with: newSubstring asTokens: ifTokens
        "Answer a copy of the receiver in which all occurrences of
        oldSubstring have been replaced by newSubstring.
        ifTokens (valid for Strings only) specifies that the characters
        surrounding the recplacement must not be alphanumeric.
                Bruce Simth,  must be incremented by 1 and not 
        newSubstring if ifTokens is true.  See example below. "

        | aString startSearch currentIndex endIndex |
        (ifTokens and: [(self isString) not])
                ifTrue: [(self isKindOf: Text) ifFalse: [
                        self error: 'Token replacement only valid for Strings']].
        aString := self.
        startSearch := 1.
        [(currentIndex := aString indexOfSubCollection: oldSubstring startingAt: startSearch)
                         > 0]
                whileTrue: 
                [endIndex := currentIndex + oldSubstring size - 1.
                (ifTokens not
                        or: [(currentIndex = 1
                                        or: [(aString at: currentIndex-1) isAlphaNumeric not])
                                and: [endIndex = aString size
                                        or: [(aString at: endIndex+1) isAlphaNumeric not]]])
                        ifTrue: [aString := aString
                                        copyReplaceFrom: currentIndex
                                        to: endIndex
                                        with: newSubstring.
                                startSearch := currentIndex + newSubstring size]
                        ifFalse: [
                                ifTokens 
                                        ifTrue: [startSearch := currentIndex + 1]
                                        ifFalse: [startSearch := currentIndex + newSubstring size]]].
        ^ aString

"Test case:
        'test te string' copyReplaceAll: 'te' with: 'longone' asTokens: true   "

    "Created: / 26-08-2009 / 12:40:34 / Jaroslav Havlin <havlij6@fel.cvut.cz>"
! !

!Stream methodsFor:'*monticello'!

isMessageStream
	^ false
! !

!String methodsFor:'*monticello'!

extractNumber
	^ ('0', self select: [:ea | ea isDigit]) asNumber
! !

!StringCollection methodsFor:'converting'!

asStringWithNativeLineEndings

    ^self asString

    "Created: / 12-09-2010 / 15:58:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!StringCollection methodsFor:'converting'!

asStringWithSqueakLineEndings

    ^ self 
        asStringWith:Character return
        from:1 to:(self size) 
        compressTabs:false 
        final:nil

    "Created: / 12-09-2010 / 15:58:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!Symbol methodsFor:'*monticello-squeakCompatibility'!

isDoIt
    ^ (self == #DoIt) or:[ self == #DoItIn: ].

    "Created: / 26-08-2009 / 11:46:44 / Jaroslav Havlin <havlij6@fel.cvut.cz>"
! !

!Timestamp class methodsFor:'*monticello-instance creation'!

fromMethodTimeStamp: aString
	| stream |
	stream := ReadStream on: aString.
	stream skipSeparators.
	stream skipTo: Character space.
	^self readFrom: stream.
! !

!Tools::NewSystemBrowser methodsFor:'menu actions-monticello'!

projectMenuMonticelloCommit
    | packageName package workingCopy |

    packageName := self theSingleSelectedProject.
    packageName isNil ifTrue:[
        Dialog information:'Please select a single project'.
        ^  self.
    ].

    self withWaitCursorDo:[
        SourceCodeManagerUtilities basicNew
            validateConsistencyOfPackage:packageName
            doClasses:true 
            doExtensions:true.

        package := MCPackage named: packageName.
        workingCopy := package workingCopy.
        MCCommitDialog new
            workingCopy: workingCopy;
            open
    ].

    "Created: / 14-09-2010 / 22:54:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!UndefinedObject methodsFor:'* monticello'!

typeOfClass
    "Necessary to support disjoint class hierarchies."

    ^#normal
! !

!UserPreferences methodsFor:'accessing-scm-monticello'!

mcEnabled
    "/ needed for MCSettingsApp

    ^self at: #mcEnabled ifAbsent: [true].

    "Created: / 16-09-2010 / 09:44:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 16-09-2010 / 14:50:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified (comment): / 15-01-2012 / 14:12:53 / cg"
! !

!UserPreferences methodsFor:'accessing-scm-monticello'!

mcEnabled: aBoolean
    "/ needed for MCSettingsApp

    self at: #mcEnabled put: aBoolean.

    "Created: / 16-09-2010 / 09:44:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 27-08-2012 / 11:54:43 / cg"
! !

!UserPreferences methodsFor:'accessing-scm-monticello'!

mcRepositories
    "Returns a list of MCRepository as in LITERAL ARRAY ENCODING"

    ^self at: #mcRepositories ifAbsent:[#(Array)].

    "
        UserPreferences current mcRepositories
        UserPreferences current mcRepositories: #(Array) 
    "

    "Created: / 16-09-2010 / 09:47:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified (comment): / 04-04-2012 / 11:08:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!UserPreferences methodsFor:'accessing-scm-monticello'!

mcRepositories: aCollection
    "/ needed for MCSettingsApp

    self at: #mcRepositories put: aCollection.

    "Created: / 27-08-2012 / 11:54:34 / cg"
! !

!VersionInfo methodsFor:'accessing'!

timeStamp

    ^Timestamp
        fromDate: (Date fromString: date)
        andTime:  (Time fromString: time)

    "Created: / 09-09-2010 / 15:20:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!stx_goodies_monticello class methodsFor:'documentation'!

extensionsVersion_HG

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