Mercurial Mercurial > hg > stx-goodies-monticello / diff
summary | shortlog | changelog | graph | tags | bookmarks | branches | files | changeset | file | latest | revisions | annotate | diff | comparison | raw | help
Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
MCPackageLoader.st
changeset 213 9babb070c82c
parent 70 7a1fe064963b
child 319 56c4fc935ac8 
--- a/MCPackageLoader.st	Sat Aug 20 13:43:44 2011 +0200
+++ b/MCPackageLoader.st	Sat Aug 20 13:43:52 2011 +0200
@@ -1,14 +1,20 @@
 "{ Package: 'stx:goodies/monticello' }"
 
 Object subclass:#MCPackageLoader
-	instanceVariableNames:'requirements unloadableDefinitions obsoletions additions removals
-		errorDefinitions provisions'
+	instanceVariableNames:'requirements unloadableDefinitions overrideDefinitions
+		obsoletions additions removals errorDefinitions provisions'
 	classVariableNames:''
 	poolDictionaries:''
 	category:'Monticello-Loading'
 !
 
 
+!MCPackageLoader class methodsFor:'initialization'!
+
+new
+    ^self basicNew initialize
+! !
+
 !MCPackageLoader class methodsFor:'as yet unclassified'!
 
 installSnapshot: aSnapshot
@@ -17,10 +23,6 @@
 		load
 !
 
-new
-	^ self basicNew initialize
-!
-
 unloadPackage: aPackage
 	self new
 		unloadPackage: aPackage;
@@ -33,6 +35,16 @@
 		load
 ! !
 
+!MCPackageLoader methodsFor:'accessing'!
+
+overrideDefinitions
+    ^ overrideDefinitions
+!
+
+unloadableDefinitions
+    ^ unloadableDefinitions
+! !
+
 !MCPackageLoader methodsFor:'patch ops'!
 
 addDefinition: aDefinition
@@ -51,26 +63,57 @@
 !MCPackageLoader methodsFor:'private'!
 
 analyze
-	| sorter |
-	sorter _ self sorterForItems: additions.
-	additions _ sorter orderedItems.
-	requirements _ sorter externalRequirements.
-	unloadableDefinitions _ sorter itemsWithMissingRequirements asSortedCollection.
-	
-	sorter _ self sorterForItems: removals.
-	removals _ sorter orderedItems reversed.
+        | sorter |
+        sorter := self sorterForItems: additions.
+        additions := sorter orderedItems.
+        requirements := sorter externalRequirements.
+        unloadableDefinitions := sorter itemsWithMissingRequirements asSortedCollection.
+
+        overrideDefinitions := additions select:[:e|e isOverrideDefinition].
+        additions := additions reject: [:e|e isOverrideDefinition].
+        
+        sorter := self sorterForItems: removals.
+        removals := sorter orderedItems reversed.
+
+    "Modified: / 08-11-2010 / 17:34:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 basicLoad
-	errorDefinitions _ OrderedCollection new.
-	[[additions do: [:ea | self tryToLoad: ea] displayingProgress: 'Loading...'.
-	removals do: [:ea | ea unload] displayingProgress: 'Cleaning up...'.
-	self shouldWarnAboutErrors ifTrue: [self warnAboutErrors].
-	errorDefinitions do: [:ea | ea loadOver: (self obsoletionFor: ea)] displayingProgress: 'Reloading...'.
-	additions do: [:ea | ea postloadOver: (self obsoletionFor: ea)] displayingProgress: 'Initializing...']
-		on: InMidstOfFileinNotification 
-		do: [:n | n resume: true]]
-			ensure: [self flushChangesFile]
+        | allowEmptyStatements allowSqueakExtensions |
+
+        allowEmptyStatements := ParserFlags allowEmptyStatements.
+        allowSqueakExtensions := ParserFlags allowSqueakExtensions.
+        ParserFlags allowEmptyStatements: true.
+        ParserFlags allowSqueakExtensions: true.
+
+        errorDefinitions := OrderedCollection new.
+        self warnAboutUnloadables.
+
+
+        [[
+        | oldErrorDefinitions |
+        additions do: [:ea | self tryToLoad: ea] displayingProgress: 'Loading...'.
+        removals do: [:ea | ea unload] displayingProgress: 'Cleaning up...'.
+        self shouldWarnAboutErrors ifTrue: [self warnAboutErrors].
+        oldErrorDefinitions := errorDefinitions.        
+        errorDefinitions := OrderedCollection new.
+        oldErrorDefinitions do: [:ea | self tryToLoad: ea] displayingProgress: 'Reloading...'.
+        additions do: [:ea | ea postloadOver: (self obsoletionFor: ea)] displayingProgress: 'Initializing...'.
+
+        self warnAboutOverrides.
+        self warnAboutErrors.
+
+        ]
+        
+                on: InMidstOfFileinNotification 
+                do: [:n | n resume: true]]
+                        ensure: 
+                            [self flushChangesFile.
+                            ParserFlags allowEmptyStatements: allowEmptyStatements.
+                            ParserFlags allowSqueakExtensions: allowSqueakExtensions.        
+                            ]
+
+    "Modified: / 08-11-2010 / 23:49:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 dependencyWarning
@@ -90,15 +133,35 @@
 !
 
 flushChangesFile
