--- a/ProjectDefinition.st Thu Aug 18 15:13:06 2011 +0200
+++ b/ProjectDefinition.st Thu Aug 18 15:22:44 2011 +0200
@@ -14,7 +14,7 @@
Object subclass:#ProjectDefinition
instanceVariableNames:''
classVariableNames:'LibraryType GUIApplicationType NonGUIApplicationType
- PackagesBeingLoaded Verbose AbbrevDictionary'
+ PackagesBeingLoaded Verbose AbbrevDictionary AccessLock'
poolDictionaries:''
category:'System-Support-Projects'
!
@@ -26,6 +26,13 @@
"
!
+Object subclass:#AbbrevEntry
+ instanceVariableNames:'className fileName category numClassInstVars'
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:ProjectDefinition
+!
+
!ProjectDefinition class methodsFor:'documentation'!
buildingMakefiles
@@ -1131,12 +1138,13 @@
LibraryType := #'Library'.
GUIApplicationType := #'GUI-Application'.
NonGUIApplicationType := #'NonGUI-Application'.
+ AccessLock := Semaphore forMutualExclusion.
"
self initialize
"
- "Modified: / 23-10-2006 / 16:40:58 / cg"
+ "Modified: / 18-08-2011 / 13:48:31 / cg"
!
initializeAllProjectDefinitions
@@ -1165,47 +1173,66 @@
installAutoloadedClasses
"install all of my autoloaded classes (if any)"
- (self classNamesForWhich:[:nm :attr | (attr includes:#autoload)])
- do:[:className |
- "/ 'install as autoloaded: ' errorPrint. className errorPrintCR.
- (Smalltalk classNamed:className) isNil ifTrue:[
- Error handle:[:ex |
- (self name,' [warning]: failed to install autoloaded: ',className) errorPrintCR.
- (self name,' [info]: reason: ',ex description) errorPrintCR.
- "/ thisContext fullPrintAll.
- ] do:[
- Smalltalk
- installAutoloadedClassNamed:className
- category:'* as yet unknown category *'
- package:self package
- revision:nil
- ].
- ].
- ].
+ self autoloaded_classNames do:[:className |
+ |cls classFilenameFromAbbreviations entry|
+
+ "/ 'install as autoloaded: ' errorPrint. className errorPrintCR.
+ (cls := Smalltalk classNamed:className) isNil ifTrue:[
+ Error handle:[:ex |
+ (self name,' [warning]: failed to install autoloaded: ',className) errorPrintCR.
+ (self name,' [info]: reason: ',ex description) errorPrintCR.
+ "/ thisContext fullPrintAll.
+ ] do:[
+ cls := Smalltalk
+ installAutoloadedClassNamed:className
+ category:'* as yet unknown category *'
+ package:self package
+ revision:nil
+ ].
+ cls notNil ifTrue:[
+ entry := self abbrevs at:(cls name) ifAbsent:nil.
+ entry notNil ifTrue:[
+ classFilenameFromAbbreviations := entry fileName.
+ classFilenameFromAbbreviations notNil ifTrue:[
+ classFilenameFromAbbreviations := classFilenameFromAbbreviations,'.st'.
+ (classFilenameFromAbbreviations ~= cls getClassFilename) ifTrue:[
+ cls setClassFilename:classFilenameFromAbbreviations
+ ].
+ ].
+ ]
+ ].
+ ].
+ ].
Smalltalk isStandAloneApp ifFalse:[
- Smalltalk addStartBlock:[
- |abbrevs|
-
- Class withoutUpdatingChangesDo:[
- abbrevs := self abbrevs.
- self classNames do:
- [:nm | | cls|
- cls := Smalltalk at: nm.
- (cls notNil and:[cls isLoaded not and:[(abbrevs at:cls name ifAbsent:[nil]) size >= 4]]) ifTrue:
- [cls category:
- ((abbrevs at: cls name) at: 4)]]]
- ]
+ "/ patch the categories
+
+ Class withoutUpdatingChangesDo:[
+ |abbrevs entry|
+
+ abbrevs := self abbrevs.
+ self classNames do:[:nm |
+ |cls|
+
+ ((cls := Smalltalk at: nm) notNil
+ and:[ cls isLoaded not
+ and:[ (entry := abbrevs at:cls name ifAbsent:[nil]) notNil
+ ]]) ifTrue:[
+ cls category: (entry category)
+ ]
+ ]
+ ]
]
"
stx_libbasic installAutoloadedClasses
stx_libhtml installAutoloadedClasses
+ stx_libtool2 installAutoloadedClasses
"
"Created: / 23-10-2006 / 16:02:12 / cg"
- "Modified: / 08-11-2006 / 17:08:06 / cg"
"Modified: / 06-03-2011 / 18:26:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified (comment): / 18-08-2011 / 15:21:06 / cg"
! !
!ProjectDefinition class methodsFor:'code generation'!
@@ -4570,29 +4597,40 @@
!ProjectDefinition class methodsFor:'private'!
abbrevs
- | abbrevs file stream |
-
- AbbrevDictionary isNil ifTrue:[
- AbbrevDictionary := WeakIdentityDictionary new.
+ "return a dictionary containing my abbreviations;
+ this dictionary is read from my project-directory's abbrev.stc file,
+ and cached for future use"
+
+ |abbrevs|
+
+ AccessLock critical:[
+ |mustRead file|
+
+ AbbrevDictionary isNil ifTrue:[
+ AbbrevDictionary := WeakIdentityDictionary new.
+ ].
+
+ mustRead := false.
+ abbrevs := AbbrevDictionary at:self ifAbsent:[ mustRead := true. Dictionary new ].
+
+ mustRead ifTrue:[
+ file := self packageDirectory / 'abbrev.stc'.
+ file exists ifTrue: [
+ file readingFileDo:[:stream |
+ Smalltalk
+ withAbbreviationsFromStream:stream
+ do:[:nm :fn :pkg :cat :sz|
+ abbrevs at: nm put: (AbbrevEntry new className:nm fileName:fn category:cat numClassInstVars:sz)
+ ]
+ ]
+ ].
+ ].
].
- [
- abbrevs := AbbrevDictionary at:self ifAbsentPut:[ Dictionary new ].
- ] valueUninterruptably.
-
- file := self packageDirectory / 'abbrev.stc'.
- file exists ifTrue: [
- stream := file readStream.
- [Smalltalk
- withAbbreviationsFromStream:stream
- do:[:nm :fn :pkg :cat :sz|
- abbrevs at: nm put: (Array with: nm with: fn with: pkg with: cat with: sz)]
- ] ensure:[
- stream close
- ]
- ].
+
^abbrevs
"Created: / 06-03-2011 / 18:25:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 18-08-2011 / 14:24:15 / cg"
!
additionalClassAttributesFor: aClass
@@ -5452,27 +5490,32 @@
!
loadClass: className asAutoloaded: asAutoloaded language: lang
-
- | packageDir classFile |
-
- "Handle smalltalk classes specially to provide backward
- compatibility"
+ | packageDir classFile entry category numClassInstVars cls|
+
+ "Handle smalltalk classes specially to provide backward compatibility"
lang isSmalltalk ifTrue:[
- ^asAutoloaded ifTrue:[
- Smalltalk
- installAutoloadedClassNamed: className
- category: ((self abbrevs at: className ifAbsent:[#(nil nil nil #autoloaded)]) at: 4)
- package: self package
- revision: nil
- numClassInstVars: ((self abbrevs at: className ifAbsent:[#(nil nil nil nil 0)]) at: 5)
- ] ifFalse: [
- Smalltalk
- fileInClass:className
- package:self package
- initialize:false
- lazy:false
- silent:true
- ]
+ entry := self abbrevs at: className ifAbsent:[nil].
+
+ asAutoloaded ifTrue:[
+ category := entry isNil ifTrue:[#autoloaded] ifFalse:[entry category].
+ numClassInstVars := entry isNil ifTrue:[0] ifFalse:[entry numClassInstVars].
+ cls := Smalltalk
+ installAutoloadedClassNamed: className
+ category: category
+ package: self package
+ revision: nil
+ numClassInstVars:numClassInstVars.
+ entry notNil ifTrue:[
+ cls setClassFilename:(entry fileName,'.st').
+ ].
+ ^ cls.
+ ].
+ ^ Smalltalk
+ fileInClass:className
+ package:self package
+ initialize:false
+ lazy:false
+ silent:true
].
"For non-smalltalk language do"
@@ -5486,6 +5529,7 @@
"Created: / 19-06-2010 / 09:11:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 06-03-2011 / 18:29:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 18-08-2011 / 14:22:15 / cg"
!
loadClassLibrary
@@ -6337,10 +6381,39 @@
"Modified: / 08-02-2011 / 10:03:49 / cg"
! !
+!ProjectDefinition::AbbrevEntry methodsFor:'accessing'!
+
+category
+ ^ category
+!
+
+className
+ ^ className
+!
+
+className:classNameArg fileName:fileNameArg category:categoryArg numClassInstVars:numClassInstVarsArg
+ className := classNameArg.
+ fileName := fileNameArg.
+ category := categoryArg.
+ numClassInstVars := numClassInstVarsArg.
+
+ "Created: / 18-08-2011 / 14:18:30 / cg"
+!
+
+fileName
+ ^ fileName
+!
+
+numClassInstVars
+ ^ numClassInstVars
+
+ "Created: / 18-08-2011 / 14:18:37 / cg"
+! !
+
!ProjectDefinition class methodsFor:'documentation'!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/ProjectDefinition.st,v 1.342 2011-08-08 13:00:12 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ProjectDefinition.st,v 1.343 2011-08-18 13:22:44 cg Exp $'
!
version_SVN