Upon commit, update logical revision of all packages that belongs to the same repository...
...but only if their logical revision is the same as logical revision of the package being commited.
"
stx:libscm - a new source code management library for Smalltalk/X
Copyright (C) 2012-2013 Jan Vrany
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
"
"{ Package: 'stx:libscm/common' }"
Object subclass:#SCMAbstractPackageModel
instanceVariableNames:'name parent children repository repositoryRoot wc wcroot
classesHasChanged extensionsHasChanged'
classVariableNames:''
poolDictionaries:''
category:'SCM-Common-StX'
!
!SCMAbstractPackageModel class methodsFor:'documentation'!
copyright
"
stx:libscm - a new source code management library for Smalltalk/X
Copyright (C) 2012-2013 Jan Vrany
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
"
!
documentation
"
A model of a Smalltalk/X package in repository. It knows how to
map living classes to their respective file containers and can
fileout individual classes.
Package models forms a hiearchy that copies package hiearchy. The root
has no parent and represent a package which is located in the root
of the repository. Examples:
stx:libscm ---> parent = nil, repository = /home/.../build/stx/libscm, repositoryPath = '.'
stx:libscm/common ---> parent = stx:libscm, repository = /home/.../build/stx/libscm, repositoryPath = 'common'
stx:libscm/mercurial ---> parent = stx:libscm, repository = /home/.../build/stx/libscm, repositoryPath = 'mercurial'
In this case, the HGRepository object is shared by all three package models.
[author:]
Jan Vrany <jan.vrany@fit.cvut.cz>
[instance variables:]
[class variables:]
[see also:]
"
! !
!SCMAbstractPackageModel class methodsFor:'instance creation'!
named: package
self subclassResponsibility
"Created: / 16-11-2012 / 19:52:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
new
"return an initialized instance"
^ self basicNew initialize.
! !
!SCMAbstractPackageModel methodsFor:'accessing'!
classes
^self classesIncludingPrivate reject:[:cls|cls owningClass notNil]
"Created: / 06-10-2012 / 23:14:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
classesFiltered: classFilter
^self classes select: [:class|classFilter value: class].
"Created: / 06-10-2012 / 23:14:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
classesIncludingPrivate
^ProjectDefinition searchForClassesWithProject: self name
"Created: / 06-10-2012 / 23:15:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
commitDialog
^self commitDialogClass new
"Modified: / 14-11-2012 / 22:31:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
commitTask
^self commitTaskClass new
package: self;
yourself
"Created: / 06-10-2012 / 22:14:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 13-11-2012 / 23:22:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
construct: aString
"Create a package model for subpackage named aString"
| normalizedName components package |
normalizedName := (aString includes: $:) ifTrue:[aString copyReplaceAll:$: with:$/] ifFalse:[aString].
( normalizedName includes: $/) ifFalse:[
^self childNamed: normalizedName.
].
components := normalizedName tokensBasedOn: $/.
package := self.
components do:[:each|package := package childNamed: each].
^package
"Created: / 16-11-2012 / 23:47:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 03-12-2012 / 14:04:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
definition
^LibraryDefinition definitionClassForPackage:self name createIfAbsent:true
"Created: / 06-10-2012 / 23:09:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
extensions
^ProjectDefinition searchForExtensionsWithProject: self name
"Created: / 06-10-2012 / 23:12:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
extensionsFiltered:aBlock
^self extensions select:aBlock
"Created: / 06-10-2012 / 23:19:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
manager
"Returns a source code manager for this kind of package"
^self subclassResponsibility
"Created: / 14-11-2012 / 01:02:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
name
^ name
!
repositoryRoot
"Returns relative path within the repository root where the package
content is located. Example: let's assume:
<repo>/.hg
<repo>/mercurial/...
<repo>/mercurial/tests/...
<repo>/common/..
then
(HGPackageModelRegistry packageNamed: 'stx:libscm/mercurial/tests') path
== 'mercurial/tests'
"
self assert: repositoryRoot notNil.
^repositoryRoot
"Created: / 01-12-2012 / 02:03:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
temporaryWorkingCopy
self ensureTemporaryWorkingCopy.
^wc
"Created: / 01-12-2012 / 00:26:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
temporaryWorkingCopyPath
"Return the directory which contains temporary working copy.
The directory may not exists if the temporary working copy has
not yet been initialized (which is done on demand)"
^ self manager temporaryWorkingCopyDirectory / repository uuid printString
"Created: / 05-02-2013 / 09:30:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
temporaryWorkingCopyRoot
self ensureTemporaryWorkingCopy.
^ wcroot
"Created: / 14-11-2012 / 23:51:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!SCMAbstractPackageModel methodsFor:'accessing-classes'!
commitDialogClass
self subclassResponsibility
"Created: / 14-11-2012 / 22:29:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
commitTaskClass
"raise an error: must be redefined in concrete subclass(es)"
^ self subclassResponsibility
! !
!SCMAbstractPackageModel methodsFor:'accessing-containers'!
containerFilenameFor: containerName
^self temporaryWorkingCopyRoot / containerName
"Created: / 09-10-2008 / 20:25:02 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Modified: / 01-12-2012 / 00:24:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
containerNameForClass:cls
^self
containerNameForClassNamed: cls theNonMetaclass fullName
language: cls programmingLanguage
"Created: / 07-10-2012 / 10:36:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 15-11-2012 / 00:46:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
containerNameForClassNamed: nm language: lang
^String streamContents:[:s|
s nextPutAll: (nm copyReplaceAll:$: with: $_).
s nextPut: $..
s nextPutAll: lang sourceFileSuffix
]
"Created: / 15-11-2012 / 00:45:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
containerNameForExtensions
^self containerNameForExtensions: SmalltalkLanguage instance
"Created: / 07-10-2012 / 10:37:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
containerNameForExtensions: aProgrammingLanguage
^'extensions.' , aProgrammingLanguage sourceFileSuffix
"Created: / 07-10-2012 / 10:38:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
containerNameForExtensions: aProgrammingLanguage javaClass: aJavaClass
| class classBinaryName comps |
class := aJavaClass theNonMetaClass.
"Sigh, make it compatible with old and new naming of Java classes
old -> aJavaClass name == #'java/lang/Object'
new -> aJavaClass name == JAVA::java::lang::Object
aJavaClass binaryName == #'java/lang/Object'
"
classBinaryName := (class respondsTo: #binaryName)
ifTrue:[ class binaryName ]
ifFalse:[ class name ].
self assert: (classBinaryName includes: $:) not.
^ String streamContents:[:s|
s nextPutAll: 'java/extensions'.
comps := classBinaryName tokensBasedOn: $/.
comps do:[:each| s nextPut: $/; nextPutAll: each ].
s nextPut: $.; nextPutAll: aProgrammingLanguage sourceFileSuffix.
].
"Created: / 24-09-2013 / 11:31:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 09-10-2013 / 08:56:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
containerSuffixes
^ProgrammingLanguage all collect:[:each|each sourceFileSuffix]
"Created: / 23-03-2009 / 18:53:56 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Modified: / 30-12-2009 / 18:15:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
containerWriteStreamFor: containerName
| filename directory |
filename := self containerFilenameFor: containerName.
(directory := filename directory) exists ifFalse:[
directory recursiveMakeDirectory
].
^filename writeStream
eolMode: #nl;
yourself
"Created: / 09-10-2008 / 20:24:44 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Modified: / 04-09-2012 / 23:44:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
containerWriteStreamForClass:cls
^self containerWriteStreamFor: (self containerNameForClass:cls)
"Created: / 07-10-2012 / 10:27:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
containerWriteStreamForExtensions: aProgrammingLanguage
^self containerWriteStreamFor: (self containerNameForExtensions: aProgrammingLanguage)
"Created: / 30-12-2009 / 18:14:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 07-10-2012 / 10:54:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
containerWriteStreamForExtensions: aProgrammingLanguage javaClass: aJavaClass
| container |
container := self containerFilenameFor: (self containerNameForExtensions: aProgrammingLanguage javaClass: aJavaClass).
container directory exists ifFalse:[
container directory recursiveMakeDirectory.
].
^ container writeStream
"Created: / 04-09-2012 / 23:17:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 24-09-2013 / 12:07:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
containers
| containers jextensions |
containers := OrderedCollection new.
containers addAll:
(wcroot directoryContents select:
[:container|self containerSuffixes anySatisfy:
[:suffix|container endsWith:suffix]]) asSet.
(jextensions:= wcroot / 'java' / 'extensions') exists ifTrue:[
jextensions recursiveDirectoryContentsDo:[:each|
(self containerSuffixes anySatisfy:[:suffix|each endsWith:suffix]) ifTrue:[
(jextensions / each) isRegularFile ifTrue:[
containers add: 'java/extensions/' , each.
].
].
]
].
^ containers
"Created: / 23-03-2009 / 18:52:27 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Modified: / 12-06-2009 / 21:44:06 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Modified: / 24-09-2013 / 12:39:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
containersToKeep
| containers extensions |
containers := self classes collect:[:cls|self containerNameForClass: cls].
(extensions := self extensions) notEmpty ifTrue:[
| languages extensionsNonJava extensionsJava |
extensionsNonJava := extensions reject:[:m | m mclass programmingLanguage isJava].
extensionsJava := extensions select:[:m | m mclass programmingLanguage isJava].
languages := (extensionsNonJava collect:[:each|each programmingLanguage]) asSet.
languages do: [:lang| containers add: (self containerNameForExtensions: lang)].
extensionsJava do:[:m |
| container |
container := self containerNameForExtensions: m programmingLanguage javaClass: m mclass.
(containers includes: container) ifFalse:[
containers add: container
].
].
].
"Keep all directories"
wcroot directoryContents do: [:f|
(f ~= '.hg' and: [(wcroot / f) isDirectory]) ifTrue:[
containers add: f
].
].
"Keep all .st files that are for with other operating systems"
self definition classNamesAndAttributesDo: [:nm :attributes|
attributes do:[:attr|
(#(win32 unix vms autoload) includes: attr) ifTrue:[
containers add: (self containerNameForClassNamed: nm language: SmalltalkLanguage instance)
]
]
].
^containers asSet.
"Created: / 12-06-2009 / 21:27:12 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Modified: / 24-09-2013 / 12:32:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!SCMAbstractPackageModel methodsFor:'accessing-hierarchy'!
children
"Returns all my immediate children."
| childNames nameSizePlus1 |
nameSizePlus1 := name size + 1.
childNames := Smalltalk allProjectIDs select:[:each |
(each startsWith: name)
and:[ each ~= name
and:[ ((each at: nameSizePlus1) == $/ or:[ (each at: nameSizePlus1) == $: ])
and:[ (each indexOf: $/ startingAt: nameSizePlus1 + 1) == 0]]]].
^ childNames collect:[:each | self childNamed: (each copyFrom: nameSizePlus1 + 1) ].
"
(HGPackageModelRegistry packageNamed: 'stx:libscm') children
"
"Created: / 19-02-2014 / 23:43:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
childrenDo: aBlock
"Evaluate a block for all immediate children of the receiver.
Does NOT recurse."
self children do: aBlock
"Created: / 19-02-2014 / 23:47:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
parent
"Returns the parent model. See class documentation for details on parents"
^parent
"Created: / 01-12-2012 / 17:56:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
root
"Returns the root of this package model hierarchy, i.e., grand-parent which itself has no parent.
See class documentation for details on parents"
| p |
p := self.
[ p parent notNil ] whileTrue:[
p := p parent.
].
^ p
"Created: / 19-02-2014 / 23:30:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
siblings
"Returns all my siblings"
^ parent notNil
ifTrue:[self parent children copy remove: self; yourself]
ifFalse:[ #() ]
"
(HGPackageModelRegistry packageNamed: 'stx:libscm') siblings
(HGPackageModelRegistry packageNamed: 'stx:libscm/common') siblings
"
"Created: / 20-02-2014 / 00:22:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
yourselfAndAllChildrenDo: aBlock
"Evaluate a block for receiver and all its children, recursively."
aBlock value: self.
self children do:[:each | each yourselfAndAllChildrenDo: aBlock ]
"Created: / 19-02-2014 / 23:49:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!SCMAbstractPackageModel methodsFor:'accessing-private'!
childNamed: aString
"Returns a child name aString. If no such child
exist, create one"
| child nm|
children at: aString ifPresent:[:child|^child].
child := self class new.
nm := (name includes: $:)
ifTrue: [name , '/' , aString]
ifFalse:[name , ':' , aString].
child setName: nm repository: repository.
child setParent: self.
children at: aString put: child.
^child
"Created: / 01-12-2012 / 01:29:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 01-12-2012 / 18:11:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!SCMAbstractPackageModel methodsFor:'file out'!
fileOutClass:cls
|stream|
stream := self containerWriteStreamForClass:cls.
[
self fileOutClass:cls on:stream
] ensure:[
stream close
]
"Modified: / 11-06-2009 / 16:18:19 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Created: / 30-12-2009 / 19:04:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 03-07-2013 / 19:50:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
fileOutClass:cls on:clsStream
"/ cls methodDictionary do:
"/ [:each|each makeLocalStringSource].
"/
"/ cls class methodDictionary do:
"/ [:each|each makeLocalStringSource].
self manager
fileOutSourceCodeOf:cls
on:clsStream
withTimeStamp:false
withInitialize:true
withDefinition:true
methodFilter:[:mth | mth package = name ]
"
String streamContents:[:s|
(SVN::RepositoryManager repositoryForPackage: Setup::ML package)
workingCopy
fileOutClass: Setup::ML on: s
]
"
"Created: / 19-04-2008 / 09:58:11 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Modified: / 11-06-2009 / 16:18:19 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Modified: / 07-07-2011 / 20:21:59 / jv"
"Modified: / 14-11-2012 / 01:01:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
fileOutExtensions: extensionMethods
^self fileOutExtensions: extensionMethods in: self temporaryWorkingCopyRoot
"Created: / 30-12-2009 / 19:01:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 01-12-2012 / 00:47:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
fileOutExtensions: extensionMethods in: directory
ProgrammingLanguage all do:[:lang|
| stream methods |
methods := extensionMethods select:[:mth|mth programmingLanguage = lang].
methods notEmpty ifTrue: [
ActivityNotification notify:'Filing out extension methods (', lang name , ')'.
self fileOutExtensions: methods in: directory language: lang
]
]
"Created: / 04-09-2012 / 22:56:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
fileOutExtensions: extensionMethods in: directory language: lang
"Given a directory, files out extensions methods in given language.
Takes care about Java extensions, as they are filed out separately
in per-classe .st file in <package dir>/java/extensions/<package>/<java classname>.st"
| stream nonJavaExtensionsMethod javaExtensionsMethods |
stream := self containerWriteStreamForExtensions: lang.
[
nonJavaExtensionsMethod := extensionMethods reject:[:each|each mclass theNonMetaclass isJavaClass].
self fileOutExtensions: nonJavaExtensionsMethod on: stream language: lang.
] ensure:[
stream close
].
javaExtensionsMethods := Dictionary new.
extensionMethods do:[:mthd|
mthd mclass theNonMetaclass isJavaClass ifTrue:[
(javaExtensionsMethods at: mthd mclass ifAbsentPut:[OrderedCollection new]) add: mthd.
].
].
javaExtensionsMethods keysAndValuesDo:[:cls :methods|
[
stream := self containerWriteStreamForExtensions: lang javaClass: cls.
self fileOutExtensions: methods on: stream language: lang.
] ensure:[
stream close.
]
]
"Created: / 04-09-2012 / 23:05:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 15-12-2012 / 17:50:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
fileOutExtensions: extensionMethods on:stream language: language
extensionMethods do:[:each|each makeLocalStringSource].
"Special hack for Smalltalk - use SourceCodeManager routine"
(language isSmalltalk and:[extensionMethods allSatisfy:[:m|m mclass theNonMetaclass isJavaClass not]]) ifTrue:[
self manager fileOutSourceCodeExtensions: extensionMethods package: self name on: stream.
^self.
].
"/ Generic fileout "
language sourceFileWriterClass new
fileOutPackageDefinition: self name on: stream;
fileOutMethods: extensionMethods on: stream
"Modified: / 15-06-2009 / 11:55:26 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Created: / 30-12-2009 / 19:01:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 16-12-2012 / 13:08:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!SCMAbstractPackageModel methodsFor:'initialization'!
initialize
"Invoked when a new instance is created."
"/ please change as required (and remove this comment)
"/ name := nil.
"/ parent := nil.
children := Dictionary new.
"/ repository := nil.
"/ repositoryRoot := nil.
"/ wc := nil.
"/ wcroot := nil.
"/ classesHasChanged := nil.
"/ extensionsHasChanged := nil.
"/ super initialize. -- commented since inherited method does nothing
"Modified: / 01-12-2012 / 18:02:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
setName: aSymbolOrPackageId repository: aRepository
"Initializes the package. This method also MUST initialize 'repositoryRoot' instvar!!"
^self subclassResponsibility
"Created: / 01-12-2012 / 17:52:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
setNameComponents: aCollection repository: aRepository
| nm |
aCollection isEmpty ifTrue:[
self setName:'' repository: aRepository.
^self.
].
aCollection size == 1 ifTrue:[
self setName: aCollection first repository: aRepository.
^self.
].
nm := aCollection first , ':' , aCollection second.
aCollection size > 2 ifTrue:[
3 to: aCollection size do:[:i|
nm := nm , '/' , (aCollection at: i)
].
].
self setName: nm repository: aRepository.
^self
"Created: / 03-12-2012 / 12:36:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
setParent: parentModel
"Sets the parent model. See class documentation for details on parents models"
| topModel |
topModel := parentModel.
topModel parent notNil ifTrue:[
topModel := topModel parent
].
parent := parentModel.
(parent repositoryRoot = '.') ifTrue:[
repositoryRoot := (self name copyFrom: parent name size + 2).
] ifFalse:[
repositoryRoot := parent repositoryRoot , '/' , (self name copyFrom: parent name size + 2) .
]
"Created: / 01-12-2012 / 17:54:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 21-06-2013 / 23:45:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
setWorkingCopy: aSCMAbstractWorkingCopy
wc := aSCMAbstractWorkingCopy.
wcroot := wc root / self repositoryRoot
"Created: / 01-12-2012 / 17:53:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!SCMAbstractPackageModel methodsFor:'private'!
commited
"Sent by commit task once commited"
extensionsHasChanged := false.
classesHasChanged := false.
"Created: / 13-08-2009 / 10:23:19 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Modified: / 15-11-2012 / 10:05:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified (comment): / 23-11-2012 / 22:50:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!SCMAbstractPackageModel methodsFor:'queries'!
classesHasChanged
classesHasChanged :=
(classesHasChanged == true) or:[self computeClassesHasChanged].
^ classesHasChanged
"Created: / 06-10-2012 / 23:16:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
extensionsHasChanged
extensionsHasChanged :=
(extensionsHasChanged == true) or:[self computeExtensionsHasChanged].
^ extensionsHasChanged
"Created: / 06-10-2012 / 23:16:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!SCMAbstractPackageModel methodsFor:'queries-privacy'!
computeClassesHasChanged
"
Answers true iff package classes differs from
those listed in ProjectDefinition>>classNamesAndAttributes"
| listedClasses realClasses pkgDef |
(pkgDef := self definition) isNil ifTrue:[^true].
listedClasses := pkgDef compiled_classNames_common ,
pkgDef compiled_classNamesForPlatform ,
pkgDef autoloaded_classNames.
realClasses := self classes collect:[:cls | cls fullName ].
listedClasses size ~= realClasses size
ifTrue:[^ true].
(realClasses allSatisfy:[:realClass | listedClasses includes:realClass ])
ifFalse:[^true].
^false
"
(CommitTask new package: 'stx:libsvn')
computePackageClassesChanged
(CommitTask new package: 'cvut:fel/smallruby')
computePackageClassesChanged
(SVN::RepositoryManager workingCopyForPackage: #'stx:libbasic')
computePackageClassesChanged
"
"Created: / 06-10-2012 / 23:17:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified (format): / 19-03-2013 / 10:12:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
computeExtensionsHasChanged
"
Answers true iff package extension method differs from
those listed in ProjectDefinition>>extensionMethodNames"
| listedExtensions listedExtensionsDictionary realExtensions |
realExtensions := self extensions.
listedExtensions := self definition
extensionMethodNames.
(listedExtensions size / 2) ~= realExtensions size ifTrue:[
^ true
].
listedExtensionsDictionary := Dictionary new.
listedExtensions
pairWiseDo:[:className :selector |
(listedExtensionsDictionary at:className
ifAbsentPut:[ OrderedCollection new ]) add:selector
].
^ (realExtensions
allSatisfy:[:mth |
(listedExtensionsDictionary includesKey:mth mclass name)
and:[ (listedExtensionsDictionary at:mth mclass name) includes:mth selector ]
])
not
"
(CommitTask new package: 'stx:libsvn')
packageExtensionsHasChanged"
"Created: / 06-10-2012 / 23:17:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified (format): / 19-03-2013 / 10:12:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!SCMAbstractPackageModel methodsFor:'utils'!
ensureTemporaryWorkingCopy
"raise an error: must be redefined in concrete subclass(es)"
^ self subclassResponsibility
! !
!SCMAbstractPackageModel class methodsFor:'documentation'!
version_HG
^ '$Changeset: <not expanded> $'
!
version_SVN
^ '§Id:: §'
! !