-	"The changes file is second in the SourceFiles array"
+        "The changes file is second in the SourceFiles array"
+
+        "(SourceFiles at: 2) flush"
+
+    "Modified: / 11-09-2010 / 18:32:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+ifInteractive: aBlock
+
+    ^self ifInteractive: aBlock else:[]
 
-	(SourceFiles at: 2) flush
+    "Created: / 06-03-2011 / 20:32:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+ifInteractive: interactiveBlock else: noninteractiveBlock
+
+    MCInteractiveLoadingQuery query 
+        ifTrue:[interactiveBlock value]
+        ifFalse:[noninteractiveBlock value].
+
+    "Created: / 06-03-2011 / 20:31:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 initialize
-	additions _ OrderedCollection new.
-	removals _ OrderedCollection new.
-	obsoletions _ Dictionary new.
+	super initialize.
+	additions := OrderedCollection new.
+	removals := OrderedCollection new.
+	obsoletions := Dictionary new.
+
 !
 
 obsoletionFor: aDefinition
@@ -114,7 +177,7 @@
 !
 
 provisions
-	^ provisions ifNil: [provisions _ Set withAll: Smalltalk keys]
+	^ provisions ifNil: [provisions := Set withAll: Smalltalk keys]
 !
 
 shouldWarnAboutErrors
@@ -123,7 +186,7 @@
 
 sorterForItems: aCollection
 	| sorter |
-	sorter _ MCDependencySorter items: aCollection.
+	sorter := MCDependencySorter items: aCollection.
 	sorter addExternalProvisions: self provisions.
 	^ sorter
 !
@@ -132,19 +195,30 @@
 	[aDefinition loadOver: (self obsoletionFor: aDefinition)] on: Error do: [errorDefinitions add: aDefinition].
 !
 
+tryToLoadAll: definitions label: label
+
+    definitions do:[:e|self tryToLoad: e] displayingProgress: label.
+
+    "Created: / 09-11-2010 / 17:17:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
 useChangeSetNamed: baseName during: aBlock
