Never remove protected files upon commit
If the file is protected, never remove it even if it *looks* it is
not needed. When user mark a file a protected, let her / him to
remove it hereself / himself manually.
"
stx:libscm - a new source code management library for Smalltalk/X
Copyright (C) 2012-2015 Jan Vrany
Copyright (C) 2020 LabWare
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' }"
"{ NameSpace: Smalltalk }"
SCMAbstractPackageModel subclass:#SCMAbstractPackageWorkingCopy
instanceVariableNames:'wc wcroot changed classesHasChanged extensionsHasChanged
lastSequenceNumber lastSequenceNumberForChildren'
classVariableNames:''
poolDictionaries:''
category:'SCM-Common-StX'
!
!SCMAbstractPackageWorkingCopy class methodsFor:'documentation'!
copyright
"
stx:libscm - a new source code management library for Smalltalk/X
Copyright (C) 2012-2015 Jan Vrany
Copyright (C) 2020 LabWare
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 a checked-out working copy.
It knows how to map living classes to their respective file containers
and can fileout individual classes. Used (not only) by SCMAbstractCommitTask.
== Changed packages ==
A 'changed' package is a package that contain changes, i.e., some method/class
beloging to a package has been modified or class/method has been added/removed.
Compared to state of the package at its LOAD TIME, not to last nor compiled
revision !!!!!!
See #hasChanges, #classesHasChanged, #extensionsHasChanged.
[author:]
Jan Vrany <jan.vrany@fit.cvut.cz>
[instance variables:]
[class variables:]
[see also:]
SCMAbstractPackageModel
"
! !
!SCMAbstractPackageWorkingCopy 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.
! !
!SCMAbstractPackageWorkingCopy class methodsFor:'testing'!
isAbstract
^ self == SCMAbstractPackageWorkingCopy
"Created: / 13-11-2012 / 23:07:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 05-03-2014 / 21:59:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!SCMAbstractPackageWorkingCopy methodsFor:'accessing'!
abbrevs
^ self definition abbrevs
"Created: / 14-03-2014 / 22:02:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
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>"
!
definition
^LibraryDefinition definitionClassForPackage:self name createIfAbsent:true
"Created: / 06-10-2012 / 23:09:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
definitionOrNilIfNotExists
^LibraryDefinition definitionClassForPackage:self name createIfAbsent:false
"Created: / 11-06-2015 / 07:01:07 / 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>"
!
revision
"Return a logical revision of the package, i.e., a revision
on which the next commit will be based on"
self isVirtual ifTrue:[
| childRevs |
childRevs := Set new.
self childrenDo:[:each | childRevs add: each revision ].
childRevs size == 0 ifTrue:[
self error: 'No non-virtual children'.
^ nil.
].
childRevs size ~~ 1 ifTrue:[
self error: 'Inconsistent revisions of chilren of virtual package'.
^ nil
].
^ childRevs anElement
] ifFalse:[
^ self getRevision
].
"Modified: / 28-02-2014 / 09:38:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
workingCopy
self ensureWorkingCopy.
^ wc
"Created: / 01-12-2012 / 00:26:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
workingCopyPath
"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>"
!
workingCopyRoot
self ensureWorkingCopy.
^ wcroot
"Created: / 14-11-2012 / 23:51:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!SCMAbstractPackageWorkingCopy 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
! !
!SCMAbstractPackageWorkingCopy methodsFor:'accessing-containers'!
containerFor: aString ifAbsent: aBlock
"Return a container as Filename with given name. If there's no such
container, evaluates a block"
^self workingCopyRoot / aString
"Created: / 14-03-2014 / 22:18:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
containerWriteStreamFor: containerName
| filename directory |
filename := self containerFor: 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: / 13-03-2014 / 22:56:16 / 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 containerFor: (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: / 13-03-2014 / 22:55:50 / 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: / 05-03-2014 / 23:29:04 / 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)
]
]
].
"Keep all protected files"
containers addAll: self definition protectedFileNames.
^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>"
"Modified: / 17-11-2020 / 15:22:47 / Jan Vrany <jan.vrany@labware.com>"
! !
!SCMAbstractPackageWorkingCopy methodsFor:'accessing-hierarchy'!
children
"Returns all my immediate children."
self updateCachedValues.
^ children values.
"
(HGPackageModelRegistry packageNamed: 'stx:libscm') children
"
"Created: / 19-02-2014 / 23:43:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 28-02-2014 / 23:54:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!SCMAbstractPackageWorkingCopy 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>"
!
getRevision
"Return a logical revision of the package, i.e., a revision
on which the next commit will be based on"
^ self subclassResponsibility
"Created: / 28-02-2014 / 09:33:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!SCMAbstractPackageWorkingCopy methodsFor:'file out'!
fileOutClass:cls
|stream|
cls theNonMetaclass methodDictionary do:
[:each|each makeLocalStringSource].
cls theMetaclass methodDictionary do:
[:each|each makeLocalStringSource].
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>"
"Modified (format): / 30-07-2014 / 20:49:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 26-10-2020 / 23:51:41 / Jan Vrany <jan.vrany@labware.com>"
!
fileOutClass:cls on:clsStream
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>"
"Modified: / 26-10-2020 / 23:51:10 / Jan Vrany <jan.vrany@labware.com>"
!
fileOutExtensions: extensionMethods
^self fileOutExtensions: extensionMethods in: self workingCopyRoot
"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>"
! !
!SCMAbstractPackageWorkingCopy methodsFor:'initialization'!
initialize
super initialize.
children := Dictionary new
"Created: / 07-03-2014 / 12:57:14 / 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"
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: / 08-03-2014 / 10:04:34 / 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>"
! !
!SCMAbstractPackageWorkingCopy 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>"
!
computeChildren
| newChildren newChildNames nameSizePlus1 |
nameSizePlus1 := name size + 1.
newChildNames := Smalltalk allLoadedPackageIDs select:[:each |
(each startsWith: name)
and:[ each ~= name
and:[ ((each at: nameSizePlus1) == $/ or:[ (each at: nameSizePlus1) == $: ])
and:[ (each indexOf: $/ startingAt: nameSizePlus1 + 1) == 0]]]].
newChildren := Dictionary new.
newChildNames do:[:each |
| nm |
nm := (each copyFrom: nameSizePlus1 + 1).
newChildren at: nm put: (self childNamed: nm).
].
^ newChildren.
"
(HGPackageModelRegistry packageNamed: 'stx:libscm') children
"
"Created: / 28-02-2014 / 23:53:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 26-03-2016 / 21:20:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
computeClassesHasChanged
"
Answers true iff package classes differs from
those listed in ProjectDefinition>>classNamesAndAttributes"
| listedClasses realClasses pkgDef |
(pkgDef := self definitionOrNilIfNotExists) 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: / 11-06-2015 / 07:01:24 / 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>"
!
computeHasChanges
classesHasChanged == true ifTrue:[
^ true.
].
extensionsHasChanged == true ifTrue:[
^ true.
].
self classes do:[:class |
(self hasChangesInClass: class) ifTrue:[
^ true.
].
].
self extensions do:[:each |
(self hasChangesInMethod: each) ifTrue:[
^ true.
]
].
^ false.
"Created: / 03-03-2014 / 09:08:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
computeIsVirtual
^ self classes isEmpty and:[ self extensions isEmpty ].
"Created: / 28-02-2014 / 23:46:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified (comment): / 05-03-2014 / 23:21:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
updateCachedValues
"Update all cached data"
| sequenceNumber |
sequenceNumber := SCMCodeMonitor sequenceNumber.
sequenceNumber ~~ lastSequenceNumber ifTrue:[
lastSequenceNumber := sequenceNumber.
virtual := self computeIsVirtual.
virtual ifTrue:[
classesHasChanged := false.
extensionsHasChanged := false.
changed := false.
] ifFalse:[
classesHasChanged := (classesHasChanged == true) or:[ self computeClassesHasChanged ].
extensionsHasChanged := (extensionsHasChanged == true) or:[ self computeExtensionsHasChanged ].
changed := self computeHasChanges.
].
children := self computeChildren.
].
"Created: / 28-02-2014 / 23:46:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 07-03-2014 / 22:44:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!SCMAbstractPackageWorkingCopy methodsFor:'queries'!
classesHasChanged
"Return true, if list of classes has changed, i.e., a class
was added, removed or renamed. False otherwise"
self updateCachedValues.
^ classesHasChanged
"Created: / 06-10-2012 / 23:16:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 28-02-2014 / 23:51:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified (comment): / 03-03-2014 / 09:06:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
extensionsHasChanged
"Return true, if list of extensions has changed, i.e., a method
was added, removed or renamed. False otherwise"
self updateCachedValues.
^ extensionsHasChanged
"Created: / 06-10-2012 / 23:16:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 28-02-2014 / 23:51:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified (comment): / 03-03-2014 / 09:07:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
hasChanges
self updateCachedValues.
^ changed
"Created: / 03-03-2014 / 00:10:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 03-03-2014 / 09:08:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
hasChangesInClass: class
"Return true, if there's a change in given class, false otherwise"
"/ Class which is not loaded could not be changed
class isLoaded ifFalse:[^false].
"/ Java classes that has been modified in St/X IDE have
"/ its source string set, those loaded from pre-compiled
"/ .class file has sourceString nil.
class isJavaClass ifTrue:[
^ class sourceString notNil
].
"/ class has been filed in...
class binaryRevisionString isNil ifTrue:[
^ true.
].
class withAllPrivateClassesDo:[:each |
(ChangeSet current includesChangeForClass:each) ifTrue:[ ^ true ].
].
class withAllPrivateClassesDo:[:each |
each theNonMetaclass
methodsDo:[:mth|(self hasChangesInMethod: mth) ifTrue:[^ true]].
each theMetaclass
methodsDo:[:mth|(self hasChangesInMethod: mth) ifTrue:[^ true]].
].
^false
"Created: / 03-03-2014 / 09:10:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 21-04-2015 / 14:53:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
hasChangesInMethod: method
"Return true, if the method's code has been edited, false otherwise"
^ method package = name
"/ This is not strictly true, for byte-code compiled method
"/ sourcePosition is also non-nil...
and:[ method getSourcePosition isNil ]
"Created: / 03-03-2014 / 09:13:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!SCMAbstractPackageWorkingCopy methodsFor:'testing'!
isVirtual
"Return true, if the package is virtual, i.e., there's no code in
the package. False otherwise.
Virtual packages serves merely as containers for nested packages"
self updateCachedValues.
^ virtual
"
(HGPackageModel named: 'stx:libscm') isVirtual
(HGPackageModel named: 'stx:libscm/mercurial') isVirtual
"
"Created: / 27-02-2014 / 22:46:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 28-02-2014 / 23:50:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!SCMAbstractPackageWorkingCopy methodsFor:'utilities'!
, anotherPackageModel
^ SCMCommonPackageModelGroup
with: self
with: anotherPackageModel
"Created: / 26-02-2014 / 22:43:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
ensureWorkingCopy
"raise an error: must be redefined in concrete subclass(es)"
^ self subclassResponsibility
! !
!SCMAbstractPackageWorkingCopy class methodsFor:'documentation'!
version_HG
^ '$Changeset: <not expanded> $'
! !