--- a/Smalltalk.st Fri Nov 08 19:45:06 2002 +0100
+++ b/Smalltalk.st Mon Nov 11 10:29:09 2002 +0100
@@ -16,7 +16,7 @@
instanceVariableNames:''
classVariableNames:'StartBlocks ImageStartBlocks ExitBlocks CachedClasses SystemPath
StartupClass StartupSelector StartupArguments CommandLine
- CommandLineArguments CachedAbbreviations SilentLoading
+ CommandName CommandLineArguments CachedAbbreviations SilentLoading
Initializing StandAlone HeadlessOperation DebuggingStandAlone LogDoits LoadBinaries
RealSystemPath ResourcePath SourcePath BitmapPath BinaryPath
FileInPath PackagePath BinaryDirName ResourceDirName
@@ -105,7 +105,10 @@
CommandLine <String> Unix (OS-) command line
+ CommandName <String> the command (i.e. argv[0])
+
CommandLineArguments <Array> Unix (OS-) command line arguments broken into words
+ CommandName has been stripped off.
(initially set by the VM)
SilentLoading <Boolean> suppresses messages during fileIn and in compiler
@@ -182,20 +185,20 @@
|envString i langString terrString|
StandAlone isNil ifTrue:[
- StandAlone := false.
+ StandAlone := false.
].
HeadlessOperation isNil ifTrue:[
- HeadlessOperation := false.
+ HeadlessOperation := false.
].
"
extract Language and LanguageTerritory from LANG variable.
valid are for example:
- en_en / en
- en_us
- en_gb
- de_de / de
- de_at (for Austria)
+ en_en / en
+ en_us
+ en_gb
+ de_de / de
+ de_at (for Austria)
"
Language := #en.
@@ -203,35 +206,35 @@
"Format of LANG is: language[_territory][.codeset][@modifier]
- language ISO-639 Language code
- territory ISO-3166 Contry code"
+ language ISO-639 Language code
+ territory ISO-3166 Contry code"
envString := OperatingSystem getEnvironment:'LANG'.
envString size > 0 ifTrue:[
- i := envString indexOf:$@.
- (i ~~ 0) ifTrue:[
- envString := envString copyTo:(i - 1).
- LanguageModifier := (envString copyFrom:(i + 1)) asLowercase asSymbol.
- ] ifFalse:[
- LanguageModifier := nil.
- ].
- i := envString indexOf:$..
- (i ~~ 0) ifTrue:[
- envString := envString copyTo:(i - 1).
- LanguageCodeset := (envString copyFrom:(i + 1)) asLowercase asSymbol
- ] ifFalse:[
- LanguageCodeset := #'iso8859-1'.
- ].
- i := envString indexOf:$_.
- (i == 0) ifTrue:[
- langString := envString.
- terrString := envString
- ] ifFalse:[
- langString := envString copyTo:(i - 1).
- terrString := envString copyFrom:(i + 1)
- ].
- Language := langString asLowercase asSymbol.
- LanguageTerritory := terrString asLowercase asSymbol
+ i := envString indexOf:$@.
+ (i ~~ 0) ifTrue:[
+ envString := envString copyTo:(i - 1).
+ LanguageModifier := (envString copyFrom:(i + 1)) asLowercase asSymbol.
+ ] ifFalse:[
+ LanguageModifier := nil.
+ ].
+ i := envString indexOf:$..
+ (i ~~ 0) ifTrue:[
+ envString := envString copyTo:(i - 1).
+ LanguageCodeset := (envString copyFrom:(i + 1)) asLowercase asSymbol
+ ] ifFalse:[
+ LanguageCodeset := #'iso8859-1'.
+ ].
+ i := envString indexOf:$_.
+ (i == 0) ifTrue:[
+ langString := envString.
+ terrString := envString
+ ] ifFalse:[
+ langString := envString copyTo:(i - 1).
+ terrString := envString copyFrom:(i + 1)
+ ].
+ Language := langString asLowercase asSymbol.
+ LanguageTerritory := terrString asLowercase asSymbol
].
"
@@ -281,14 +284,13 @@
"redefine debug-tools, if view-classes exist"
Display notNil ifTrue:[
- InspectorView notNil ifTrue:[
- Inspector := InspectorView
- ].
- DebugView notNil ifTrue:[
-'33' printCR.
- Debugger := DebugView
- ].
- Display initialize
+ InspectorView notNil ifTrue:[
+ Inspector := InspectorView
+ ].
+ DebugView notNil ifTrue:[
+ Debugger := DebugView
+ ].
+ Display initialize
]
"
@@ -402,8 +404,8 @@
This one is the very first entry into the smalltalk world,
right after startup, ususally immediately followed by Smalltalk>>start.
Notice:
- this is not called when an image is restarted; in this
- case the show starts in Smalltalk>>restart."
+ this is not called when an image is restarted; in this
+ case the show starts in Smalltalk>>restart."
|idx|
@@ -412,38 +414,36 @@
AbstractOperatingSystem initializeConcreteClass.
CommandLineArguments isNil ifTrue:[
- CommandLineArguments := #('stx').
+ CommandLineArguments := #('stx').
].
CommandLine := CommandLineArguments copy.
CommandLineArguments := CommandLineArguments asOrderedCollection.
- CommandLineArguments removeAtIndex:1. "/ the command
+ CommandName := CommandLineArguments removeFirst. "/ the command
SilentLoading := (CommandLineArguments includes:'--silentStartup').
DebuggingStandAlone := false.
StandAlone ifTrue:[
- InfoPrinting := false.
- ObjectMemory infoPrinting:false.
-
- idx := CommandLineArguments indexOf:'-debug'.
- idx ~~ 0 ifTrue:[
- CommandLineArguments removeAtIndex:idx.
+ InfoPrinting := false.
+ ObjectMemory infoPrinting:false.
+
+ idx := CommandLineArguments indexOf:'-debug'.
+ idx ~~ 0 ifTrue:[
+ CommandLineArguments removeAtIndex:idx.
DebuggingStandAlone := true.
- ].
- DebuggingStandAlone ifTrue:[
-'11' printCR.
- Debugger := MiniDebugger.
+ ].
+ DebuggingStandAlone ifTrue:[
+ Debugger := MiniDebugger.
].
] ifFalse:[
- "/
- "/ define low-level debugging tools - graphical classes are not prepared yet
- "/ to handle things.
- "/ This will bring us into the MiniDebugger when an error occurs during startup.
- "/
- Inspector := MiniInspector.
-'22' printCR.
- Debugger := MiniDebugger.
+ "/
+ "/ define low-level debugging tools - graphical classes are not prepared yet
+ "/ to handle things.
+ "/ This will bring us into the MiniDebugger when an error occurs during startup.
+ "/
+ Inspector := MiniInspector.
+ Debugger := MiniDebugger.
].
"/
@@ -475,12 +475,12 @@
Compiler := ByteCodeCompiler.
Compiler isNil ifTrue:[
- "
- ByteCodeCompiler is not in the system (i.e. has not been linked in)
- this allows at least immediate evaluations for runtime systems without compiler
- NOTICE: a parser is always needed, otherwise we cannot read resource files etc.
- "
- Compiler := Parser
+ "
+ ByteCodeCompiler is not in the system (i.e. has not been linked in)
+ this allows at least immediate evaluations for runtime systems without compiler
+ NOTICE: a parser is always needed, otherwise we cannot read resource files etc.
+ "
+ Compiler := Parser
].
"/
@@ -598,9 +598,9 @@
anObject isNil ifTrue:[^ self].
objects := SpecialObjectArray.
1 to: objects size do: [:i |
- (objects at: i) == anObject ifTrue: [
- objects at: i put: nil
- ]
+ (objects at: i) == anObject ifTrue: [
+ objects at: i put: nil
+ ]
].
! !
@@ -616,17 +616,17 @@
|newClass|
indexed == #none ifTrue:[
- newClass := superclass
- subclass:nameSymbol
- instanceVariableNames:instVars
- classVariableNames:''
- poolDictionaries:''
- category:category
- inEnvironment:self.
- classInstVars size > 0 ifTrue:[
- newClass class instanceVariableNames:classInstVars.
- ].
- ^ newClass
+ newClass := superclass
+ subclass:nameSymbol
+ instanceVariableNames:instVars
+ classVariableNames:''
+ poolDictionaries:''
+ category:category
+ inEnvironment:self.
+ classInstVars size > 0 ifTrue:[
+ newClass class instanceVariableNames:classInstVars.
+ ].
+ ^ newClass
].
self halt:'not yet supported'.
! !
@@ -786,16 +786,16 @@
removeKey:aKey
"remove the association stored under the key-argument from the globals dictionary.
WARNING:
- this is somewhat dangerous: conceptionally, the association is removed,
- to which machine & byte compiled code refers if it accesses a global.
- If there are still global accesses in some literalArray or from machine-compiled code,
- it continues to reference the globals value via that obsolete association and gets a nil
- value. (which is correct)
- However, if that global is later reintroduced, a new association will be created and
- the new global now referenced via the new association.
- The old accesses will still see nil, although the globals value is actually non-nil
- (this is questionable).
- To avoid this problem, the #removeClass: method never removed the key."
+ this is somewhat dangerous: conceptionally, the association is removed,
+ to which machine & byte compiled code refers if it accesses a global.
+ If there are still global accesses in some literalArray or from machine-compiled code,
+ it continues to reference the globals value via that obsolete association and gets a nil
+ value. (which is correct)
+ However, if that global is later reintroduced, a new association will be created and
+ the new global now referenced via the new association.
+ The old accesses will still see nil, although the globals value is actually non-nil
+ (this is questionable).
+ To avoid this problem, the #removeClass: method never removed the key."
CachedClasses := nil.
@@ -966,7 +966,7 @@
flushCachedClass:aClass
CachedClasses notNil ifTrue:[
- CachedClasses remove:aClass ifAbsent:[]
+ CachedClasses remove:aClass ifAbsent:[]
]
!
@@ -990,31 +990,31 @@
oldName := aClass name.
sym := oldNameSym := oldName asSymbol.
((self at:oldNameSym) == aClass) ifFalse:[
- "check other name ..."
- (self includes:aClass) ifFalse:[
- 'Smalltalk [warning]: no such class: ' errorPrint. oldName errorPrintCR.
- ^ self
- ].
- "
- the class has changed its name - without telling me ...
- what should be done in this case ?
- "
- 'Smalltalk [warning]: class ' errorPrint. oldName errorPrint.
- ' has changed its name' errorPrintCR.
-
- "/
- "/ might be an alias (i.e. removing a compatibility name)
- "/
- actualName := self keyAtValue:aClass.
- ('Smalltalk [info]: ' , oldName , ' is actually stored as ' , actualName , '.') infoPrintCR.
- sym := actualName asSymbol.
- oldName := actualName asString.
- wrongName := true.
+ "check other name ..."
+ (self includes:aClass) ifFalse:[
+ 'Smalltalk [warning]: no such class: ' errorPrint. oldName errorPrintCR.
+ ^ self
+ ].
+ "
+ the class has changed its name - without telling me ...
+ what should be done in this case ?
+ "
+ 'Smalltalk [warning]: class ' errorPrint. oldName errorPrint.
+ ' has changed its name' errorPrintCR.
+
+ "/
+ "/ might be an alias (i.e. removing a compatibility name)
+ "/
+ actualName := self keyAtValue:aClass.
+ ('Smalltalk [info]: ' , oldName , ' is actually stored as ' , actualName , '.') infoPrintCR.
+ sym := actualName asSymbol.
+ oldName := actualName asString.
+ wrongName := true.
].
ns := aClass nameSpace.
aClass topOwningClass notNil ifTrue:[
- ons := aClass topOwningClass nameSpace
+ ons := aClass topOwningClass nameSpace
].
self at:sym put:nil. "nil it out for compiled accesses"
@@ -1023,25 +1023,25 @@
"/ see comment in removeKey: on why we dont remove it here
"/
"/ self removeKey:sym. "/ remove key - this actually fails, if there are
- "/ still compiled code references."
+ "/ still compiled code references."
"remove private classes"
aClass privateClassesSorted do:[:somePrivateClass |
- aClass privateClassesAt:(somePrivateClass nameWithoutPrefix) asSymbol put:nil.
+ aClass privateClassesAt:(somePrivateClass nameWithoutPrefix) asSymbol put:nil.
].
"remove class variables"
names := aClass classVariableString asCollectionOfWords.
names do:[:name |
- cSym := (sym , ':' , name) asSymbol.
- self at:cSym asSymbol put:nil.
-
- "/
- "/ see comment in removeKey: on why we dont remove it here
- "/
- "/ self removeKey:cSym
+ cSym := (sym , ':' , name) asSymbol.
+ self at:cSym asSymbol put:nil.
+
+ "/
+ "/ see comment in removeKey: on why we dont remove it here
+ "/
+ "/ self removeKey:cSym
].
@@ -1070,31 +1070,31 @@
Class flushSubclassInfo.
wrongName == true ifTrue:[
- "/
- "/ an alias (i.e. removing a compatibility name)
- "/
- "/ check if there are more refs to it ...
- [self includes:aClass] whileTrue:[
- actualName := self keyAtValue:aClass.
- ('Smalltalk [info]: ' , aClass name , ' is also registered under the name ' , actualName
- , ' - remove that binding too.') infoPrintCR.
- self at:actualName put:nil.
- ].
+ "/
+ "/ an alias (i.e. removing a compatibility name)
+ "/
+ "/ check if there are more refs to it ...
+ [self includes:aClass] whileTrue:[
+ actualName := self keyAtValue:aClass.
+ ('Smalltalk [info]: ' , aClass name , ' is also registered under the name ' , actualName
+ , ' - remove that binding too.') infoPrintCR.
+ self at:actualName put:nil.
+ ].
].
ns ~~ Smalltalk ifTrue:[
- ons notNil ifTrue:[
- ClassBuilder
- recompileGlobalAccessorsTo:oldNameSym
- in:ons
- except:nil
- ].
- (ns notNil and:[ns ~~ ons]) ifTrue:[
- ClassBuilder
- recompileGlobalAccessorsTo:oldNameSym
- in:ns
- except:nil
- ].
+ ons notNil ifTrue:[
+ ClassBuilder
+ recompileGlobalAccessorsTo:oldNameSym
+ in:ons
+ except:nil
+ ].
+ (ns notNil and:[ns ~~ ons]) ifTrue:[
+ ClassBuilder
+ recompileGlobalAccessorsTo:oldNameSym
+ in:ns
+ except:nil
+ ].
].
"Modified: / 20.6.1998 / 13:26:10 / cg"
@@ -1115,24 +1115,24 @@
i2 := 1.
ns := self.
[i2 ~~ 0] whileTrue:[
- i2 := newName indexOfSubCollection:'::' startingAt:i1.
- i2 ~~ 0 ifTrue:[
- nm := newName copyFrom:i1 to:i2-1.
- ns isNameSpace ifTrue:[
- subns := ns at:nm asSymbol ifAbsent:nil.
- subns isNil ifTrue:[
- self error:'Nonexisting namespace: ',nm.
- ^ nil.
- ].
- ] ifFalse:[
- subns := ns privateClassesAt:nm asSymbol.
- subns isNil ifTrue:[
- self error:'Cannot create a namespace below a class'
- ]
- ].
- ns := subns.
- i1 := i2 + 2.
- ].
+ i2 := newName indexOfSubCollection:'::' startingAt:i1.
+ i2 ~~ 0 ifTrue:[
+ nm := newName copyFrom:i1 to:i2-1.
+ ns isNameSpace ifTrue:[
+ subns := ns at:nm asSymbol ifAbsent:nil.
+ subns isNil ifTrue:[
+ self error:'Nonexisting namespace: ',nm.
+ ^ nil.
+ ].
+ ] ifFalse:[
+ subns := ns privateClassesAt:nm asSymbol.
+ subns isNil ifTrue:[
+ self error:'Cannot create a namespace below a class'
+ ]
+ ].
+ ns := subns.
+ i1 := i2 + 2.
+ ].
].
oldName := aClass name.
@@ -1143,8 +1143,8 @@
privateClasses := aClass privateClassesSorted.
((self at:oldSym) ~~ aClass) ifTrue:[
- 'Smalltalk [warning]: rename failed - name is different from key' errorPrintCR.
- ^ self
+ 'Smalltalk [warning]: rename failed - name is different from key' errorPrintCR.
+ ^ self
].
"/ rename the class
@@ -1158,28 +1158,28 @@
"/ change the owning class
ns isNameSpace ifFalse:[
- aClass isPrivate ifTrue:[
- aClass class setOwningClass:ns.
- ] ifFalse:[
- oldMetaclass := aClass class.
-
- "/ sigh - must make a PrivateMetaclass from Metaclass
- newMetaclass := PrivateMetaclass new.
- newMetaclass flags:(oldMetaclass flags).
- newMetaclass setSuperclass:(oldMetaclass superclass).
- newMetaclass instSize:(oldMetaclass instSize).
- newMetaclass setInstanceVariableString:(oldMetaclass instanceVariableString).
- newMetaclass setMethodDictionary:(oldMetaclass methodDictionary).
- newMetaclass setSoleInstance:aClass.
- newMetaclass setOwningClass:ns.
-
- aClass changeClassTo:newMetaclass.
- ObjectMemory flushCaches.
- ]
+ aClass isPrivate ifTrue:[
+ aClass class setOwningClass:ns.
+ ] ifFalse:[
+ oldMetaclass := aClass class.
+
+ "/ sigh - must make a PrivateMetaclass from Metaclass
+ newMetaclass := PrivateMetaclass new.
+ newMetaclass flags:(oldMetaclass flags).
+ newMetaclass setSuperclass:(oldMetaclass superclass).
+ newMetaclass instSize:(oldMetaclass instSize).
+ newMetaclass setInstanceVariableString:(oldMetaclass instanceVariableString).
+ newMetaclass setMethodDictionary:(oldMetaclass methodDictionary).
+ newMetaclass setSoleInstance:aClass.
+ newMetaclass setOwningClass:ns.
+
+ aClass changeClassTo:newMetaclass.
+ ObjectMemory flushCaches.
+ ]
] ifTrue:[
- aClass isPrivate ifTrue:[
- aClass class setOwningClass:nil.
- ]
+ aClass isPrivate ifTrue:[
+ aClass class setOwningClass:nil.
+ ]
].
"/
@@ -1194,32 +1194,32 @@
names := aClass classVariableString asCollectionOfWords.
names do:[:name |
- oldCVSym := (oldSym , ':' , name) asSymbol.
- value := self at:oldCVSym.
- self at:oldCVSym put:nil.
-
- "/
- "/ see comment in #removeKey: on why we dont remove it it here
- "/
- "/ self removeKey:cSym.
-
- newCVSym := (newSym , ':' , name) asSymbol.
- self at:newCVSym put:value.
-
- oldNameToNewName at:oldCVSym put:newCVSym.
+ oldCVSym := (oldSym , ':' , name) asSymbol.
+ value := self at:oldCVSym.
+ self at:oldCVSym put:nil.
+
+ "/
+ "/ see comment in #removeKey: on why we dont remove it it here
+ "/
+ "/ self removeKey:cSym.
+
+ newCVSym := (newSym , ':' , name) asSymbol.
+ self at:newCVSym put:value.
+
+ oldNameToNewName at:oldCVSym put:newCVSym.
].
"/ patch methods literal arrays from oldCVname to newCVname
oldNameToNewName keysAndValuesDo:[:oldNameSym :newNameSym |
- aClass withAllSubclasses do:[:aSubClass |
- Transcript showCR:'changing global accesses from ''' , oldNameSym , ''' into ''' , newNameSym , ''' in class: ''' , aSubClass name , ''' ...'.
- aSubClass instAndClassSelectorsAndMethodsDo:[:sel :aMethod |
- aMethod changeLiteral:oldNameSym to:newNameSym
- ].
- ].
-
- "/ and also in privateClasses ? ...
+ aClass withAllSubclasses do:[:aSubClass |
+ Transcript showCR:'changing global accesses from ''' , oldNameSym , ''' into ''' , newNameSym , ''' in class: ''' , aSubClass name , ''' ...'.
+ aSubClass instAndClassSelectorsAndMethodsDo:[:sel :aMethod |
+ aMethod changeLiteral:oldNameSym to:newNameSym
+ ].
+ ].
+
+ "/ and also in privateClasses ? ...
"/ privateClasses size > 0 ifTrue:[
"/ privateClasses do:[:aPrivateClass |
@@ -1242,77 +1242,77 @@
newNameSpace := aClass topNameSpace.
privateClasses size > 0 ifTrue:[
- "/ must rename privateClasses as well
- Class withoutUpdatingChangesDo:[
- privateClasses do:[:aPrivateClass |
- self renameClass:aPrivateClass
- to:(newSym , '::' , aPrivateClass nameWithoutPrefix).
+ "/ must rename privateClasses as well
+ Class withoutUpdatingChangesDo:[
+ privateClasses do:[:aPrivateClass |
+ self renameClass:aPrivateClass
+ to:(newSym , '::' , aPrivateClass nameWithoutPrefix).
- Transcript showCR:'recompiling methods in ''' , newNameSpace name , ''' accessing ''' , oldName , '::' , aPrivateClass nameWithoutPrefix , ''' ...'.
- ClassBuilder
- recompileGlobalAccessorsTo:(oldName , '::' , aPrivateClass nameWithoutPrefix) asSymbol
- in:newNameSpace
- except:nil.
- ]
- ]
+ Transcript showCR:'recompiling methods in ''' , newNameSpace name , ''' accessing ''' , oldName , '::' , aPrivateClass nameWithoutPrefix , ''' ...'.
+ ClassBuilder
+ recompileGlobalAccessorsTo:(oldName , '::' , aPrivateClass nameWithoutPrefix) asSymbol
+ in:newNameSpace
+ except:nil.
+ ]
+ ]
].
oldNameSpace ~~ newNameSpace ifTrue:[
- "/ all those referencing the class from the old nameSpace
- "/ must be recompiled ...
- "/ (to now access the global from smalltalk)
-
- oldNameSpace ~~ Smalltalk ifTrue:[
- Transcript showCR:'recompiling methods in ''' , oldNameSpace name , ''' accessing ''' , oldName , ''' ...'.
-
- ClassBuilder
- recompileGlobalAccessorsTo:oldName asSymbol
- in:oldNameSpace
- except:nil.
- ].
-
- "/ all referencing the class in the new namespace
- "/ as well; to now access the new class.
-
- (newNameSpace notNil and:[newNameSpace ~~ Smalltalk]) ifTrue:[
- Transcript showCR:'recompiling methods in ''' , newNameSpace name , ''' accessing ''' , oldBaseName , ''' ...'.
-
- ClassBuilder
- recompileGlobalAccessorsTo:oldBaseName asSymbol
- in:newNameSpace
- except:nil.
- ].
+ "/ all those referencing the class from the old nameSpace
+ "/ must be recompiled ...
+ "/ (to now access the global from smalltalk)
+
+ oldNameSpace ~~ Smalltalk ifTrue:[
+ Transcript showCR:'recompiling methods in ''' , oldNameSpace name , ''' accessing ''' , oldName , ''' ...'.
+
+ ClassBuilder
+ recompileGlobalAccessorsTo:oldName asSymbol
+ in:oldNameSpace
+ except:nil.
+ ].
+
+ "/ all referencing the class in the new namespace
+ "/ as well; to now access the new class.
+
+ (newNameSpace notNil and:[newNameSpace ~~ Smalltalk]) ifTrue:[
+ Transcript showCR:'recompiling methods in ''' , newNameSpace name , ''' accessing ''' , oldBaseName , ''' ...'.
+
+ ClassBuilder
+ recompileGlobalAccessorsTo:oldBaseName asSymbol
+ in:newNameSpace
+ except:nil.
+ ].
] ifFalse:[
- "/ all references to a global with my new name in my owning class
- "/ must now be redirected to myself.
-
- aClass isPrivate ifTrue:[
- newBaseName := aClass nameWithoutNameSpacePrefix.
- newBaseNameWithoutPrefix := aClass nameWithoutPrefix.
-
- Transcript showCR:'recompiling methods accessing ''' , oldBaseNameWithoutPrefix , ''' in: ''' , aClass owningClass name , ''' ...'.
- aClass owningClass recompileMethodsAccessingGlobal:oldBaseNameWithoutPrefix.
- aClass owningClass class recompileMethodsAccessingGlobal:oldBaseNameWithoutPrefix.
-
- Transcript showCR:'recompiling methods accessing ''' , oldBaseName , ''' in: ''' , aClass owningClass name , ''' ...'.
- aClass owningClass recompileMethodsAccessingGlobal:oldBaseName.
- aClass owningClass class recompileMethodsAccessingGlobal:oldBaseName.
-
- Transcript showCR:'recompiling methods accessing ''' , newBaseNameWithoutPrefix , ''' in: ''' , aClass owningClass name , ''' ...'.
- aClass owningClass recompileMethodsAccessingGlobal:newBaseNameWithoutPrefix.
- aClass owningClass class recompileMethodsAccessingGlobal:newBaseNameWithoutPrefix.
-
- Transcript showCR:'recompiling methods accessing ''' , newBaseName , ''' in: ''' , aClass owningClass name , ''' ...'.
- aClass owningClass recompileMethodsAccessingGlobal:newBaseName.
- aClass owningClass class recompileMethodsAccessingGlobal:newBaseName.
- ]
+ "/ all references to a global with my new name in my owning class
+ "/ must now be redirected to myself.
+
+ aClass isPrivate ifTrue:[
+ newBaseName := aClass nameWithoutNameSpacePrefix.
+ newBaseNameWithoutPrefix := aClass nameWithoutPrefix.
+
+ Transcript showCR:'recompiling methods accessing ''' , oldBaseNameWithoutPrefix , ''' in: ''' , aClass owningClass name , ''' ...'.
+ aClass owningClass recompileMethodsAccessingGlobal:oldBaseNameWithoutPrefix.
+ aClass owningClass class recompileMethodsAccessingGlobal:oldBaseNameWithoutPrefix.
+
+ Transcript showCR:'recompiling methods accessing ''' , oldBaseName , ''' in: ''' , aClass owningClass name , ''' ...'.
+ aClass owningClass recompileMethodsAccessingGlobal:oldBaseName.
+ aClass owningClass class recompileMethodsAccessingGlobal:oldBaseName.
+
+ Transcript showCR:'recompiling methods accessing ''' , newBaseNameWithoutPrefix , ''' in: ''' , aClass owningClass name , ''' ...'.
+ aClass owningClass recompileMethodsAccessingGlobal:newBaseNameWithoutPrefix.
+ aClass owningClass class recompileMethodsAccessingGlobal:newBaseNameWithoutPrefix.
+
+ Transcript showCR:'recompiling methods accessing ''' , newBaseName , ''' in: ''' , aClass owningClass name , ''' ...'.
+ aClass owningClass recompileMethodsAccessingGlobal:newBaseName.
+ aClass owningClass class recompileMethodsAccessingGlobal:newBaseName.
+ ]
].
aClass changed:#definition.
"/ because of the change of my superclasses name ...
aClass allSubclassesDo:[:subClass |
- subClass changed:#definition.
+ subClass changed:#definition.
].
self changed:#definition.
Smalltalk changed:#classRename with:(Array with:aClass with:oldName).
@@ -1364,7 +1364,7 @@
"call the dummy debug function, on which a breakpoint
can be put in adb, sdb, dbx or gdb.
WARNING: this method is for debugging only
- it will be removed without notice."
+ it will be removed without notice."
%{
__PATCHUPCONTEXTS(__context);
__debugBreakPoint__();
@@ -1412,9 +1412,9 @@
char *msg;
if (__isString(aMessage))
- msg = (char *) __stringVal(aMessage);
+ msg = (char *) __stringVal(aMessage);
else
- msg = "fatalAbort";
+ msg = "fatalAbort";
__fatal0(__context, msg);
/* NEVER RETURNS */
@@ -1447,7 +1447,7 @@
allCategories := Set new.
Smalltalk allClassesDo:[:cls |
- allCategories add:cls category.
+ allCategories add:cls category.
].
allCategories := allCategories asOrderedCollection.
@@ -1468,16 +1468,16 @@
already := IdentitySet new.
self allClassesDo:[:eachClass | |cls|
- cls := eachClass theNonMetaclass.
- (already includes:cls) ifFalse:[
- aBlock value:cls.
- already add:cls.
- ].
- cls := cls class.
- (already includes:cls) ifFalse:[
- aBlock value:cls.
- already add:cls.
- ].
+ cls := eachClass theNonMetaclass.
+ (already includes:cls) ifFalse:[
+ aBlock value:cls.
+ already add:cls.
+ ].
+ cls := cls class.
+ (already includes:cls) ifFalse:[
+ aBlock value:cls.
+ already add:cls.
+ ].
].
!
@@ -1515,13 +1515,13 @@
The order of the classes is not defined."
aCategory notNil ifTrue:[
- self allClassesDo:[:aClass |
- aClass isMeta ifFalse:[
- (aClass category = aCategory) ifTrue:[
- aBlock value:aClass
- ]
- ]
- ]
+ self allClassesDo:[:aClass |
+ aClass isMeta ifFalse:[
+ (aClass category = aCategory) ifTrue:[
+ aBlock value:aClass
+ ]
+ ]
+ ]
]
"
@@ -1536,12 +1536,12 @@
|classes|
aCategory notNil ifTrue:[
- classes := OrderedCollection new.
- self allClassesInCategory:aCategory do:[:aClass |
- classes add:aClass
- ].
- classes topologicalSort:[:a :b | b isSubclassOf:a].
- classes do:aBlock
+ classes := OrderedCollection new.
+ self allClassesInCategory:aCategory do:[:aClass |
+ classes add:aClass
+ ].
+ classes topologicalSort:[:a :b | b isSubclassOf:a].
+ classes do:aBlock
]
"
@@ -1559,16 +1559,16 @@
already := IdentitySet new.
self allClassesDo:[:aClass |
- (already includes:aClass) ifFalse:[
- aClass allSuperclasses reverseDo:[:cls |
- (already includes:aClass) ifFalse:[
- already add:cls.
- aBlock value:cls.
- ].
- ].
- already add:aClass.
- aBlock value:aClass.
- ]
+ (already includes:aClass) ifFalse:[
+ aClass allSuperclasses reverseDo:[:cls |
+ (already includes:aClass) ifFalse:[
+ already add:cls.
+ aBlock value:cls.
+ ].
+ ].
+ already add:aClass.
+ aBlock value:aClass.
+ ]
].
"
@@ -1589,7 +1589,7 @@
allCategories := Set new.
Smalltalk allClassesDo:[:cls |
- allCategories addAll:cls allCategories.
+ allCategories addAll:cls allCategories.
].
allCategories := allCategories asOrderedCollection.
@@ -1634,7 +1634,7 @@
RETURN (self);
%}.
self keysDo:[:aKey |
- aBlock value:(self at:aKey)
+ aBlock value:(self at:aKey)
]
!
@@ -1655,7 +1655,7 @@
RETURN (self);
%}.
self basicKeys do:[:aKey |
- aBlock value:aKey
+ aBlock value:aKey
]
! !
@@ -1803,28 +1803,28 @@
"/ If that happens, we restart the set-building here
"/
[(classes := CachedClasses) isNil] whileTrue:[
- CachedClasses := classes := IdentitySet new:800.
- self keysAndValuesDo:[:sym :anObject |
- anObject notNil ifTrue:[
- anObject isBehavior ifTrue:[
- "/ sigh - would like to skip over aliases
- "/ but this cannot be done simply by comparing
- "/ the classes name against the store-key
- "/ i.e. cannot do:
- "/ anObject name == sym ifTrue:[
- "/ classes add:anObject
- "/ ]
- "/ because that would lead to ignore all java
- "/ classes, which are stored under a different
- "/ key.
-
- (anObject name == sym
- or:[anObject isJavaClass]) ifTrue:[
- classes add:anObject
- ].
- ]
- ]
- ]
+ CachedClasses := classes := IdentitySet new:800.
+ self keysAndValuesDo:[:sym :anObject |
+ anObject notNil ifTrue:[
+ anObject isBehavior ifTrue:[
+ "/ sigh - would like to skip over aliases
+ "/ but this cannot be done simply by comparing
+ "/ the classes name against the store-key
+ "/ i.e. cannot do:
+ "/ anObject name == sym ifTrue:[
+ "/ classes add:anObject
+ "/ ]
+ "/ because that would lead to ignore all java
+ "/ classes, which are stored under a different
+ "/ key.
+
+ (anObject name == sym
+ or:[anObject isJavaClass]) ifTrue:[
+ classes add:anObject
+ ].
+ ]
+ ]
+ ]
].
^ classes
@@ -1846,8 +1846,8 @@
classes := IdentitySet new.
self allClassesDo:[:eachClass |
- classes add:(eachClass theNonMetaclass).
- classes add:(eachClass theMetaclass).
+ classes add:(eachClass theNonMetaclass).
+ classes add:(eachClass theMetaclass).
].
^ classes
!
@@ -1889,7 +1889,7 @@
classCategoryCompletion:aPartialCategory
"given a partial class category name, return an array consisting of
2 entries: 1st: collection consisting of matching categories
- 2nd: the longest match"
+ 2nd: the longest match"
|matches best lcName|
@@ -1897,31 +1897,31 @@
"/ search for exact match
self allClassesDo:[:aClass |
- |category|
-
- category := aClass category.
- (category notNil and:[category startsWith:aPartialCategory]) ifTrue:[
- matches add:category
- ]
+ |category|
+
+ category := aClass category.
+ (category notNil and:[category startsWith:aPartialCategory]) ifTrue:[
+ matches add:category
+ ]
].
matches isEmpty ifTrue:[
- "/ search for case-ignoring match
- lcName := aPartialCategory asLowercase.
- self allClassesDo:[:aClass |
- |category|
-
- category := aClass category.
- (category asLowercase startsWith:lcName) ifTrue:[
- matches add:category
- ].
- ].
+ "/ search for case-ignoring match
+ lcName := aPartialCategory asLowercase.
+ self allClassesDo:[:aClass |
+ |category|
+
+ category := aClass category.
+ (category asLowercase startsWith:lcName) ifTrue:[
+ matches add:category
+ ].
+ ].
].
matches isEmpty ifTrue:[
- ^ Array with:aPartialCategory with:(Array with:aPartialCategory)
+ ^ Array with:aPartialCategory with:(Array with:aPartialCategory)
].
matches size == 1 ifTrue:[
- ^ Array with:matches first with:(matches asArray)
+ ^ Array with:matches first with:(matches asArray)
].
matches := matches asSortedCollection.
best := matches longestCommonPrefix.
@@ -1983,89 +1983,89 @@
classnameCompletion:aPartialClassName
"given a partial classname, return an array consisting of
2 entries: 1st: collection consisting of matching names
- 2nd: the best (longest) match"
+ 2nd: the best (longest) match"
^ self
- classnameCompletion:aPartialClassName inEnvironment:self
+ classnameCompletion:aPartialClassName inEnvironment:self
!
classnameCompletion:aPartialClassName inEnvironment:anEnvironment
"given a partial classname, return an array consisting of
2 entries: 1st: collection consisting of matching names
- 2nd: the best (longest) match"
+ 2nd: the best (longest) match"
|searchName matches ignCaseMatches best isMatchString cls nsPrefix |
aPartialClassName isEmpty ifTrue:[
- ^ Array with:aPartialClassName with:#()
+ ^ Array with:aPartialClassName with:#()
].
(aPartialClassName startsWith:'Smalltalk::') ifTrue:[
- nsPrefix := 'Smalltalk::'.
- searchName := aPartialClassName copyFrom:'Smalltalk::' size + 1
+ nsPrefix := 'Smalltalk::'.
+ searchName := aPartialClassName copyFrom:'Smalltalk::' size + 1
] ifFalse:[
- nsPrefix := ''.
- searchName := aPartialClassName.
+ nsPrefix := ''.
+ searchName := aPartialClassName.
].
(searchName at:1) isLowercase ifTrue:[
- searchName := searchName copy asUppercaseFirst
+ searchName := searchName copy asUppercaseFirst
].
isMatchString := searchName includesMatchCharacters.
matches := OrderedCollection new.
ignCaseMatches := OrderedCollection new.
anEnvironment allClassesDo:[:aClass |
- |className addIt|
-
- className := aClass name.
- aClass isMeta ifFalse:[
+ |className addIt|
+
+ className := aClass name.
+ aClass isMeta ifFalse:[
- isMatchString ifTrue:[
- addIt := searchName match:className
- ] ifFalse:[
- addIt := className startsWith:searchName
- ].
- addIt ifTrue:[
- matches add:(nsPrefix , aClass name)
- ] ifFalse:[
- "/ try ignoring case
- isMatchString ifTrue:[
- addIt := searchName match:className ignoreCase:true
- ] ifFalse:[
- addIt := className asLowercase startsWith:searchName asLowercase
- ].
- addIt ifTrue:[
- ignCaseMatches add:(nsPrefix , aClass name)
- ]
- ]
- ]
+ isMatchString ifTrue:[
+ addIt := searchName match:className
+ ] ifFalse:[
+ addIt := className startsWith:searchName
+ ].
+ addIt ifTrue:[
+ matches add:(nsPrefix , aClass name)
+ ] ifFalse:[
+ "/ try ignoring case
+ isMatchString ifTrue:[
+ addIt := searchName match:className ignoreCase:true
+ ] ifFalse:[
+ addIt := className asLowercase startsWith:searchName asLowercase
+ ].
+ addIt ifTrue:[
+ ignCaseMatches add:(nsPrefix , aClass name)
+ ]
+ ]
+ ]
].
matches isEmpty ifTrue:[
- matches := ignCaseMatches
+ matches := ignCaseMatches
].
matches isEmpty ifTrue:[
- ^ Array with:searchName with:(Array with:searchName)
+ ^ Array with:searchName with:(Array with:searchName)
].
matches size == 1 ifTrue:[
- best := matches first.
- ^ Array with:best with:(matches asArray)
+ best := matches first.
+ ^ Array with:best with:(matches asArray)
].
matches := matches asSortedCollection.
isMatchString ifTrue:[
- best := searchName.
+ best := searchName.
] ifFalse:[
- best := matches longestCommonPrefix.
+ best := matches longestCommonPrefix.
].
cls := anEnvironment classNamed:best.
(cls isBehavior and:[cls isNameSpace]) ifTrue:[
- (matches conform:[:each | each = best
- or:[each startsWith:(best , '::')]])
- ifTrue:[
- best := best , '::'
- ].
+ (matches conform:[:each | each = best
+ or:[each startsWith:(best , '::')]])
+ ifTrue:[
+ best := best , '::'
+ ].
].
^ Array with:best with:matches asArray
@@ -2099,60 +2099,60 @@
globalnameCompletion:aPartialGlobalName
"given a partial globalName, return an array consisting of
2 entries: 1st: collection consisting of matching names
- 2nd: the best (longest) match"
+ 2nd: the best (longest) match"
|searchName matches ignCaseMatches best isMatchString|
searchName := aPartialGlobalName.
searchName isEmpty ifTrue:[
- ^ Array with:searchName with:#()
+ ^ Array with:searchName with:#()
].
(searchName at:1) isLowercase ifTrue:[
- searchName := searchName copy asUppercaseFirst
+ searchName := searchName copy asUppercaseFirst
].
isMatchString := searchName includesMatchCharacters.
matches := OrderedCollection new.
ignCaseMatches := OrderedCollection new.
self keysDo:[:aGlobalName |
- | addIt|
-
- isMatchString ifTrue:[
- addIt := searchName match:aGlobalName
- ] ifFalse:[
- addIt := aGlobalName startsWith:searchName
- ].
- addIt ifTrue:[
- matches add:aGlobalName
- ] ifFalse:[
- "/ try ignoring case
- isMatchString ifTrue:[
- addIt := searchName match:aGlobalName ignoreCase:true
- ] ifFalse:[
- addIt := aGlobalName asLowercase startsWith:searchName asLowercase
- ].
- addIt ifTrue:[
- ignCaseMatches add:aGlobalName
- ]
- ]
+ | addIt|
+
+ isMatchString ifTrue:[
+ addIt := searchName match:aGlobalName
+ ] ifFalse:[
+ addIt := aGlobalName startsWith:searchName
+ ].
+ addIt ifTrue:[
+ matches add:aGlobalName
+ ] ifFalse:[
+ "/ try ignoring case
+ isMatchString ifTrue:[
+ addIt := searchName match:aGlobalName ignoreCase:true
+ ] ifFalse:[
+ addIt := aGlobalName asLowercase startsWith:searchName asLowercase
+ ].
+ addIt ifTrue:[
+ ignCaseMatches add:aGlobalName
+ ]
+ ]
].
matches isEmpty ifTrue:[
- matches := ignCaseMatches
+ matches := ignCaseMatches
].
matches isEmpty ifTrue:[
- ^ Array with:searchName with:(Array with:searchName)
+ ^ Array with:searchName with:(Array with:searchName)
].
matches size == 1 ifTrue:[
- ^ Array with:matches first with:(matches asArray)
+ ^ Array with:matches first with:(matches asArray)
].
matches := matches asSortedCollection.
isMatchString ifTrue:[
- best := searchName.
+ best := searchName.
] ifFalse:[
- best := matches longestCommonPrefix.
+ best := matches longestCommonPrefix.
].
^ Array with:best with:matches asArray
@@ -2203,7 +2203,7 @@
methodProtocolCompletion:aPartialProtocolName
"given a partial method protocol name, return an array consisting of
2 entries: 1st: collection consisting of matching protocols
- 2nd: the longest match"
+ 2nd: the longest match"
|matches best lcName|
@@ -2211,35 +2211,35 @@
"/ search for exact match
self allClassesDo:[:aClass |
- aClass instAndClassSelectorsAndMethodsDo:[:aSelector :aMethod |
- |protocol|
-
- protocol := aMethod category.
- (protocol notNil and:[protocol startsWith:aPartialProtocolName]) ifTrue:[
- matches add:protocol
- ]
- ].
+ aClass instAndClassSelectorsAndMethodsDo:[:aSelector :aMethod |
+ |protocol|
+
+ protocol := aMethod category.
+ (protocol notNil and:[protocol startsWith:aPartialProtocolName]) ifTrue:[
+ matches add:protocol
+ ]
+ ].
].
matches isEmpty ifTrue:[
- "/ search for case-ignoring match
- lcName := aPartialProtocolName asLowercase.
- self allClassesDo:[:aClass |
- aClass instAndClassSelectorsAndMethodsDo:[:aSelector :aMethod |
- |protocol|
-
- protocol := aMethod category.
- (protocol asLowercase startsWith:lcName) ifTrue:[
- matches add:protocol
- ]
- ].
- ].
+ "/ search for case-ignoring match
+ lcName := aPartialProtocolName asLowercase.
+ self allClassesDo:[:aClass |
+ aClass instAndClassSelectorsAndMethodsDo:[:aSelector :aMethod |
+ |protocol|
+
+ protocol := aMethod category.
+ (protocol asLowercase startsWith:lcName) ifTrue:[
+ matches add:protocol
+ ]
+ ].
+ ].
].
matches isEmpty ifTrue:[
- ^ Array with:aPartialProtocolName with:(Array with:aPartialProtocolName)
+ ^ Array with:aPartialProtocolName with:(Array with:aPartialProtocolName)
].
matches size == 1 ifTrue:[
- ^ Array with:matches first with:(matches asArray)
+ ^ Array with:matches first with:(matches asArray)
].
matches := matches asSortedCollection.
best := matches longestCommonPrefix.
@@ -2302,8 +2302,8 @@
"redefined, since the references are only kept in the VM's symbol table"
self keysAndValuesDo:[:key :val |
- (key == anObject) ifTrue:[^ true].
- (val == anObject ) ifTrue:[^ true].
+ (key == anObject) ifTrue:[^ true].
+ (val == anObject ) ifTrue:[^ true].
].
^ super referencesObject:anObject
@@ -2351,16 +2351,16 @@
selectorCompletion:aPartialSymbolName
"given a partial selector, return an array consisting of
2 entries: 1st: collection consisting of matching implemented selectors
- 2nd: the longest match"
+ 2nd: the longest match"
^ self
- selectorCompletion:aPartialSymbolName inEnvironment:self
+ selectorCompletion:aPartialSymbolName inEnvironment:self
!
selectorCompletion:aPartialSymbolName inEnvironment:anEnvironment
"given a partial selector, return an array consisting of
2 entries: 1st: collection consisting of matching implemented selectors
- 2nd: the longest match"
+ 2nd: the longest match"
|matches best lcSym|
@@ -2368,29 +2368,29 @@
"/ search for exact match
anEnvironment allClassesDo:[:aClass |
- aClass instAndClassSelectorsAndMethodsDo:[:aSelector :aMethod |
- (aSelector startsWith:aPartialSymbolName) ifTrue:[
- matches add:aSelector
- ]
- ].
+ aClass instAndClassSelectorsAndMethodsDo:[:aSelector :aMethod |
+ (aSelector startsWith:aPartialSymbolName) ifTrue:[
+ matches add:aSelector
+ ]
+ ].
].
matches isEmpty ifTrue:[
- "/ search for case-ignoring match
- lcSym := aPartialSymbolName asLowercase.
- anEnvironment allClassesDo:[:aClass |
- aClass instAndClassSelectorsAndMethodsDo:[:aSelector :aMethod |
- (aSelector asLowercase startsWith:lcSym) ifTrue:[
- matches add:aSelector
- ]
- ].
- ].
+ "/ search for case-ignoring match
+ lcSym := aPartialSymbolName asLowercase.
+ anEnvironment allClassesDo:[:aClass |
+ aClass instAndClassSelectorsAndMethodsDo:[:aSelector :aMethod |
+ (aSelector asLowercase startsWith:lcSym) ifTrue:[
+ matches add:aSelector
+ ]
+ ].
+ ].
].
matches isEmpty ifTrue:[
- ^ Array with:aPartialSymbolName with:(Array with:aPartialSymbolName)
+ ^ Array with:aPartialSymbolName with:(Array with:aPartialSymbolName)
].
matches size == 1 ifTrue:[
- ^ Array with:matches first with:(matches asArray)
+ ^ Array with:matches first with:(matches asArray)
].
matches := matches asSortedCollection.
best := matches longestCommonPrefix.
@@ -2485,15 +2485,15 @@
if there is a display, start its event dispatcher
"
Display notNil ifTrue:[
- Display deviceIOTimeoutErrorSignal handlerBlock:[:ex |
- SaveEmergencyImage == true ifTrue:[
- 'Display [warning]: broken display connection - emergency save in ''crash.img''.' infoPrintCR.
- ObjectMemory primSnapShotOn:'crash.img'.
- ].
- 'Display [warning]: broken display connection - exit.' infoPrintCR.
- Smalltalk exit.
- ].
- Display startDispatch.
+ Display deviceIOTimeoutErrorSignal handlerBlock:[:ex |
+ SaveEmergencyImage == true ifTrue:[
+ 'Display [warning]: broken display connection - emergency save in ''crash.img''.' infoPrintCR.
+ ObjectMemory primSnapShotOn:'crash.img'.
+ ].
+ 'Display [warning]: broken display connection - exit.' infoPrintCR.
+ Smalltalk exit.
+ ].
+ Display startDispatch.
].
Initializing := false.
@@ -2504,50 +2504,50 @@
"/ Therefore, it is now done by an extra user-process.
mainProcess := [
- StartBlocks notNil ifTrue:[
- StartBlocks do:[:aBlock|
- aBlock value
- ].
- StartBlocks := nil.
- ].
- ImageStartBlocks notNil ifTrue:[
- ImageStartBlocks do:[:aBlock|
- aBlock value
- ].
- ].
- StandAlone ifFalse:[
- (SilentLoading == true) ifFalse:[ "i.e. undefined counts as false"
- thisIsARestart ifTrue:[
- Transcript cr.
- Transcript showCR:('Smalltalk restarted from:'
- , imageName
- , ' (saved '
- , ObjectMemory imageSaveTime printString
- , ')' ).
- ] ifFalse:[
- Transcript showCR:(self hello).
- Transcript showCR:(self copyrightString).
- Transcript cr.
- ].
- Transcript cr.
- ].
-
- DemoMode==true ifTrue:[
- Transcript showCR:'*** Restricted use: ***'.
- Transcript showCR:'*** This program may be used for education only. ***'.
- Transcript showCR:'*** Please read the files COPYRIGHT and LICENSE ***'.
- Transcript showCR:'*** for more details. ***'.
- Transcript cr.
- ].
- ].
-
- thisIsARestart ifTrue:[
- "/
- "/ the final late notification - users can now assume that
- "/ views, forms etc. have been recreated.
-
- ObjectMemory changed:#returnFromSnapshot.
- ]
+ StartBlocks notNil ifTrue:[
+ StartBlocks do:[:aBlock|
+ aBlock value
+ ].
+ StartBlocks := nil.
+ ].
+ ImageStartBlocks notNil ifTrue:[
+ ImageStartBlocks do:[:aBlock|
+ aBlock value
+ ].
+ ].
+ StandAlone ifFalse:[
+ (SilentLoading == true) ifFalse:[ "i.e. undefined counts as false"
+ thisIsARestart ifTrue:[
+ Transcript cr.
+ Transcript showCR:('Smalltalk restarted from:'
+ , imageName
+ , ' (saved '
+ , ObjectMemory imageSaveTime printString
+ , ')' ).
+ ] ifFalse:[
+ Transcript showCR:(self hello).
+ Transcript showCR:(self copyrightString).
+ Transcript cr.
+ ].
+ Transcript cr.
+ ].
+
+ DemoMode==true ifTrue:[
+ Transcript showCR:'*** Restricted use: ***'.
+ Transcript showCR:'*** This program may be used for education only. ***'.
+ Transcript showCR:'*** Please read the files COPYRIGHT and LICENSE ***'.
+ Transcript showCR:'*** for more details. ***'.
+ Transcript cr.
+ ].
+ ].
+
+ thisIsARestart ifTrue:[
+ "/
+ "/ the final late notification - users can now assume that
+ "/ views, forms etc. have been recreated.
+
+ ObjectMemory changed:#returnFromSnapshot.
+ ]
] newProcess.
mainProcess priority:8.
@@ -2560,54 +2560,55 @@
"/ message.
(StartupClass notNil and:[StartupSelector notNil]) ifTrue:[
- "
- allow more customization by reading an image specific rc-file
- "
- thisIsARestart ifTrue:[
- (imageName asFilename hasSuffix:'img') ifTrue:[
- imageName := imageName copyWithoutLast:4
- ].
- self fileIn:(imageName , '.rc')
- ].
+ "
+ allow more customization by reading an image specific rc-file
+ "
+ thisIsARestart ifTrue:[
+ (imageName asFilename hasSuffix:'img') ifTrue:[
+ imageName := imageName copyWithoutLast:4
+ ].
+ self fileIn:(imageName , '.rc')
+ ].
"/ Display notNil ifTrue:[
"/ Display exitOnLastClose:true.
"/ ].
"/ Processor exitWhenNoMoreUserProcesses:true.
- standAloneProcess := [
- StartupClass perform:StartupSelector withArguments:StartupArguments.
- "/
- "/ non-GUI apps exit after the startup;
- "/ assume that GUI apps have created & opened some view ...
- "/
- Display isNil ifTrue:[
- Smalltalk exit.
- ].
- "/
- "/ GUI apps exit after the last user process has finished
- "/
- Display exitOnLastClose:true.
- Processor exitWhenNoMoreUserProcesses:true.
- ] newProcess.
- standAloneProcess priority:8.
- standAloneProcess name:'main'.
- standAloneProcess beGroupLeader.
- standAloneProcess resume.
+ standAloneProcess := [
+ StartupClass perform:StartupSelector withArguments:StartupArguments.
+ "/
+ "/ non-GUI apps exit after the startup;
+ "/ assume that GUI apps have created & opened some view ...
+ "/
+ Display isNil ifTrue:[
+ Smalltalk exit.
+ ].
+ "/
+ "/ GUI apps exit after the last user process has finished
+ "/
+ Display exitOnLastClose:true.
+ Processor exitWhenNoMoreUserProcesses:true.
+ ] newProcess.
+ standAloneProcess priority:8.
+ standAloneProcess name:'main'.
+ standAloneProcess beGroupLeader.
+ standAloneProcess resume.
].
"
if view-classes exist, start dispatching;
otherwise go into a read-eval-print loop
"
+'Display is:' print. Display printCR.
((Display notNil and:[graphicalMode])
or:[standAloneProcess notNil
or:[HeadlessOperation]]) ifTrue:[
- Processor dispatchLoop.
+ Processor dispatchLoop.
] ifFalse:[
- StandAlone ifFalse:[
- self readEvalPrint
- ]
+ StandAlone ifFalse:[
+ self readEvalPrint
+ ]
].
"done - the last process finished"
@@ -2629,20 +2630,20 @@
'ST- ' print.
Stdin skipSeparators.
Stdin atEnd ifFalse:[
- text := Stdin nextChunk.
- [text notNil] whileTrue:[
- AbortSignal handle:[:ex |
- 'evaluation aborted' printCR
- ] do:[
- Compiler isNil ifTrue:[
- 'No evaluator class available (Compiler == nil)' printCR.
- ^ self
- ].
- (Compiler evaluate:text) printCR.
- ].
- 'ST- ' print.
- text := Stdin nextChunk
- ].
+ text := Stdin nextChunk.
+ [text notNil] whileTrue:[
+ AbortSignal handle:[:ex |
+ 'evaluation aborted' printCR
+ ] do:[
+ Compiler isNil ifTrue:[
+ 'No evaluator class available (Compiler == nil)' printCR.
+ ^ self
+ ].
+ (Compiler evaluate:text) printCR.
+ ].
+ 'ST- ' print.
+ text := Stdin nextChunk
+ ].
].
'' printCR
!
@@ -2655,15 +2656,15 @@
#earlySystemInstallation is sent for ST80 compatibility
#earlyRestart is send first, nothing has been setup yet.
- (should be used to flush all device dependent entries)
+ (should be used to flush all device dependent entries)
#restarted is send right after.
- (should be used to recreate external resources (fds, bitmaps etc)
+ (should be used to recreate external resources (fds, bitmaps etc)
#returnFromSnapshot is sent last
- (should be used to restart processes, reOpen Streams which cannot
- be automatically be reopened (i.e. Sockets, Pipes) and so on.
- (Notice that positionable fileStreams are already reopened and repositioned)
+ (should be used to restart processes, reOpen Streams which cannot
+ be automatically be reopened (i.e. Sockets, Pipes) and so on.
+ (Notice that positionable fileStreams are already reopened and repositioned)
"
|deb insp transcript idx|
@@ -2683,13 +2684,13 @@
CommandLine := CommandLineArguments copy.
CommandLineArguments := CommandLineArguments asOrderedCollection.
- CommandLineArguments removeAtIndex:1. "/ the command
+ CommandName := CommandLineArguments removeFirst. "/ the command
idx := CommandLineArguments indexOf:'-q'.
idx ~~ 0 ifTrue:[
- Object infoPrinting:false.
- ObjectMemory infoPrinting:false.
- CommandLineArguments removeAtIndex:idx.
+ Object infoPrinting:false.
+ ObjectMemory infoPrinting:false.
+ CommandLineArguments removeAtIndex:idx.
].
"/
@@ -2724,7 +2725,7 @@
insp := Inspector.
deb := Debugger.
deb notNil ifTrue:[
- deb reinitialize
+ deb reinitialize
].
Inspector := MiniInspector.
Debugger := MiniDebugger.
@@ -2737,7 +2738,7 @@
"/ ObjectFileLoader; therefore, must reload before doing any notifications.
ObjectFileLoader notNil ifTrue:[
- ObjectFileLoader reloadAllRememberedObjectFiles.
+ ObjectFileLoader reloadAllRememberedObjectFiles.
].
"/
@@ -2746,9 +2747,9 @@
"/ a display during early startup.
Screen notNil ifTrue:[
- Screen allScreens do:[:aDisplay |
- aDisplay invalidateConnection
- ].
+ Screen allScreens do:[:aDisplay |
+ aDisplay invalidateConnection
+ ].
].
ObjectMemory changed:#earlySystemInstallation.
@@ -2764,7 +2765,7 @@
"/ (mostly view/GC/color & font stuff)
ObjectMemory
- changed:#earlyRestart; changed:#restarted.
+ changed:#earlyRestart; changed:#restarted.
"/
"/ start catching SIGINT and SIGQUIT
@@ -2778,61 +2779,61 @@
idx := CommandLineArguments indexOf:'-faststart'.
idx ~~ 0 ifTrue:[
- CommandLineArguments removeAtIndex:idx.
+ CommandLineArguments removeAtIndex:idx.
] ifFalse:[
- CallbackSignal := QuerySignal new.
- [
- Class withoutUpdatingChangesDo:[
- (self fileIn:(self commandName , '_r.rc')) ifFalse:[
- "no _r.rc file where executable is; try default smalltalk_r.rc"
- self fileIn:'smalltalk_r.rc'
- ].
- ]
- ] on:CallbackSignal do:[:ex|
- "/ now, display and view-stuff works;
- "/ back to the previous debugging interface
-
- Inspector := insp.
- Debugger := deb.
-
- "/ reinstall Transcript, if not changed during restart.
- "/ if there was no Transcript, go to stderr
-
- (transcript notNil and:[Transcript == Stderr]) ifTrue:[
- Transcript := transcript.
- ].
- Initializing := false.
- ex proceed.
- ].
- CallbackSignal := nil.
+ CallbackSignal := QuerySignal new.
+ [
+ Class withoutUpdatingChangesDo:[
+ (self fileIn:(self commandName , '_r.rc')) ifFalse:[
+ "no _r.rc file where executable is; try default smalltalk_r.rc"
+ self fileIn:'smalltalk_r.rc'
+ ].
+ ]
+ ] on:CallbackSignal do:[:ex|
+ "/ now, display and view-stuff works;
+ "/ back to the previous debugging interface
+
+ Inspector := insp.
+ Debugger := deb.
+
+ "/ reinstall Transcript, if not changed during restart.
+ "/ if there was no Transcript, go to stderr
+
+ (transcript notNil and:[Transcript == Stderr]) ifTrue:[
+ Transcript := transcript.
+ ].
+ Initializing := false.
+ ex proceed.
+ ].
+ CallbackSignal := nil.
].
"/ reinitialization (restart) of Display is normally performed
"/ in the restart script. If this has not been run for some reason,
"/ do in now.
Initializing ifTrue:[
- Display notNil ifTrue:[
- [
- Display reinitializeFor:Screen defaultDisplayName.
- ] on:Screen deviceOpenErrorSignal do:[
- 'Smalltalk [error]: Cannot restart connection to: ' errorPrint.
- Screen defaultDisplayName errorPrintCR.
- Smalltalk exit.
- ].
- ].
- "/ now, display and view-stuff works;
- "/ back to the previous debugging interface
-
- Inspector := insp.
- Debugger := deb.
-
- "/ reinstall Transcript, if not changed during restart.
- "/ if there was no Transcript, go to stderr
-
- (transcript notNil and:[Transcript == Stderr]) ifTrue:[
- Transcript := transcript.
- ].
- Initializing := false.
+ Display notNil ifTrue:[
+ [
+ Display reinitializeFor:Screen defaultDisplayName.
+ ] on:Screen deviceOpenErrorSignal do:[
+ 'Smalltalk [error]: Cannot restart connection to: ' errorPrint.
+ Screen defaultDisplayName errorPrintCR.
+ Smalltalk exit.
+ ].
+ ].
+ "/ now, display and view-stuff works;
+ "/ back to the previous debugging interface
+
+ Inspector := insp.
+ Debugger := deb.
+
+ "/ reinstall Transcript, if not changed during restart.
+ "/ if there was no Transcript, go to stderr
+
+ (transcript notNil and:[Transcript == Stderr]) ifTrue:[
+ Transcript := transcript.
+ ].
+ Initializing := false.
].
self mainStartup:true
@@ -2854,89 +2855,89 @@
while reading patches- and rc-file, do not add things into change-file
"
Class withoutUpdatingChangesDo:[
- |myName defaultRC prevCatchSetting|
-
- "/
- "/ look for any '-q', '-e' or '-f' command line arguments
- "/ and handle them;
- "/ read startup and patches file
- "/
- idx := CommandLineArguments indexOf:'-q'.
- idx ~~ 0 ifTrue:[
- Object infoPrinting:false.
- ObjectMemory infoPrinting:false.
- CommandLineArguments removeAtIndex:idx.
- ].
-
- StandAlone ifFalse:[
- "/ look for a '-e filename' argument - this will force evaluation of
- "/ filename only, no standard startup
-
- idx := CommandLineArguments indexOf:'-e'.
- idx ~~ 0 ifTrue:[
- arg := CommandLineArguments at:idx + 1.
-
- CommandLineArguments
- removeAtIndex:idx+1; removeAtIndex:idx.
-
- arg = '-' ifTrue:[
- self fileInStream:Stdin
- lazy:nil
- silent:nil
- logged:false
- addPath:nil
- ] ifFalse:[
- self fileIn:arg.
- ].
- self exit
- ].
- ].
-
- "/ look for a '-f filename' argument - this will force evaluation of
- "/ filename instead of smalltalk.rc
-
- idx := CommandLineArguments indexOf:'-f'.
- idx ~~ 0 ifTrue:[
- myName := (CommandLineArguments at:idx + 1).
- CommandLineArguments
- removeAtIndex:idx+1; removeAtIndex:idx.
- CommandLine at:1 put:myName.
- (self secureFileIn:myName) ifFalse:[
- ('Smalltalk [error]: startup file ', myName, ' not found.') errorPrintCR.
- self exit.
- ].
- ] ifFalse:[
- "/ look for <command>.rc
- "/ if not found, read smalltalk.rc (or stxapp.rc for standAlone operation)
-
- myName := self commandName asFilename withSuffix:'rc'.
- (self secureFileIn:myName) ifFalse:[
- StandAlone ifFalse:[
- defaultRC := 'smalltalk.rc'
- ] ifTrue:[
- defaultRC := 'stxapp.rc'
- ].
-
- (self secureFileIn:defaultRC) ifFalse:[
- StandAlone ifFalse:[
- 'Smalltalk [warning]: no startup rc-file found. Going into line-by-line interpreter.' infoPrintCR.
- graphicalMode := false.
- ]
- ]
- ].
- ].
+ |myName defaultRC prevCatchSetting|
+
+ "/
+ "/ look for any '-q', '-e' or '-f' command line arguments
+ "/ and handle them;
+ "/ read startup and patches file
+ "/
+ idx := CommandLineArguments indexOf:'-q'.
+ idx ~~ 0 ifTrue:[
+ Object infoPrinting:false.
+ ObjectMemory infoPrinting:false.
+ CommandLineArguments removeAtIndex:idx.
+ ].
+
+ StandAlone ifFalse:[
+ "/ look for a '-e filename' argument - this will force evaluation of
+ "/ filename only, no standard startup
+
+ idx := CommandLineArguments indexOf:'-e'.
+ idx ~~ 0 ifTrue:[
+ arg := CommandLineArguments at:idx + 1.
+
+ CommandLineArguments
+ removeAtIndex:idx+1; removeAtIndex:idx.
+
+ arg = '-' ifTrue:[
+ self fileInStream:Stdin
+ lazy:nil
+ silent:nil
+ logged:false
+ addPath:nil
+ ] ifFalse:[
+ self fileIn:arg.
+ ].
+ self exit
+ ].
+ ].
+
+ "/ look for a '-f filename' argument - this will force evaluation of
+ "/ filename instead of smalltalk.rc
+
+ idx := CommandLineArguments indexOf:'-f'.
+ idx ~~ 0 ifTrue:[
+ myName := (CommandLineArguments at:idx + 1).
+ CommandLineArguments
+ removeAtIndex:idx+1; removeAtIndex:idx.
+ CommandLine at:1 put:myName.
+ (self secureFileIn:myName) ifFalse:[
+ ('Smalltalk [error]: startup file ', myName, ' not found.') errorPrintCR.
+ self exit.
+ ].
+ ] ifFalse:[
+ "/ look for <command>.rc
+ "/ if not found, read smalltalk.rc (or stxapp.rc for standAlone operation)
+
+ myName := self commandName asFilename withSuffix:'rc'.
+ (self secureFileIn:myName) ifFalse:[
+ StandAlone ifFalse:[
+ defaultRC := 'smalltalk.rc'
+ ] ifTrue:[
+ defaultRC := 'stxapp.rc'
+ ].
+
+ (self secureFileIn:defaultRC) ifFalse:[
+ StandAlone ifFalse:[
+ 'Smalltalk [warning]: no startup rc-file found. Going into line-by-line interpreter.' infoPrintCR.
+ graphicalMode := false.
+ ]
+ ]
+ ].
+ ].
].
StandAlone ifFalse:[
- "
- enable the graphical debugger/inspector
- (they could have been (re)defined as autoloaded in the patches file)
- "
- self initStandardTools.
+ "
+ enable the graphical debugger/inspector
+ (they could have been (re)defined as autoloaded in the patches file)
+ "
+ self initStandardTools.
].
(Display isNil or:[HeadlessOperation]) ifTrue:[
- graphicalMode := false.
+ graphicalMode := false.
].
self mainStartup:graphicalMode
@@ -2955,15 +2956,14 @@
!
commandLineArgumentNamed:aString
- "extract the default display name from command line arguments
- and environment. Nil is a valid name which represents the builtin default"
+ "extract a named argument from the command line arguments."
|args index|
args := self commandLineArguments.
index := args indexOf:aString.
(index between:1 and:(args size - 1)) ifTrue:[
- ^ args at:index+1
+ ^ args at:index+1
].
^ nil.
@@ -2989,7 +2989,7 @@
"return the excutables name - this is normally 'smalltalk', but
can be something else for standAlone apps."
- ^ CommandLine at:1.
+ ^ CommandName.
"Modified: 19.7.1996 / 11:11:16 / cg"
!
@@ -3238,30 +3238,30 @@
"/ install if not already compiled-in
(cls := self at:clsSym) isNil ifTrue:[
- Autoload subclass:clsSym
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:cat
- inEnvironment:Smalltalk.
-
- cls := self at:clsSym.
- cls isNil ifTrue:[
- ('Smalltalk [warning]: failed to install ' , clsName , ' as autoloaded.') infoPrintCR.
- ] ifFalse:[
- cls package:package asSymbol.
- revisionOrNil notNil ifTrue:[
- cls setBinaryRevision:revisionOrNil
- ]
- ]
+ Autoload subclass:clsSym
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:cat
+ inEnvironment:Smalltalk.
+
+ cls := self at:clsSym.
+ cls isNil ifTrue:[
+ ('Smalltalk [warning]: failed to install ' , clsName , ' as autoloaded.') infoPrintCR.
+ ] ifFalse:[
+ cls package:package asSymbol.
+ revisionOrNil notNil ifTrue:[
+ cls setBinaryRevision:revisionOrNil
+ ]
+ ]
] ifFalse:[
- "/ class already present - however, check for same category/package
- package ~= cls package ifTrue:[
- cls package:package asSymbol.
- ].
- cat ~= cls category ifTrue:[
- cls category:cat.
- ].
+ "/ class already present - however, check for same category/package
+ package ~= cls package ifTrue:[
+ cls package:package asSymbol.
+ ].
+ cat ~= cls category ifTrue:[
+ cls category:cat.
+ ].
].
"Created: / 5.11.1998 / 15:10:25 / cg"
@@ -3294,24 +3294,24 @@
"/ along the package-path
(p := self packagePath) do:[:aPath |
- (dirsConsulted includes:aPath) ifFalse:[
- ('Smalltalk [info]: installing autoloaded classes found under ''' , aPath ,'''') infoPrintCR.
- self
- recursiveInstallAutoloadedClassesFrom:aPath
- rememberIn:dirsConsulted
- maxLevels:5
- noAutoload:false
- packageTop:aPath.
- ]
+ (dirsConsulted includes:aPath) ifFalse:[
+ ('Smalltalk [info]: installing autoloaded classes found under ''' , aPath ,'''') infoPrintCR.
+ self
+ recursiveInstallAutoloadedClassesFrom:aPath
+ rememberIn:dirsConsulted
+ maxLevels:5
+ noAutoload:false
+ packageTop:aPath.
+ ]
].
p size == 0 ifTrue:[
- ('Smalltalk [info]: installing autoloaded classes found under ''../../..''') infoPrintCR.
- self
- recursiveInstallAutoloadedClassesFrom:'../../..'
- rememberIn:dirsConsulted
- maxLevels:5
- noAutoload:false
- packageTop:'../../..'.
+ ('Smalltalk [info]: installing autoloaded classes found under ''../../..''') infoPrintCR.
+ self
+ recursiveInstallAutoloadedClassesFrom:'../../..'
+ rememberIn:dirsConsulted
+ maxLevels:5
+ noAutoload:false
+ packageTop:'../../..'.
].
"/ old scheme: look for a single file called 'abbrev.stc' in the
@@ -3338,15 +3338,15 @@
f isNil ifTrue:[f := self getPackageFileName:anAbbrevFilePath].
f notNil ifTrue:[
- f := f asFilename.
- f isDirectory ifTrue:[
- f := f construct:'abbrev.stc'
- ].
- s := f readStream.
- s notNil ifTrue:[
- self installAutoloadedClassesFromStream:s.
- s close.
- ].
+ f := f asFilename.
+ f isDirectory ifTrue:[
+ f := f construct:'abbrev.stc'
+ ].
+ s := f readStream.
+ s notNil ifTrue:[
+ self installAutoloadedClassesFromStream:s.
+ s close.
+ ].
]
"
@@ -3366,96 +3366,96 @@
"/ on the fly, update the abbreviations
CachedAbbreviations isNil ifTrue:[
- CachedAbbreviations := IdentityDictionary new.
+ CachedAbbreviations := IdentityDictionary new.
].
abbrevs := CachedAbbreviations.
KnownPackages isNil ifTrue:[
- KnownPackages := Set new.
+ KnownPackages := Set new.
].
"/ yes, create any required nameSpace, without asking user.
Class createNameSpaceQuerySignal answer:true do:[
- [anAbbrevFileStream atEnd] whileFalse:[
- l := anAbbrevFileStream nextLine withoutSeparators.
- l notEmpty ifTrue:[
- "/ must do it manually, caring for quoted strings.
+ [anAbbrevFileStream atEnd] whileFalse:[
+ l := anAbbrevFileStream nextLine withoutSeparators.
+ l notEmpty ifTrue:[
+ "/ must do it manually, caring for quoted strings.
"/ words := line asCollectionOfWords.
- words := OrderedCollection new.
- s2 := l readStream.
- [s2 atEnd] whileFalse:[
- s2 skipSeparators.
- s2 peek == $' ifTrue:[
- s2 next.
- w := s2 upTo:$'.
- s2 skipSeparators.
- ] ifFalse:[
- w := s2 upToSeparator
- ].
- words add:w
- ].
- words size < 3 ifTrue:[
- 'Smalltalk [warning]: bad abbrev entry' errorPrint.
- anAbbrevFileStream isFileStream ifTrue:[
- ' (in ''' errorPrint.
- anAbbrevFileStream pathName errorPrint.
- ''')' errorPrint
- ].
- ': ' errorPrint. l errorPrintCR
- ] ifFalse:[
- clsName := (words at:1) asSymbol.
- abbrev := (words at:2).
- package := (words at:3) asSymbol.
+ words := OrderedCollection new.
+ s2 := l readStream.
+ [s2 atEnd] whileFalse:[
+ s2 skipSeparators.
+ s2 peek == $' ifTrue:[
+ s2 next.
+ w := s2 upTo:$'.
+ s2 skipSeparators.
+ ] ifFalse:[
+ w := s2 upToSeparator
+ ].
+ words add:w
+ ].
+ words size < 3 ifTrue:[
+ 'Smalltalk [warning]: bad abbrev entry' errorPrint.
+ anAbbrevFileStream isFileStream ifTrue:[
+ ' (in ''' errorPrint.
+ anAbbrevFileStream pathName errorPrint.
+ ''')' errorPrint
+ ].
+ ': ' errorPrint. l errorPrintCR
+ ] ifFalse:[
+ clsName := (words at:1) asSymbol.
+ abbrev := (words at:2).
+ package := (words at:3) asSymbol.
"/ KnownPackages add:package.
- cat := words at:4 ifAbsent:nil.
-
- (cat size == 0) ifTrue:[
- cat := 'autoloaded'
- ].
-
- "/ on the fly, update the abbreviations
- clsName ~= abbrev ifTrue:[
- nameKey := clsName asSymbol.
- oldAbbrev := abbrevs at:nameKey ifAbsent:nil.
- (oldAbbrev notNil and:[oldAbbrev ~= abbrev]) ifTrue:[
- StandAlone ifFalse:[
- ('Smalltalk [warning]: conflict for: ' , clsName , ' in ' , (anAbbrevFileStream pathName)) infoPrintCR.
- ('Smalltalk [warning]: (' , oldAbbrev , ' <-> ' , abbrev , ')') infoPrintCR
- ].
- abbrevs at:nameKey put:abbrev.
- ] ifFalse:[
- cls := self classNamed:abbrev.
-
- cls notNil ifTrue:[
- cls name ~= clsName ifTrue:[
- "/ ok, there is a class named after this abbrev ...
- "/ this is only a conflict, if the other class has no
- "/ abbreviation (or the same).
- (abbrevs at:(cls name asSymbol) ifAbsent:cls name) = abbrev ifTrue:[
- cls isNameSpace ifFalse:[
- package = cls package ifTrue:[
- StandAlone ifFalse:[
- ('Smalltalk [warning]: conflict for: ' , cls name , ' in ' , (anAbbrevFileStream pathName)) infoPrintCR.
- ('Smalltalk [warning]: (' , clsName , ' -> ' , abbrev , ')') infoPrintCR
- ]
- ]
- ]
- ]
- ]
- ].
- abbrevs at:clsName asSymbol put:abbrev.
- ]
- ].
-
- "/ ' autoloaded: ' print. clsName print. ' in ' print. cat printCR.
-
- self installAutoloadedClassNamed:clsName category:cat package:package revision:nil.
- ]
- ]
- ]
+ cat := words at:4 ifAbsent:nil.
+
+ (cat size == 0) ifTrue:[
+ cat := 'autoloaded'
+ ].
+
+ "/ on the fly, update the abbreviations
+ clsName ~= abbrev ifTrue:[
+ nameKey := clsName asSymbol.
+ oldAbbrev := abbrevs at:nameKey ifAbsent:nil.
+ (oldAbbrev notNil and:[oldAbbrev ~= abbrev]) ifTrue:[
+ StandAlone ifFalse:[
+ ('Smalltalk [warning]: conflict for: ' , clsName , ' in ' , (anAbbrevFileStream pathName)) infoPrintCR.
+ ('Smalltalk [warning]: (' , oldAbbrev , ' <-> ' , abbrev , ')') infoPrintCR
+ ].
+ abbrevs at:nameKey put:abbrev.
+ ] ifFalse:[
+ cls := self classNamed:abbrev.
+
+ cls notNil ifTrue:[
+ cls name ~= clsName ifTrue:[
+ "/ ok, there is a class named after this abbrev ...
+ "/ this is only a conflict, if the other class has no
+ "/ abbreviation (or the same).
+ (abbrevs at:(cls name asSymbol) ifAbsent:cls name) = abbrev ifTrue:[
+ cls isNameSpace ifFalse:[
+ package = cls package ifTrue:[
+ StandAlone ifFalse:[
+ ('Smalltalk [warning]: conflict for: ' , cls name , ' in ' , (anAbbrevFileStream pathName)) infoPrintCR.
+ ('Smalltalk [warning]: (' , clsName , ' -> ' , abbrev , ')') infoPrintCR
+ ]
+ ]
+ ]
+ ]
+ ]
+ ].
+ abbrevs at:clsName asSymbol put:abbrev.
+ ]
+ ].
+
+ "/ ' autoloaded: ' print. clsName print. ' in ' print. cat printCR.
+
+ self installAutoloadedClassNamed:clsName category:cat package:package revision:nil.
+ ]
+ ]
+ ]
]
!
@@ -3546,39 +3546,39 @@
maxLevels == 0 ifTrue:[
"/ 'Smalltalk [warning]: max directory nesting reached.' infoPrintCR.
- ^ self
+ ^ self
].
dir := aDirectory asFilename.
(dirsConsulted includes:dir pathName) ifTrue:[
- ^ self
+ ^ self
].
dirsConsulted add:dir pathName.
(dir construct:'NOPACKAGES') exists ifTrue:[
- ^ self.
+ ^ self.
].
noAutoloadHere := noAutoloadIn.
noAutoloadHere ifFalse:[
- (dir construct:'NOAUTOLOAD') exists ifTrue:[
- noAutoloadHere := true.
- ].
+ (dir construct:'NOAUTOLOAD') exists ifTrue:[
+ noAutoloadHere := true.
+ ].
] ifTrue:[
- (dir construct:'AUTOLOAD') exists ifTrue:[
- noAutoloadHere := false.
- ].
+ (dir construct:'AUTOLOAD') exists ifTrue:[
+ noAutoloadHere := false.
+ ].
].
((dir construct:'loadAll') exists
or:[(dir construct:'abbrev.stc') exists
or:[(dir construct:(dir baseName , '.prj')) exists]]) ifTrue:[
- KnownPackages isNil ifTrue:[
- KnownPackages := Set new.
- ].
- dirName := dir pathName.
- pkgName := dirName copyFrom:(packageTopPath asFilename pathName) size + 1 + 1.
- KnownPackages add:pkgName
+ KnownPackages isNil ifTrue:[
+ KnownPackages := Set new.
+ ].
+ dirName := dir pathName.
+ pkgName := dirName copyFrom:(packageTopPath asFilename pathName) size + 1 + 1.
+ KnownPackages add:pkgName
].
"/
@@ -3586,45 +3586,45 @@
"/ below; however, still traverse the directories to find packages ...
"/
noAutoloadHere ifFalse:[
- abbrevStream := (dir construct:'abbrev.stc') asFilename readStream.
- abbrevStream notNil ifTrue:[
- "/ abbrevStream pathName printCR.
- self installAutoloadedClassesFromStream:abbrevStream.
- abbrevStream close.
- ].
+ abbrevStream := (dir construct:'abbrev.stc') asFilename readStream.
+ abbrevStream notNil ifTrue:[
+ "/ abbrevStream pathName printCR.
+ self installAutoloadedClassesFromStream:abbrevStream.
+ abbrevStream close.
+ ].
].
(dir directoryContents ? #()) do:[:aFilename |
- |f|
-
- (#(
- 'doc'
- 'CVS'
- 'bitmaps'
- 'resources'
- 'source'
- ) includes:aFilename) ifFalse:[
- ((dir baseName ~= 'stx')
- or:[
- (#(
- 'configurations'
- 'include'
- 'rules'
- 'stc'
- 'support'
- ) includes:aFilename) not])
- ifTrue:[
- f := dir construct:aFilename.
- f isDirectory ifTrue:[
- self
- recursiveInstallAutoloadedClassesFrom:f
- rememberIn:dirsConsulted
- maxLevels:maxLevels-1
- noAutoload:noAutoloadHere
- packageTop:packageTopPath.
- ]
- ]
- ].
+ |f|
+
+ (#(
+ 'doc'
+ 'CVS'
+ 'bitmaps'
+ 'resources'
+ 'source'
+ ) includes:aFilename) ifFalse:[
+ ((dir baseName ~= 'stx')
+ or:[
+ (#(
+ 'configurations'
+ 'include'
+ 'rules'
+ 'stc'
+ 'support'
+ ) includes:aFilename) not])
+ ifTrue:[
+ f := dir construct:aFilename.
+ f isDirectory ifTrue:[
+ self
+ recursiveInstallAutoloadedClassesFrom:f
+ rememberIn:dirsConsulted
+ maxLevels:maxLevels-1
+ noAutoload:noAutoloadHere
+ packageTop:packageTopPath.
+ ]
+ ]
+ ].
].
"
@@ -3637,15 +3637,15 @@
toAdd := OrderedCollection new.
self keysAndValuesDo:[:key :val |
- (key == anObject) ifTrue:[
- self halt:'not implemented'.
- ].
- (val == anObject ) ifTrue:[
- toAdd add:(key -> newRef)
- ].
+ (key == anObject) ifTrue:[
+ self halt:'not implemented'.
+ ].
+ (val == anObject ) ifTrue:[
+ toAdd add:(key -> newRef)
+ ].
].
toAdd do:[:each |
- self at:(each key) put:(each value)
+ self at:(each key) put:(each value)
].
!
@@ -3761,10 +3761,10 @@
If silent is true, no compiler messages are output to the transcript.
Giving nil for silent/lazy will use the current settings.
This method can load almost anything which makes sense:
- .st - source files
- .cls - binary smalltalk bytecode files
- .so - binary compiled machine code class libraries
- [.class - java bytecode -- soon to come]"
+ .st - source files
+ .cls - binary smalltalk bytecode files
+ .so - binary compiled machine code class libraries
+ [.class - java bytecode -- soon to come]"
|fileNameString aStream path morePath bos|
@@ -3775,55 +3775,55 @@
"
(ObjectFileLoader notNil
and:[ObjectFileLoader hasValidBinaryExtension:fileNameString]) ifTrue:[
- "/ LoadBinaries ifFalse:[^ false].
- path := self getBinaryFileName:fileNameString.
- path isNil ifTrue:[
- path := self getSystemFileName:fileNameString.
- ].
- path isNil ifTrue:[^ false].
- ^ (ObjectFileLoader loadObjectFile:path) notNil
+ "/ LoadBinaries ifFalse:[^ false].
+ path := self getBinaryFileName:fileNameString.
+ path isNil ifTrue:[
+ path := self getSystemFileName:fileNameString.
+ ].
+ path isNil ifTrue:[^ false].
+ ^ (ObjectFileLoader loadObjectFile:path) notNil
].
(fileNameString asFilename hasSuffix:'cls') ifTrue:[
- BinaryObjectStorage notNil ifTrue:[
- aStream := self systemFileStreamFor:fileNameString.
+ BinaryObjectStorage notNil ifTrue:[
+ aStream := self systemFileStreamFor:fileNameString.
"/ path := self getBinaryFileName:fileNameString.
"/ path isNil ifTrue:[^ false].
"/ aStream := path asFilename readStream.
- aStream notNil ifTrue:[
- aStream binary.
- bos := BinaryObjectStorage onOld:aStream.
- bos next.
- bos close.
- ^ true
- ].
- ^ false
- ]
+ aStream notNil ifTrue:[
+ aStream binary.
+ bos := BinaryObjectStorage onOld:aStream.
+ bos next.
+ bos close.
+ ^ true
+ ].
+ ^ false
+ ]
].
(fileNameString startsWith:'source/') ifTrue:[
- aStream := self sourceFileStreamFor:(fileNameString copyFrom:8)
+ aStream := self sourceFileStreamFor:(fileNameString copyFrom:8)
] ifFalse:[
- (fileNameString startsWith:'fileIn/') ifTrue:[
- aStream := self fileInFileStreamFor:(fileNameString copyFrom:8)
- ] ifFalse:[
- aStream := self systemFileStreamFor:fileNameString.
- aStream isNil ifTrue:[
- OperatingSystem isUNIXlike ifTrue:[
- (fileNameString startsWith:'/') ifFalse:[
- aStream := self systemFileStreamFor:('lib/' , fileNameString).
- ]
- ]
- ].
- (aStream notNil and:[fileNameString includes:$/]) ifTrue:[
- "/ temporarily prepend the files directory
- "/ to the searchPath.
- "/ This allows fileIn-driver files to refer to local
- "/ files via a relative path, and drivers to fileIn other
- "/ drivers ...
- morePath := aStream pathName asFilename directoryName.
- ]
- ]
+ (fileNameString startsWith:'fileIn/') ifTrue:[
+ aStream := self fileInFileStreamFor:(fileNameString copyFrom:8)
+ ] ifFalse:[
+ aStream := self systemFileStreamFor:fileNameString.
+ aStream isNil ifTrue:[
+ OperatingSystem isUNIXlike ifTrue:[
+ (fileNameString startsWith:'/') ifFalse:[
+ aStream := self systemFileStreamFor:('lib/' , fileNameString).
+ ]
+ ]
+ ].
+ (aStream notNil and:[fileNameString includes:$/]) ifTrue:[
+ "/ temporarily prepend the files directory
+ "/ to the searchPath.
+ "/ This allows fileIn-driver files to refer to local
+ "/ files via a relative path, and drivers to fileIn other
+ "/ drivers ...
+ morePath := aStream pathName asFilename directoryName.
+ ]
+ ]
].
aStream isNil ifTrue:[^ false].
^ self fileInStream:aStream lazy:lazy silent:silent logged:logged addPath:morePath
@@ -3978,303 +3978,303 @@
wasLazy := Compiler compileLazy:loadLazy.
beSilent notNil ifTrue:[
- wasSilent := self silentLoading:beSilent.
+ wasSilent := self silentLoading:beSilent.
].
longName := aClassName copyReplaceAll:$: with:$_.
[
- Class withoutUpdatingChangesDo:
- [
- |zarFn zar entry|
-
- ok := false.
-
- shortName := self fileNameForClass:aClassName.
- package notNil ifTrue:[
- packageDir := package asString.
- packageDir := packageDir copyReplaceAll:$: with:$/.
- ].
-
- Class packageQuerySignal answer:package
- do:[
-
- "
- first, look for a loader-driver file (in fileIn/xxx.ld)
- "
- (ok := self fileIn:('fileIn/' , shortName , '.ld') lazy:loadLazy silent:beSilent)
- ifFalse:[
- "
- try abbreviated driver-file (in fileIn/xxx.ld)
- "
- shortName ~= aClassName ifTrue:[
- ok := self fileIn:('fileIn/' , longName , '.ld') lazy:loadLazy silent:beSilent
- ].
- ok ifFalse:[
- "
- then, if dynamic linking is available,
- "
- (LoadBinaries and:[ObjectFileLoader notNil]) ifTrue:[
- sharedLibExtension := ObjectFileLoader sharedLibraryExtension.
-
- "
- first look for a class packages shared binary in binary/xxx.o
- "
- libName := self libraryFileNameOfClass:aClassName.
- libName notNil ifTrue:[
- (ok := self fileInClass:aClassName fromObject:(libName, sharedLibExtension))
- ifFalse:[
- sharedLibExtension ~= '.o' ifTrue:[
- ok := self fileInClass:aClassName fromObject:(libName, '.o')
- ]
- ].
- ].
-
- "
- then, look for a shared binary in binary/xxx.o
- "
- ok ifFalse:[
- (ok := self fileInClass:aClassName fromObject:(shortName, sharedLibExtension))
- ifFalse:[
- sharedLibExtension ~= '.o' ifTrue:[
- ok := self fileInClass:aClassName fromObject:(shortName, '.o')
- ].
- ok ifFalse:[
- shortName ~= aClassName ifTrue:[
- (ok := self fileInClass:aClassName fromObject:(longName, sharedLibExtension))
- ifFalse:[
- sharedLibExtension ~= '.o' ifTrue:[
- ok := self fileInClass:aClassName fromObject:(longName, '.o')
- ]
- ]
- ].
- ].
- ].
- ].
- ].
-
- "
- if that did not work, look for a compiled-bytecode file ...
- "
- ok ifFalse:[
- (ok := self fileIn:(shortName , '.cls') lazy:loadLazy silent:beSilent)
- ifFalse:[
- shortName ~= aClassName ifTrue:[
- ok := self fileIn:(longName , '.cls') lazy:loadLazy silent:beSilent
- ]
- ]
- ].
- "
- if that did not work, and the classes package is known,
- look for an st-cls file
- in a package subdir of the source-directory ...
- "
- ok ifFalse:[
- (packageDir notNil and:[BinaryObjectStorage notNil]) ifTrue:[
- packageFile := self getPackageFileName:(packageDir , '/classes/' , shortName , '.cls').
- packageFile isNil ifTrue:[
- packageFile := (packageDir , '/classes/' , shortName , '.cls').
- ].
- (ok := self fileIn:packageFile lazy:loadLazy silent:beSilent)
- ifFalse:[
- shortName ~= aClassName ifTrue:[
- packageFile := self getPackageFileName:(packageDir , '/classes/' , longName , '.cls').
- packageFile isNil ifTrue:[
- packageFile := (packageDir , '/classes/' , longName , '.cls').
- ].
- ok := self fileIn:packageFile lazy:loadLazy silent:beSilent
- ]
- ].
-
- zarFn := self getPackageFileName:(packageDir , '/classes.zip').
- zarFn notNil ifTrue:[
- zar := ZipArchive oldFileNamed:zarFn.
- zar notNil ifTrue:[
- entry := zar extract:(shortName , '.cls').
- (entry isNil and:[shortName ~= longName]) ifTrue:[
- entry := zar extract:(longName , '.cls').
- ].
- entry notNil ifTrue:[
- bos := BinaryObjectStorage onOld:(entry asByteArray readStream).
- bos next.
- bos close.
- ok := true
- ].
- ]
- ]
- ]
- ].
-
- "
- if that did not work, look for an st-source file ...
- "
- ok ifFalse:[
- fn := shortName , '.st'.
- (ok := self fileIn:fn lazy:loadLazy silent:beSilent)
- ifFalse:[
- shortName ~= longName ifTrue:[
- fn := longName , '.st'.
- ok := self fileIn:fn lazy:loadLazy silent:beSilent
- ].
- ok ifFalse:[
- "
- ... and in the standard source-directory
- "
- fn := 'source/' , shortName , '.st'.
- (ok := self fileIn:fn lazy:loadLazy silent:beSilent)
- ifFalse:[
- shortName ~= longName ifTrue:[
- fn := 'source/' , longName , '.st'.
- ok := self fileIn:fn lazy:loadLazy silent:beSilent
- ]
- ]
- ]
- ].
- "
- if that did not work, and the classes package is known,
- look for an st-source file
- in a package subdir of the source-directory ...
- "
- ok ifFalse:[
- packageDir notNil ifTrue:[
- packageFile := self getPackageFileName:(packageDir , '/source/' , shortName , '.st').
- packageFile isNil ifTrue:[
- packageFile := (packageDir , '/source/' , shortName , '.st').
- ].
- (ok := self fileIn:packageFile lazy:loadLazy silent:beSilent)
- ifFalse:[
- shortName ~= aClassName ifTrue:[
- packageFile := self getPackageFileName:(packageDir , '/source/' , longName , '.st').
- packageFile isNil ifTrue:[
- packageFile := (packageDir , '/source/' , longName , '.st').
- ].
- ok := self fileIn:packageFile lazy:loadLazy silent:beSilent
- ].
- ok ifFalse:[
-
- packageFile := self getPackageFileName:(packageDir , '/' , shortName , '.st').
- packageFile isNil ifTrue:[
- packageFile := (packageDir , '/' , shortName , '.st').
- ].
- (ok := self fileIn:packageFile lazy:loadLazy silent:beSilent)
- ifFalse:[
- shortName ~= aClassName ifTrue:[
- packageFile := self getPackageFileName:(packageDir , '/' , longName , '.st').
- packageFile isNil ifTrue:[
- packageFile := (packageDir , '/' , longName , '.st').
- ].
- ok := self fileIn:packageFile lazy:loadLazy silent:beSilent
- ].
- ok ifFalse:[
- "
- ... and in the standard source-directory
- "
- fn := 'source/' , packageDir , '/' , shortName , '.st'.
- (ok := self fileIn:fn lazy:loadLazy silent:beSilent)
- ifFalse:[
- shortName ~= aClassName ifTrue:[
- fn := 'source/' , packageDir , '/' , longName , '.st'.
- ok := self fileIn:fn lazy:loadLazy silent:beSilent
- ]
- ]
- ]
- ].
- ].
- ].
- ]
- ].
- "
- if that did not work, and the classes package is known,
- look for a zipArchive containing a class entry.
- "
- ok ifFalse:[
- packageDir notNil ifTrue:[
- zarFn := self getPackageFileName:(packageDir , '/source.zip').
- zarFn isNil ifTrue:[
- zarFn := packageDir asFilename withSuffix:'zip'.
- zarFn := self getSourceFileName:zarFn.
- ].
- zarFn notNil ifTrue:[
- zar := ZipArchive oldFileNamed:zarFn.
- zar notNil ifTrue:[
- entry := zar extract:(shortName , '.st').
- (entry isNil and:[shortName ~= longName]) ifTrue:[
- entry := zar extract:(longName , '.st').
- ].
- entry notNil ifTrue:[
- ok := self
- fileInStream:(entry asString readStream)
- lazy:loadLazy
- silent:beSilent
- logged:false
- addPath:nil
- ].
- ]
- ]
- ]
- ].
-
- "
- if that did not work,
- look for a zipArchive containing a class entry.
- "
- ok ifFalse:[
- zarFn := self getSourceFileName:'source.zip'.
- zarFn notNil ifTrue:[
- zar := ZipArchive oldFileNamed:zarFn.
- zar notNil ifTrue:[
- entry := zar extract:(shortName , '.st').
- (entry isNil and:[shortName ~= longName]) ifTrue:[
- entry := zar extract:(longName , '.st').
- ].
- entry notNil ifTrue:[
- ok := self
- fileInStream:(entry asString readStream)
- lazy:loadLazy
- silent:beSilent
- logged:false
- addPath:nil
- ].
- ]
- ]
- ].
- ok ifFalse:[
- "
- new: if there is a sourceCodeManager, ask it for the classes sourceCode
- "
- (mgr := Smalltalk at:#SourceCodeManager) notNil ifTrue:[
- inStream := mgr getMostRecentSourceStreamForClassNamed:aClassName.
- inStream notNil ifTrue:[
- fn := nil.
- ok := self fileInStream:inStream lazy:loadLazy silent:beSilent logged:false addPath:nil.
- ]
- ].
- ].
- ].
- ].
- ]
- ]
- ].
-
- ok ifTrue:[
- newClass := self at:(aClassName asSymbol).
- newClass notNil ifTrue:[
- fn notNil ifTrue:[
- newClass classFilename isNil ifTrue:[
- newClass setClassFilename:fn
- ].
- ].
-
- doInit ifTrue:[
- newClass initialize
- ]
- ]
- ].
+ Class withoutUpdatingChangesDo:
+ [
+ |zarFn zar entry|
+
+ ok := false.
+
+ shortName := self fileNameForClass:aClassName.
+ package notNil ifTrue:[
+ packageDir := package asString.
+ packageDir := packageDir copyReplaceAll:$: with:$/.
+ ].
+
+ Class packageQuerySignal answer:package
+ do:[
+
+ "
+ first, look for a loader-driver file (in fileIn/xxx.ld)
+ "
+ (ok := self fileIn:('fileIn/' , shortName , '.ld') lazy:loadLazy silent:beSilent)
+ ifFalse:[
+ "
+ try abbreviated driver-file (in fileIn/xxx.ld)
+ "
+ shortName ~= aClassName ifTrue:[
+ ok := self fileIn:('fileIn/' , longName , '.ld') lazy:loadLazy silent:beSilent
+ ].
+ ok ifFalse:[
+ "
+ then, if dynamic linking is available,
+ "
+ (LoadBinaries and:[ObjectFileLoader notNil]) ifTrue:[
+ sharedLibExtension := ObjectFileLoader sharedLibraryExtension.
+
+ "
+ first look for a class packages shared binary in binary/xxx.o
+ "
+ libName := self libraryFileNameOfClass:aClassName.
+ libName notNil ifTrue:[
+ (ok := self fileInClass:aClassName fromObject:(libName, sharedLibExtension))
+ ifFalse:[
+ sharedLibExtension ~= '.o' ifTrue:[
+ ok := self fileInClass:aClassName fromObject:(libName, '.o')
+ ]
+ ].
+ ].
+
+ "
+ then, look for a shared binary in binary/xxx.o
+ "
+ ok ifFalse:[
+ (ok := self fileInClass:aClassName fromObject:(shortName, sharedLibExtension))
+ ifFalse:[
+ sharedLibExtension ~= '.o' ifTrue:[
+ ok := self fileInClass:aClassName fromObject:(shortName, '.o')
+ ].
+ ok ifFalse:[
+ shortName ~= aClassName ifTrue:[
+ (ok := self fileInClass:aClassName fromObject:(longName, sharedLibExtension))
+ ifFalse:[
+ sharedLibExtension ~= '.o' ifTrue:[
+ ok := self fileInClass:aClassName fromObject:(longName, '.o')
+ ]
+ ]
+ ].
+ ].
+ ].
+ ].
+ ].
+
+ "
+ if that did not work, look for a compiled-bytecode file ...
+ "
+ ok ifFalse:[
+ (ok := self fileIn:(shortName , '.cls') lazy:loadLazy silent:beSilent)
+ ifFalse:[
+ shortName ~= aClassName ifTrue:[
+ ok := self fileIn:(longName , '.cls') lazy:loadLazy silent:beSilent
+ ]
+ ]
+ ].
+ "
+ if that did not work, and the classes package is known,
+ look for an st-cls file
+ in a package subdir of the source-directory ...
+ "
+ ok ifFalse:[
+ (packageDir notNil and:[BinaryObjectStorage notNil]) ifTrue:[
+ packageFile := self getPackageFileName:(packageDir , '/classes/' , shortName , '.cls').
+ packageFile isNil ifTrue:[
+ packageFile := (packageDir , '/classes/' , shortName , '.cls').
+ ].
+ (ok := self fileIn:packageFile lazy:loadLazy silent:beSilent)
+ ifFalse:[
+ shortName ~= aClassName ifTrue:[
+ packageFile := self getPackageFileName:(packageDir , '/classes/' , longName , '.cls').
+ packageFile isNil ifTrue:[
+ packageFile := (packageDir , '/classes/' , longName , '.cls').
+ ].
+ ok := self fileIn:packageFile lazy:loadLazy silent:beSilent
+ ]
+ ].
+
+ zarFn := self getPackageFileName:(packageDir , '/classes.zip').
+ zarFn notNil ifTrue:[
+ zar := ZipArchive oldFileNamed:zarFn.
+ zar notNil ifTrue:[
+ entry := zar extract:(shortName , '.cls').
+ (entry isNil and:[shortName ~= longName]) ifTrue:[
+ entry := zar extract:(longName , '.cls').
+ ].
+ entry notNil ifTrue:[
+ bos := BinaryObjectStorage onOld:(entry asByteArray readStream).
+ bos next.
+ bos close.
+ ok := true
+ ].
+ ]
+ ]
+ ]
+ ].
+
+ "
+ if that did not work, look for an st-source file ...
+ "
+ ok ifFalse:[
+ fn := shortName , '.st'.
+ (ok := self fileIn:fn lazy:loadLazy silent:beSilent)
+ ifFalse:[
+ shortName ~= longName ifTrue:[
+ fn := longName , '.st'.
+ ok := self fileIn:fn lazy:loadLazy silent:beSilent
+ ].
+ ok ifFalse:[
+ "
+ ... and in the standard source-directory
+ "
+ fn := 'source/' , shortName , '.st'.
+ (ok := self fileIn:fn lazy:loadLazy silent:beSilent)
+ ifFalse:[
+ shortName ~= longName ifTrue:[
+ fn := 'source/' , longName , '.st'.
+ ok := self fileIn:fn lazy:loadLazy silent:beSilent
+ ]
+ ]
+ ]
+ ].
+ "
+ if that did not work, and the classes package is known,
+ look for an st-source file
+ in a package subdir of the source-directory ...
+ "
+ ok ifFalse:[
+ packageDir notNil ifTrue:[
+ packageFile := self getPackageFileName:(packageDir , '/source/' , shortName , '.st').
+ packageFile isNil ifTrue:[
+ packageFile := (packageDir , '/source/' , shortName , '.st').
+ ].
+ (ok := self fileIn:packageFile lazy:loadLazy silent:beSilent)
+ ifFalse:[
+ shortName ~= aClassName ifTrue:[
+ packageFile := self getPackageFileName:(packageDir , '/source/' , longName , '.st').
+ packageFile isNil ifTrue:[
+ packageFile := (packageDir , '/source/' , longName , '.st').
+ ].
+ ok := self fileIn:packageFile lazy:loadLazy silent:beSilent
+ ].
+ ok ifFalse:[
+
+ packageFile := self getPackageFileName:(packageDir , '/' , shortName , '.st').
+ packageFile isNil ifTrue:[
+ packageFile := (packageDir , '/' , shortName , '.st').
+ ].
+ (ok := self fileIn:packageFile lazy:loadLazy silent:beSilent)
+ ifFalse:[
+ shortName ~= aClassName ifTrue:[
+ packageFile := self getPackageFileName:(packageDir , '/' , longName , '.st').
+ packageFile isNil ifTrue:[
+ packageFile := (packageDir , '/' , longName , '.st').
+ ].
+ ok := self fileIn:packageFile lazy:loadLazy silent:beSilent
+ ].
+ ok ifFalse:[
+ "
+ ... and in the standard source-directory
+ "
+ fn := 'source/' , packageDir , '/' , shortName , '.st'.
+ (ok := self fileIn:fn lazy:loadLazy silent:beSilent)
+ ifFalse:[
+ shortName ~= aClassName ifTrue:[
+ fn := 'source/' , packageDir , '/' , longName , '.st'.
+ ok := self fileIn:fn lazy:loadLazy silent:beSilent
+ ]
+ ]
+ ]
+ ].
+ ].
+ ].
+ ]
+ ].
+ "
+ if that did not work, and the classes package is known,
+ look for a zipArchive containing a class entry.
+ "
+ ok ifFalse:[
+ packageDir notNil ifTrue:[
+ zarFn := self getPackageFileName:(packageDir , '/source.zip').
+ zarFn isNil ifTrue:[
+ zarFn := packageDir asFilename withSuffix:'zip'.
+ zarFn := self getSourceFileName:zarFn.
+ ].
+ zarFn notNil ifTrue:[
+ zar := ZipArchive oldFileNamed:zarFn.
+ zar notNil ifTrue:[
+ entry := zar extract:(shortName , '.st').
+ (entry isNil and:[shortName ~= longName]) ifTrue:[
+ entry := zar extract:(longName , '.st').
+ ].
+ entry notNil ifTrue:[
+ ok := self
+ fileInStream:(entry asString readStream)
+ lazy:loadLazy
+ silent:beSilent
+ logged:false
+ addPath:nil
+ ].
+ ]
+ ]
+ ]
+ ].
+
+ "
+ if that did not work,
+ look for a zipArchive containing a class entry.
+ "
+ ok ifFalse:[
+ zarFn := self getSourceFileName:'source.zip'.
+ zarFn notNil ifTrue:[
+ zar := ZipArchive oldFileNamed:zarFn.
+ zar notNil ifTrue:[
+ entry := zar extract:(shortName , '.st').
+ (entry isNil and:[shortName ~= longName]) ifTrue:[
+ entry := zar extract:(longName , '.st').
+ ].
+ entry notNil ifTrue:[
+ ok := self
+ fileInStream:(entry asString readStream)
+ lazy:loadLazy
+ silent:beSilent
+ logged:false
+ addPath:nil
+ ].
+ ]
+ ]
+ ].
+ ok ifFalse:[
+ "
+ new: if there is a sourceCodeManager, ask it for the classes sourceCode
+ "
+ (mgr := Smalltalk at:#SourceCodeManager) notNil ifTrue:[
+ inStream := mgr getMostRecentSourceStreamForClassNamed:aClassName.
+ inStream notNil ifTrue:[
+ fn := nil.
+ ok := self fileInStream:inStream lazy:loadLazy silent:beSilent logged:false addPath:nil.
+ ]
+ ].
+ ].
+ ].
+ ].
+ ]
+ ]
+ ].
+
+ ok ifTrue:[
+ newClass := self at:(aClassName asSymbol).
+ newClass notNil ifTrue:[
+ fn notNil ifTrue:[
+ newClass classFilename isNil ifTrue:[
+ newClass setClassFilename:fn
+ ].
+ ].
+
+ doInit ifTrue:[
+ newClass initialize
+ ]
+ ]
+ ].
] ensure:[
- Compiler compileLazy:wasLazy.
- wasSilent notNil ifTrue:[
- self silentLoading:wasSilent
- ]
+ Compiler compileLazy:wasLazy.
+ wasSilent notNil ifTrue:[
+ self silentLoading:wasSilent
+ ]
].
^ newClass
@@ -4288,8 +4288,8 @@
and load it. This install all of its contained classes.
Return true if ok, false if not.
Notice: the argument may not have an extension (by purpose);
- the sharedLib extension (.dll / .so / .sl) is added here, to
- make the caller independent of the underlying operatingSystem."
+ the sharedLib extension (.dll / .so / .sl) is added here, to
+ make the caller independent of the underlying operatingSystem."
|path fn|
@@ -4300,7 +4300,7 @@
path := self getBinaryFileName:fn.
path isNil ifTrue:[
- path := self getSystemFileName:fn.
+ path := self getSystemFileName:fn.
].
path isNil ifTrue:[^ false].
@@ -4319,8 +4319,8 @@
and load it. This install all of its contained classes.
Return true if ok, false if not.
Notice: the argument may not have an extension (by purpose);
- the sharedLib extension (.dll / .so / .sl) is added here, to
- make the caller independent of the underlying operatingSystem."
+ the sharedLib extension (.dll / .so / .sl) is added here, to
+ make the caller independent of the underlying operatingSystem."
|path fn|
@@ -4366,25 +4366,25 @@
lazy notNil ifTrue:[wasLazy := Compiler compileLazy:lazy].
silent notNil ifTrue:[wasSilent := self silentLoading:silent].
[
- Class updateChangeFileQuerySignal answer:logged do:[
- Class updateChangeListQuerySignal answer:logged do:[
- oldSystemPath := SystemPath copy.
- morePath notNil ifTrue:[
- SystemPath addFirst:morePath.
- oldRealPath := RealSystemPath.
- RealSystemPath := nil.
- ].
- aStream fileIn
- ]
- ]
+ Class updateChangeFileQuerySignal answer:logged do:[
+ Class updateChangeListQuerySignal answer:logged do:[
+ oldSystemPath := SystemPath copy.
+ morePath notNil ifTrue:[
+ SystemPath addFirst:morePath.
+ oldRealPath := RealSystemPath.
+ RealSystemPath := nil.
+ ].
+ aStream fileIn
+ ]
+ ]
] ensure:[
- morePath notNil ifTrue:[
- SystemPath := oldSystemPath.
- RealSystemPath := oldRealPath.
- ].
- lazy notNil ifTrue:[Compiler compileLazy:wasLazy].
- silent notNil ifTrue:[self silentLoading:wasSilent].
- aStream close
+ morePath notNil ifTrue:[
+ SystemPath := oldSystemPath.
+ RealSystemPath := oldRealPath.
+ ].
+ lazy notNil ifTrue:[Compiler compileLazy:wasLazy].
+ silent notNil ifTrue:[self silentLoading:wasSilent].
+ aStream close
].
^ true
@@ -4399,14 +4399,14 @@
"return true, if a particular class library is already loaded"
ObjectMemory
- binaryModuleInfo
- do:[:entry |
- entry type == #classLibrary ifTrue:[
- entry libraryName = name ifTrue:[
- ^ true "/ already loaded
- ]
- ].
- ].
+ binaryModuleInfo
+ do:[:entry |
+ entry type == #classLibrary ifTrue:[
+ entry libraryName = name ifTrue:[
+ ^ true "/ already loaded
+ ]
+ ].
+ ].
^ false
@@ -4461,9 +4461,9 @@
wasSilent := self silentLoading:true.
[
- self fileIn:aFilename
+ self fileIn:aFilename
] ensure:[
- self silentLoading:wasSilent
+ self silentLoading:wasSilent
]
! !
@@ -4569,12 +4569,12 @@
|fileName abbrev cls fullClassName shortClassName|
aClassOrClassName isBehavior ifTrue:[
- cls := aClassOrClassName theNonMetaclass.
- fullClassName := cls name.
- shortClassName := cls nameWithoutPrefix.
+ cls := aClassOrClassName theNonMetaclass.
+ fullClassName := cls name.
+ shortClassName := cls nameWithoutPrefix.
] ifFalse:[
- fullClassName := shortClassName := aClassOrClassName.
- shortClassName := shortClassName copyFrom:(shortClassName lastIndexOf:$:)+1.
+ fullClassName := shortClassName := aClassOrClassName.
+ shortClassName := shortClassName copyFrom:(shortClassName lastIndexOf:$:)+1.
].
fileName := fullClassName asSymbol.
@@ -4587,8 +4587,8 @@
"no abbreviation found - if its a short name, take it"
OperatingSystem maxFileNameLength < (fileName size + 3) ifTrue:[
- "this will only be triggered on sys5.3/DOS type systems"
- ('Smalltalk [info]: cant find short for ' , fileName , ' in abbreviation file') infoPrintCR.
+ "this will only be triggered on sys5.3/DOS type systems"
+ ('Smalltalk [info]: cant find short for ' , fileName , ' in abbreviation file') infoPrintCR.
].
fileName := shortClassName asSymbol.
@@ -4703,18 +4703,18 @@
packageDir := aPackageID copyReplaceAll:$: with:$/.
self packagePath do:[:aPath |
- |dir|
-
- dir := aPath asFilename construct:packageDir.
- (dir exists and:[dir isDirectory]) ifTrue:[^ dir].
+ |dir|
+
+ dir := aPath asFilename construct:packageDir.
+ (dir exists and:[dir isDirectory]) ifTrue:[^ dir].
].
"/ not found - special case for the stx package ...
(aPackageID upTo:$:) = 'stx' ifTrue:[
- packageDir := aPackageID copyFrom:(aPackageID indexOf:$:) + 1.
- packageDir := '../../' , packageDir.
- packageDir := packageDir asFilename.
- (packageDir exists and:[packageDir isDirectory]) ifTrue:[^ packageDir].
+ packageDir := aPackageID copyFrom:(aPackageID indexOf:$:) + 1.
+ packageDir := '../../' , packageDir.
+ packageDir := packageDir asFilename.
+ (packageDir exists and:[packageDir isDirectory]) ifTrue:[^ packageDir].
].
^ nil
@@ -4735,22 +4735,22 @@
"/ search along packagePath ...
f := self searchPath:self packagePath for:aFileName in:nil.
f isNil ifTrue:[
- "/ search under packages-directory along systemPath ...
- f := self searchPath:self realSystemPath for:aFileName in:PackageDirName.
- "/ kludge - allow for stx-directory to be named differently
- f isNil ifTrue:[
- (aFileName startsWith:'stx') ifTrue:[
- (aFileName startsWith:'stx' , Filename separator) ifTrue:[
- f := '../..' asFilename construct:(aFileName copyFrom:5).
- f exists ifTrue:[
- ^ f pathName
- ].
- ]
- ].
- ].
+ "/ search under packages-directory along systemPath ...
+ f := self searchPath:self realSystemPath for:aFileName in:PackageDirName.
+ "/ kludge - allow for stx-directory to be named differently
+ f isNil ifTrue:[
+ (aFileName startsWith:'stx') ifTrue:[
+ (aFileName startsWith:'stx' , Filename separator) ifTrue:[
+ f := '../..' asFilename construct:(aFileName copyFrom:5).
+ f exists ifTrue:[
+ ^ f pathName
+ ].
+ ]
+ ].
+ ].
].
(f notNil and:[(f := f asFilename) exists]) ifTrue:[
- ^ f pathName
+ ^ f pathName
].
^ nil
@@ -4816,34 +4816,34 @@
f notNil ifTrue:[^ f].
aPackageIDOrNil notNil ifTrue:[
- packageDir := aPackageIDOrNil copyReplaceAll:$: with:$/.
- self packagePath do:[:aPath |
- |pD|
-
- pD := aPath asFilename construct:packageDir.
- pD exists ifTrue:[
- f := pD construct:aFileName.
- f exists ifTrue:[
- ^ f pathName
- ].
- f := (pD construct:'resources') construct:aFileName.
- f exists ifTrue:[
- ^ f pathName
- ].
- ].
- ].
-
- dir := Smalltalk getPackageDirectoryForPackage:(aPackageIDOrNil ? 'stx:libview').
- dir notNil ifTrue:[
- f := (dir asFilename construct:'resources') construct:aFileName.
- f exists ifTrue:[
- ^ f pathName
- ].
- f := (dir asFilename construct:'styles') construct:aFileName.
- f exists ifTrue:[
- ^ f pathName
- ].
- ].
+ packageDir := aPackageIDOrNil copyReplaceAll:$: with:$/.
+ self packagePath do:[:aPath |
+ |pD|
+
+ pD := aPath asFilename construct:packageDir.
+ pD exists ifTrue:[
+ f := pD construct:aFileName.
+ f exists ifTrue:[
+ ^ f pathName
+ ].
+ f := (pD construct:'resources') construct:aFileName.
+ f exists ifTrue:[
+ ^ f pathName
+ ].
+ ].
+ ].
+
+ dir := Smalltalk getPackageDirectoryForPackage:(aPackageIDOrNil ? 'stx:libview').
+ dir notNil ifTrue:[
+ f := (dir asFilename construct:'resources') construct:aFileName.
+ f exists ifTrue:[
+ ^ f pathName
+ ].
+ f := (dir asFilename construct:'styles') construct:aFileName.
+ f exists ifTrue:[
+ ^ f pathName
+ ].
+ ].
].
^ nil
@@ -4941,23 +4941,23 @@
package := aClass package.
img := self imageFromFileNamed:aFileName inPackage:package.
img isNil ifTrue:[
- package ~= 'stx:goodies' ifTrue:[
- "/ try under the goodies package ...
- img := Smalltalk imageFromFileNamed:aFileName inPackage:'stx:goodies'.
- ].
- img isNil ifTrue:[
- (aFileName startsWith:'bitmaps') ifFalse:[
- nm := 'bitmaps/' , aFileName.
- img := Smalltalk imageFromFileNamed:nm forClass:self.
- img isNil ifTrue:[
- img := Smalltalk imageFromFileNamed:nm inPackage:'stx:goodies'.
- ]
- ].
-
- img isNil ifTrue:[
- img := Smalltalk imageFromFileNamed:aFileName inPackage:'stx:goodies'.
- ].
- ]
+ package ~= 'stx:goodies' ifTrue:[
+ "/ try under the goodies package ...
+ img := Smalltalk imageFromFileNamed:aFileName inPackage:'stx:goodies'.
+ ].
+ img isNil ifTrue:[
+ (aFileName startsWith:'bitmaps') ifFalse:[
+ nm := 'bitmaps/' , aFileName.
+ img := Smalltalk imageFromFileNamed:nm forClass:self.
+ img isNil ifTrue:[
+ img := Smalltalk imageFromFileNamed:nm inPackage:'stx:goodies'.
+ ]
+ ].
+
+ img isNil ifTrue:[
+ img := Smalltalk imageFromFileNamed:aFileName inPackage:'stx:goodies'.
+ ].
+ ]
].
^ img
@@ -4979,17 +4979,17 @@
f := self getBitmapFileName:aFileName.
f notNil ifTrue:[
- i := Image fromFile:f.
- i notNil ifTrue:[^ i].
+ i := Image fromFile:f.
+ i notNil ifTrue:[^ i].
].
dir := self projectDirectoryForPackage:aPackage.
dir isNil ifTrue:[^ nil].
((f := aFileName) startsWith:'bitmaps/') ifFalse:[
- i := Image fromFile:(dir asFilename construct:f).
- i notNil ifTrue:[^ i].
+ i := Image fromFile:(dir asFilename construct:f).
+ i notNil ifTrue:[^ i].
- f := 'bitmaps/' , aFileName.
+ f := 'bitmaps/' , aFileName.
].
^ Image fromFile:(dir asFilename construct:f).
@@ -5115,10 +5115,10 @@
"/ in the directory, from which the project was loaded
prj := Project projectWithId:aPackage.
prj notNil ifTrue:[
- prjDir := prj directory.
+ prjDir := prj directory.
].
(prjDir notNil and:[prjDir asFilename exists]) ifFalse:[
- prjDir := Smalltalk getPackageFileName:(aPackage copyReplaceAll:$: with:$/).
+ prjDir := Smalltalk getPackageFileName:(aPackage copyReplaceAll:$: with:$/).
].
^ prjDir
@@ -5372,26 +5372,26 @@
((f := aFileName asFilename) isAbsolute
or:[f isExplicitRelative]) ifTrue:[
- "/
- "/ dont use path for absolute or explicit .-relative file names
- "/
- ^ aFileName
+ "/
+ "/ dont use path for absolute or explicit .-relative file names
+ "/
+ ^ aFileName
].
aPath notNil ifTrue:[
- aPath do:[:dirName |
- |realName dir|
-
- dir := dirName asFilename.
- aDirName notNil ifTrue:[
- realName := (dir construct:aDirName) construct:aFileName.
- ] ifFalse:[
- realName := dir construct:aFileName.
- ].
- (realName isReadable) ifTrue:[
- ^ realName name
- ]
- ].
+ aPath do:[:dirName |
+ |realName dir|
+
+ dir := dirName asFilename.
+ aDirName notNil ifTrue:[
+ realName := (dir construct:aDirName) construct:aFileName.
+ ] ifFalse:[
+ realName := dir construct:aFileName.
+ ].
+ (realName isReadable) ifTrue:[
+ ^ realName name
+ ]
+ ].
].
^ nil.
@@ -5595,10 +5595,10 @@
|p t new|
(self fileIn:aFilename) ifFalse:[
- (self fileInClassLibrary:aFilename) ifFalse:[
- self warn:'Failed to load the package ', packageId printString.
- ^ false.
- ]
+ (self fileInClassLibrary:aFilename) ifFalse:[
+ self warn:'Failed to load the package ', packageId printString.
+ ^ false.
+ ]
].
new := (p := Project projectWithId:packageId) isNil.
@@ -5694,9 +5694,9 @@
"
Smalltalk loadPackage:'exept:osi/asn1'
Smalltalk
- loadPackage:'exept:osi/asn1'
- fromProjectFile:'../../../exept/osi/asn1/asn1.prj'
- asAutoloaded:false
+ loadPackage:'exept:osi/asn1'
+ fromProjectFile:'../../../exept/osi/asn1/asn1.prj'
+ asAutoloaded:false
"
!
@@ -5732,11 +5732,11 @@
pkg := Project projectWithId:aPackageId.
(pkg notNil and:[pkg isLoaded]) ifTrue:[
- "/ ('Smalltalk [info]: Package ' , aPackageId , ' already loaded.') infoPrintCR.
- (doLoadAsAutoloaded
- or:[pkg areAllClassesLoaded]) ifTrue:[
- ^ true
- ].
+ "/ ('Smalltalk [info]: Package ' , aPackageId , ' already loaded.') infoPrintCR.
+ (doLoadAsAutoloaded
+ or:[pkg areAllClassesLoaded]) ifTrue:[
+ ^ true
+ ].
].
"/ ok; not yet loaded.
@@ -5749,22 +5749,22 @@
packageDir := self getPackageFileName:packageDirName.
packageDir isNil ifTrue:[
- "/ for convenience: try ../../.. as well
- "/ (when executing in thedevelopment environment)
- packageDir := '../../..' asFilename construct:packageDirName.
- packageDir exists ifTrue:[
- packageDir := packageDir pathName
- ] ifFalse:[
- ('Smalltalk [warning]: cannot find packageDirectory: ' , packageDirName) errorPrintCR.
- ^ false
- ]
+ "/ for convenience: try ../../.. as well
+ "/ (when executing in thedevelopment environment)
+ packageDir := '../../..' asFilename construct:packageDirName.
+ packageDir exists ifTrue:[
+ packageDir := packageDir pathName
+ ] ifFalse:[
+ ('Smalltalk [warning]: cannot find packageDirectory: ' , packageDirName) errorPrintCR.
+ ^ false
+ ]
].
^ self
- loadPackageWithId:aPackageId
- name:packageBaseName
- fromDirectory:packageDir
- asAutoloaded:doLoadAsAutoloaded
+ loadPackageWithId:aPackageId
+ name:packageBaseName
+ fromDirectory:packageDir
+ asAutoloaded:doLoadAsAutoloaded
@@ -5783,32 +5783,32 @@
"/ .prj ?
f := (packageDir construct:packageName) withSuffix:'prj'.
f exists ifTrue:[
- (self loadPackage:aPackageId fromProjectFile:f asAutoloaded:doLoadAsAutoloaded) ifTrue:[
- SilentLoading ifFalse:[
- Transcript showCR:('Smalltalk [info]: loaded package: ' , aPackageId , ' from project file: ' , f pathName).
- ].
- ^ true
- ]
+ (self loadPackage:aPackageId fromProjectFile:f asAutoloaded:doLoadAsAutoloaded) ifTrue:[
+ SilentLoading ifFalse:[
+ Transcript showCR:('Smalltalk [info]: loaded package: ' , aPackageId , ' from project file: ' , f pathName).
+ ].
+ ^ true
+ ]
].
"/ loadAll ?
f := packageDir construct:'loadAll'.
f exists ifTrue:[
- (self loadPackage:aPackageId fromLoadAllFile:f) ifTrue:[
- SilentLoading ifFalse:[
- Transcript showCR:('loaded package: ' , aPackageId , ' from loadAll file: ' , f pathName).
- ].
- ^ true
- ]
+ (self loadPackage:aPackageId fromLoadAllFile:f) ifTrue:[
+ SilentLoading ifFalse:[
+ Transcript showCR:('loaded package: ' , aPackageId , ' from loadAll file: ' , f pathName).
+ ].
+ ^ true
+ ]
].
"/ .zip ?
f := (packageDir construct:packageName) withSuffix:'zip'.
f exists ifTrue:[
- (self loadPackage:aPackageId fromZIPArchive:f asAutoloaded:doLoadAsAutoloaded) ifTrue:[
- SilentLoading ifFalse:[
- Transcript showCR:('loaded package: ' , aPackageId , ' from zip file: ' , f pathName).
- ].
- ^ true
- ]
+ (self loadPackage:aPackageId fromZIPArchive:f asAutoloaded:doLoadAsAutoloaded) ifTrue:[
+ SilentLoading ifFalse:[
+ Transcript showCR:('loaded package: ' , aPackageId , ' from zip file: ' , f pathName).
+ ].
+ ^ true
+ ]
].
shLibName := packageName , ObjectFileLoader sharedLibraryExtension.
@@ -5816,79 +5816,79 @@
"/ .so ?
f := packageDir construct:shLibName.
f exists ifTrue:[
- (self loadPackage:aPackageId fromClassLibrary:f) ifTrue:[
- SilentLoading ifFalse:[
- Transcript showCR:('loaded package: ' , aPackageId , ' from binary classLib file: ' , f pathName).
- ].
- ^ true
- ]
+ (self loadPackage:aPackageId fromClassLibrary:f) ifTrue:[
+ SilentLoading ifFalse:[
+ Transcript showCR:('loaded package: ' , aPackageId , ' from binary classLib file: ' , f pathName).
+ ].
+ ^ true
+ ]
].
"/ abbrev.stc ?
f := packageDir construct:'abbrev.stc'.
f exists ifTrue:[
- Smalltalk installAutoloadedClassesFrom:f pathName.
-
- doLoadAsAutoloaded ifFalse:[
- "/ force autoloading...
- s := f readStream.
- s contents do:[:eachLine |
- |s className cls|
-
- s := eachLine readStream.
- s skipSpaces.
- className := s upTo:Character space.
- cls := Smalltalk classNamed:className.
- cls autoload
- ].
- s close.
- ].
- SilentLoading ifFalse:[
- Transcript showCR:('loaded package: ' , aPackageId , ' from abbrev file: ' , f pathName).
- ].
- ^ true
+ Smalltalk installAutoloadedClassesFrom:f pathName.
+
+ doLoadAsAutoloaded ifFalse:[
+ "/ force autoloading...
+ s := f readStream.
+ s contents do:[:eachLine |
+ |s className cls|
+
+ s := eachLine readStream.
+ s skipSpaces.
+ className := s upTo:Character space.
+ cls := Smalltalk classNamed:className.
+ cls autoload
+ ].
+ s close.
+ ].
+ SilentLoading ifFalse:[
+ Transcript showCR:('loaded package: ' , aPackageId , ' from abbrev file: ' , f pathName).
+ ].
+ ^ true
].
"/ lib/loadAll ? (will vanish)
f := (packageDir construct:'lib') construct:'loadAll'.
f exists ifTrue:[
- (self loadPackage:aPackageId fromLoadAllFile:f) ifTrue:[
- SilentLoading ifFalse:[
- Transcript showCR:('loaded package: ' , aPackageId , ' from loadAll file: ' , f pathName).
- ].
- ^ true
- ]
+ (self loadPackage:aPackageId fromLoadAllFile:f) ifTrue:[
+ SilentLoading ifFalse:[
+ Transcript showCR:('loaded package: ' , aPackageId , ' from loadAll file: ' , f pathName).
+ ].
+ ^ true
+ ]
].
"/ /lib/.so ? (will vanish)
f := (packageDir construct:'lib') construct:shLibName.
f exists ifTrue:[
- (self loadPackage:aPackageId fromClassLibrary:f) ifTrue:[
- SilentLoading ifFalse:[
- Transcript showCR:('loaded package: ' , aPackageId , ' from binary classLib file: ' , f pathName).
- ].
- ^ true
- ]
+ (self loadPackage:aPackageId fromClassLibrary:f) ifTrue:[
+ SilentLoading ifFalse:[
+ Transcript showCR:('loaded package: ' , aPackageId , ' from binary classLib file: ' , f pathName).
+ ].
+ ^ true
+ ]
].
"/ any .so ? -> load the first one found (maybe not a good idea)
packageDir directoryContentsAsFilenamesDo:[:aFilename |
- (aFilename hasSuffix:ObjectFileLoader sharedLibrarySuffix) ifTrue:[
- (self loadPackage:aPackageId fromClassLibrary:aFilename) ifTrue:[
- SilentLoading ifFalse:[
- Transcript showCR:('loaded package: ' , aPackageId , ' from binary classLib file: ' , aFilename pathName).
- ].
- ^ true
- ]
- ]
+ (aFilename hasSuffix:ObjectFileLoader sharedLibrarySuffix) ifTrue:[
+ (self loadPackage:aPackageId fromClassLibrary:aFilename) ifTrue:[
+ SilentLoading ifFalse:[
+ Transcript showCR:('loaded package: ' , aPackageId , ' from binary classLib file: ' , aFilename pathName).
+ ].
+ ^ true
+ ]
+ ]
].
"/ source files
(self loadPackage:aPackageId fromAllSourceFilesInDirectory:packageDir) ifTrue:[
- SilentLoading ifFalse:[
- Transcript showCR:('loaded package: ' , aPackageId , ' from source files in:' , packageDir pathName).
- ].
- ^ true
+ SilentLoading ifFalse:[
+ Transcript showCR:('loaded package: ' , aPackageId , ' from source files in:' , packageDir pathName).
+ ].
+ ^ true
].
^ false
@@ -5905,7 +5905,7 @@
"remove all undeclared variables"
(Smalltalk at:#Undeclared) do:[:eachKey |
- Smalltalk removeKey:(self undeclaredPrefix , eachKey) asSymbol.
+ Smalltalk removeKey:(self undeclaredPrefix , eachKey) asSymbol.
].
(Smalltalk at:#Undeclared) removeAll.
Smalltalk removeKey:#Undeclared.
@@ -6045,28 +6045,28 @@
lang := Language.
(lang == #de) ifTrue:[
- proto := 'Willkommen bei %1 (Version %2 vom %3)'
+ proto := 'Willkommen bei %1 (Version %2 vom %3)'
] ifFalse:[ (lang == #fr) ifTrue:[
- proto := 'Salut, Bienvenue à %1 (version %2 de %3)'
+ proto := 'Salut, Bienvenue à %1 (version %2 de %3)'
] ifFalse:[ (lang == #it) ifTrue:[
- proto := 'Ciao, benvenuto al %1 (versione %2 di %3)'
+ proto := 'Ciao, benvenuto al %1 (versione %2 di %3)'
] ifFalse:[ (lang == #es) ifTrue:[
"/ proto := 'Hola, bienvenida a %1 (versión %2 de %3)'
] ifFalse:[ (lang == #es) ifTrue:[
"/ proto := 'Oi, benvindo a %1 (versão %2 de %3)'
] ifFalse:[ (lang == #no) ifTrue:[
- proto := 'Hei, verdenmottakelse til %1 (versjon %2 av %3)'
+ proto := 'Hei, verdenmottakelse til %1 (versjon %2 av %3)'
]]]]]].
"/ ... more needed here ...
proto isNil ifTrue:[
- proto := 'Hello World - here is %1 version %2 of %3'.
+ proto := 'Hello World - here is %1 version %2 of %3'.
].
^ proto bindWith:('SmallTalk/X' allBold)
- with:(self versionString)
- with:(self versionDate)
+ with:(self versionString)
+ with:(self versionDate)
"
Smalltalk language:#us.
@@ -6212,7 +6212,7 @@
to the outside world.
ST/X revision Naming is:
- <major>.<minor>.<revision>.<release>"
+ <major>.<minor>.<revision>.<release>"
^ 5
@@ -6302,5 +6302,5 @@
!Smalltalk class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.544 2002-11-08 18:45:06 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.545 2002-11-11 09:29:09 cg Exp $'
! !