Added support for pluggable pre/postLoad hooks based on annotated method.
--- a/ProjectDefinition.st Tue Nov 20 22:50:28 2012 +0000
+++ b/ProjectDefinition.st Tue Nov 20 23:15:42 2012 +0000
@@ -4668,72 +4668,74 @@
|newStuffHasBeenLoaded meOrMySecondIncarnation|
self projectIsLoaded ifTrue:[
- asAutoloaded ifFalse:[
- "/ to be considered !!
+ asAutoloaded ifFalse:[
+ "/ to be considered !!
"/ self isFullyLoaded ifFalse:[
"/ self hasAllExtensionsLoaded ifFalse:[
"/ self loadExtensions.
"/ ].
"/ self loadAllAutoloadedClasses
"/ ].
- ].
- ^ false
+ ].
+ ^ false
].
thisContext isRecursive ifTrue:[self breakPoint:#cg. ^ false]. "/ avoid endless loops
newStuffHasBeenLoaded := false.
(self infoPrinting and:[Smalltalk silentLoading not]) ifTrue:[
- "/ thisContext fullPrintAll.
- Transcript showCR:('loading %1%2...'
- bindWith:(asAutoloaded ifTrue:['as autoloaded '] ifFalse:[''])
- with:self name).
+ "/ thisContext fullPrintAll.
+ Transcript showCR:('loading %1%2...'
+ bindWith:(asAutoloaded ifTrue:['as autoloaded '] ifFalse:[''])
+ with:self name).
].
self rememberOverwrittenExtensionMethods.
self activityNotification:'Executing pre-load action'.
+ self executeHooks: #preLoad.
self preLoadAction.
meOrMySecondIncarnation := self.
Class withoutUpdatingChangesDo:[
- self activityNotification:'Loading prerequisities'.
- self loadPreRequisitesAsAutoloaded:asAutoloaded.
-
- self checkPrerequisitesForLoading.
-
- asAutoloaded ifFalse:[
- self loadClassLibrary.
- "/ could have overloaded my first incarnation
- meOrMySecondIncarnation := (Smalltalk at:(self name)) ? self.
- meOrMySecondIncarnation ~~ self ifTrue:[
- meOrMySecondIncarnation fetchSlotsFrom:self.
- ].
- ].
-
- self hasAllExtensionsLoaded ifFalse:[
- self activityNotification:'Loading extensions'.
- newStuffHasBeenLoaded := newStuffHasBeenLoaded | meOrMySecondIncarnation loadExtensions.
- ].
- self hasAllClassesLoaded ifFalse:[
- self activityNotification:'Loading classes'.
- newStuffHasBeenLoaded := newStuffHasBeenLoaded | (meOrMySecondIncarnation loadAllClassesAsAutoloaded:asAutoloaded).
- ].
+ self activityNotification:'Loading prerequisities'.
+ self loadPreRequisitesAsAutoloaded:asAutoloaded.
+
+ self checkPrerequisitesForLoading.
+
+ asAutoloaded ifFalse:[
+ self loadClassLibrary.
+ "/ could have overloaded my first incarnation
+ meOrMySecondIncarnation := (Smalltalk at:(self name)) ? self.
+ meOrMySecondIncarnation ~~ self ifTrue:[
+ meOrMySecondIncarnation fetchSlotsFrom:self.
+ ].
+ ].
+
+ self hasAllExtensionsLoaded ifFalse:[
+ self activityNotification:'Loading extensions'.
+ newStuffHasBeenLoaded := newStuffHasBeenLoaded | meOrMySecondIncarnation loadExtensions.
+ ].
+ self hasAllClassesLoaded ifFalse:[
+ self activityNotification:'Loading classes'.
+ newStuffHasBeenLoaded := newStuffHasBeenLoaded | (meOrMySecondIncarnation loadAllClassesAsAutoloaded:asAutoloaded).
+ ].
"/ no, don't load subProjects here - will lead to a recursion, which leads
"/ to some classes being loaded from source (soap)
- self activityNotification:'Loading sub projects'.
- meOrMySecondIncarnation loadSubProjectsAsAutoloaded:asAutoloaded.
+ self activityNotification:'Loading sub projects'.
+ meOrMySecondIncarnation loadSubProjectsAsAutoloaded:asAutoloaded.
].
self activityNotification:('Executing post-load action for %1' bindWith:self package).
"/ mhmh - already done for dll-loaded packages
"/ meOrMySecondIncarnation initializeAllClasses.
meOrMySecondIncarnation postLoadAction.
+ meOrMySecondIncarnation executeHooks: #postLoad.
meOrMySecondIncarnation projectIsLoaded:true.
meOrMySecondIncarnation ~~ self ifTrue:[
- self projectIsLoaded:true.
+ self projectIsLoaded:true.
].
self activityNotification:('Done (%1).' bindWith:self package).
@@ -4741,8 +4743,8 @@
"Created: / 17-08-2006 / 01:01:41 / cg"
"Modified: / 30-10-2008 / 08:16:21 / Jan Vrany <vranyj1@fel.cvut.cz>"
- "Modified: / 22-08-2009 / 12:02:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 04-09-2011 / 10:01:53 / cg"
+ "Modified: / 20-11-2012 / 23:06:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
unloadPackage
@@ -4753,26 +4755,29 @@
thisContext isRecursive ifTrue:[^ false].
(self infoPrinting and:[Smalltalk silentLoading not]) ifTrue:[
- "/ thisContext fullPrintAll.
- Transcript show:'unloading '; showCR:self name.
+ "/ thisContext fullPrintAll.
+ Transcript show:'unloading '; showCR:self name.
].
self activityNotification:'Executing pre-unload action'.
self preUnloadAction.
+ self executeHooks: #preUnload.
self activityNotification:'Restoring original methods'.
self restoreOverwrittenExtensionMethods.
Class withoutUpdatingChangesDo:[
- self activityNotification:'Unloading sunprojects'.
- self unloadSubProjects.
-
- self activityNotification:'Unloading classes'.
- self unloadClassLibrary.
- self unloadAllClasses.
+ self activityNotification:'Unloading sunprojects'.
+ self unloadSubProjects.
+
+ self activityNotification:'Unloading classes'.
+ self unloadClassLibrary.
+ self unloadAllClasses.
].
self projectIsLoaded:false.
^ true
+
+ "Modified: / 20-11-2012 / 23:06:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!ProjectDefinition class methodsFor:'misc ui support'!
@@ -5533,6 +5538,23 @@
"
!
+executeHooks: hook
+ "Execute all hooks annotate by given symbol. Currently supported
+ hooks are: #preLoad, #postLoad, #preUnload."
+
+ self class selectorsAndMethodsDo:[:selector :method|
+ (method annotationAt: hook) notNil ifTrue:[
+ method numArgs == 0 ifTrue:[
+ self perform: selector
+ ] ifFalse:[
+ self error:'Hook for %1 must have no arguments' mayProceed: true.
+ ]
+ ]
+ ]
+
+ "Created: / 20-11-2012 / 23:00:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
extensionOverwriteInfo
^ extensionOverwriteInfo
!
@@ -6854,7 +6876,7 @@
!ProjectDefinition class methodsFor:'documentation'!
version
- ^ '$Id: ProjectDefinition.st 10865 2012-11-20 22:50:28Z vranyj1 $'
+ ^ '$Id: ProjectDefinition.st 10866 2012-11-20 23:15:42Z vranyj1 $'
!
version_CVS
@@ -6862,7 +6884,7 @@
!
version_SVN
- ^ '$Id:: ProjectDefinition.st 10865 2012-11-20 22:50:28Z vranyj1 $'
+ ^ '$Id:: ProjectDefinition.st 10866 2012-11-20 23:15:42Z vranyj1 $'
! !
ProjectDefinition initialize!