-	"Use the named change set, or create one with the given name."
-	| changeHolder oldChanges newChanges |
-	changeHolder _ (ChangeSet respondsTo: #newChanges:)
-						ifTrue: [ChangeSet]
-						ifFalse: [Smalltalk].
-	oldChanges _ (ChangeSet respondsTo: #current)
-						ifTrue: [ChangeSet current]
-						ifFalse: [Smalltalk changes].
+        "Use the named change set, or create one with the given name."
+        | changeHolder oldChanges newChanges |
+        changeHolder := (ChangeSet respondsTo: #newChanges:)
+                                                ifTrue: [ChangeSet]
+                                                ifFalse: [Smalltalk].
+        oldChanges := (ChangeSet respondsTo: #current)
+                                                ifTrue: [ChangeSet current]
+                                                ifFalse: [Smalltalk changes].
 
-	newChanges _ (ChangeSorter changeSetNamed: baseName) ifNil: [ ChangeSet new name: baseName ].
-	changeHolder newChanges: newChanges.
-	[aBlock value] ensure: [changeHolder newChanges: oldChanges].
+        "/JV @ 2010-09-11: Don't cate about changes
+        "/newChanges := (ChangeSorter changeSetNamed: baseName) ifNil: [ ChangeSet new name: baseName ].
+        "/changeHolder newChanges: newChanges.
+        "/[aBlock value] ensure: [changeHolder newChanges: oldChanges].
+        Class withoutUpdatingChangesDo: aBlock
+
+    "Modified: / 08-11-2010 / 20:01:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 useNewChangeSetDuring: aBlock
@@ -155,20 +229,76 @@
 	^self useChangeSetNamed: (ChangeSet uniqueNameLike: baseName) during: aBlock
 !
 
-warnAboutDependencies 
-	self notify: self dependencyWarning
+warnAboutDependencies
+    "
+    
+    
+        self notify: self dependencyWarning
+    "
+
+    "Modified: / 13-10-2010 / 15:44:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 warnAboutErrors
-	self notify: self errorDefinitionWarning.
+
+    | changes |
+
+    errorDefinitions isNilOrEmptyCollection ifTrue:[^self].
+    changes := ChangeSet withAll:(errorDefinitions select:[:e|e notNil] thenCollect:[:e|e asChange]).
+
+    changes := Tools::ChangeSetBrowser
+                openOn: changes
+                label:'Error definitions'.
+
+    "Created: / 08-11-2010 / 20:19:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 06-03-2011 / 20:39:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+warnAboutOverrides
+
+    | changes |
+
+    overrideDefinitions isNilOrEmptyCollection ifTrue:[^self].
+    self ifInteractive:[
+        changes := ChangeSet withAll:(overrideDefinitions collect:[:e|e asChange]).
+        changes := Tools::ChangeSetBrowser
+                    confirmChanges: changes
+                    label:'Overridden definitions. Load anyway?'.
+        self tryToLoadAll: (changes collect:[:e|e mcDefinition]) label: 'Loading overrides...'.
+    ] else:[
+        self tryToLoadAll: overrideDefinitions label: 'Loading overrides...'.
+    ]
+
+    "Created: / 08-11-2010 / 20:19:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 06-03-2011 / 20:33:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+warnAboutUnloadables
+
+    | changes |
+
+    unloadableDefinitions isNilOrEmptyCollection ifTrue:[^self].
+    self ifInteractive:[
+        changes := ChangeSet withAll:(unloadableDefinitions collect:[:e|e asChange]).
+        changes := Tools::ChangeSetBrowser
+                    confirmChanges: changes
+                    label:'Unsatisfied dependencies. Load anyway?'.
+        self tryToLoadAll: (changes collect:[:e|e mcDefinition]) label: 'Loading unloadables...'.
+    ] else:[
+        self tryToLoadAll: unloadableDefinitions label: 'Loading unloadables...'.
+    ]
+
+    "Created: / 08-11-2010 / 20:19:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 06-03-2011 / 20:36:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
 
 !MCPackageLoader methodsFor:'public'!
 
 installSnapshot: aSnapshot
 	| patch |
-	patch _ aSnapshot patchRelativeToBase: MCSnapshot empty.
+	patch := aSnapshot patchRelativeToBase: MCSnapshot empty.
 	patch applyTo: self.
+
 !
 
 load
@@ -194,15 +324,26 @@
 !
 
 updatePackage: aPackage withSnapshot: aSnapshot
-	|  patch packageSnap |
-	packageSnap _ aPackage snapshot.
-	patch _ aSnapshot patchRelativeToBase: packageSnap.
-	patch applyTo: self.
-	packageSnap definitions do: [:ea | self provisions addAll: ea provisions]
+        |  patch packageSnap |
+        MCStXPackageQuery answer: aPackage name do:
+            [packageSnap := aPackage snapshot.
+            patch := aSnapshot patchRelativeToBase: packageSnap.
+            patch applyTo: self.
+            packageSnap definitions do: [:ea | self provisions addAll: ea provisions]]
+
+    "Modified: / 14-09-2010 / 22:09:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
 
 !MCPackageLoader class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/goodies/monticello/MCPackageLoader.st,v 1.1 2006-11-22 13:12:56 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/goodies/monticello/MCPackageLoader.st,v 1.2 2011-08-20 11:43:52 cg Exp $'
+!
+
+version_CVS
+    ^ '$Header: /cvs/stx/stx/goodies/monticello/MCPackageLoader.st,v 1.2 2011-08-20 11:43:52 cg Exp $'
+!
+
+version_SVN
+    ^ '§Id: MCPackageLoader.st 27 2011-03-07 03:48:48Z vranyj1 §'
 ! !
hg/stx-goodies-monticello