extensions.st
author Jan Vrany <jan.vrany@fit.cvut.cz>
Tue, 23 Aug 2011 15:37:10 +0200
changeset 437 f66cbf40d994
parent 436 436066f63a27
child 452 cbc2f85f11f8
permissions -rw-r--r--
Fixes for saving Smalltalk/X packages

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

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

!Behavior methodsFor:'*monticello-squeakCompatibility'!

includesLocalSelector:aSymbol 
    ^ self localSelectors includes:aSymbol

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

!Behavior methodsFor:'*monticello-squeakCompatibility'!

localSelectors
    ^ self methodDictionary collect:[:x | x selector asSymbol ]

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

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

!Class methodsFor:'*monticello'!

asClassDefinition
    ^ MCClassDefinition
        name: self name
        superclassName: 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
	^ Array with: self asClassDefinition
! !

!Class methodsFor:'*monticello'!

poolDictionaryNames
        ^ self sharedPools "/ collect: [:ea | ea name "self environment keyAtIdentityValue: ea"]
! !

!ClassBuilder methodsFor:'compatibility - squeak'!

name:newName 
    inEnvironment:aSystemDictionaryOrClass 
    subclassOf:aClass
    type: type 
    instanceVariableNames: stringOfInstVarNames 
    classVariableNames: stringOfClassVarNames 
    poolDictionaries: stringOfPoolNames
    category: categoryString

    "this returns the created class; it is not a simple accessor"

    |variableBoolean wordsBoolean pointersBoolean|

    variableBoolean := wordsBoolean := pointersBoolean := false.
    type ~~ #normal ifTrue:[
self halt:'todo'.
    ].

    self 
        name:newName 
        inEnvironment:aSystemDictionaryOrClass 
        subclassOf:aClass 
        instanceVariableNames:stringOfInstVarNames 
        variable:variableBoolean 
        words:wordsBoolean 
        pointers:pointersBoolean 
        classVariableNames:stringOfClassVarNames 
        poolDictionaries:stringOfPoolNames 
        category:categoryString 
        comment:''
        changed:false
        classInstanceVariableNames:''.

    ^ self buildClass

    "Modified (comment): / 20-08-2011 / 18:12:51 / cg"
! !

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

!Object methodsFor:'*monticello'!

isConflict
	^false
! !

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

!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
! !

!String methodsFor:'*monticello-squeakCompatibility'!

withSqueakLineEndings
        "Answer a copy of myself in which all sequences of <CR><LF> or <LF> have been changed to <CR>"
        | newText |
        (self includes: Character lf) ifFalse: [ ^self copy ].
        newText := self copyReplaceAll: String crlf with: String cr.
        (newText asString includes: Character lf) ifFalse: [ ^newText ].
        ^newText copyReplaceAll: String lf with: String cr asTokens: false.

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

!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.
    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>"
! !

!Tools::NewSystemBrowser class methodsFor:'menu specs-monticello'!

projectMonticelloMenu
    "This resource specification was automatically generated
     by the MenuEditor of ST/X."

    "Do not manually edit this!! If it is corrupted,
     the MenuEditor may not be able to read the specification."

    "
     MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#projectMonticelloMenu
     (Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser projectMonticelloMenu)) startUp
    "

    <resource: #menu>

    ^ 
     #(Menu
        (
         (MenuItem
            label: 'Commit'
            itemValue: projectMenuMonticelloCommit
            translateLabel: true
          )
         (MenuItem
            label: '-'
          )
         (MenuItem
            enabled: false
            label: 'Not yet finished...'
            translateLabel: true
          )
         )
        nil
        nil
      )
! !

!UndefinedObject methodsFor:'* monticello'!

typeOfClass
    "Necessary to support disjoint class hierarchies."

    ^#normal
! !

!UserPreferences methodsFor:'accessing-monticello'!

mcEnabled

    ^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>"
! !

!UserPreferences methodsFor:'accessing-monticello'!

mcEnabled: aBoolean

    self at: #mcEnabled put: aBoolean.

    "Created: / 16-09-2010 / 09:44:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!UserPreferences methodsFor:'accessing-monticello'!

mcRepositories

    | repos |
    repos := self at: #mcRepositories ifAbsent:[#()].
    ^repos decodeAsLiteralArray

    "
        self mcRepositories: #() 
    "

    "Created: / 16-09-2010 / 09:47:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 17-09-2010 / 11:45:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!UserPreferences methodsFor:'accessing-monticello'!

mcRepositories: aCollection

    | repos |
    repos  := aCollection literalArrayEncoding.
    self at: #mcRepositories put:repos.
    MCRepositoryGroup default flushRepositories.

    "Created: / 16-09-2010 / 09:53:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 16-09-2010 / 13:56:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!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_CVS
    ^ '$Header: /cvs/stx/stx/goodies/monticello/extensions.st,v 1.10 2011-08-23 13:37:10 vrany Exp $'
! !