Smalltalk.st
author Claus Gittinger <cg@exept.de>
Sat, 28 Oct 1995 17:45:10 +0100
changeset 453 57381f377c3f
parent 452 e8bcdf3bedaf
child 456 411202bbbfbb
permissions -rw-r--r--
fix logged-arg (was nil)
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
     1
"
5
67342904af11 *** empty log message ***
claus
parents: 3
diff changeset
     2
 COPYRIGHT (c) 1988 by Claus Gittinger
159
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
     3
	      All Rights Reserved
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
     4
a27a279701f8 Initial revision
claus
parents:
diff changeset
     5
 This software is furnished under a license and may be used
a27a279701f8 Initial revision
claus
parents:
diff changeset
     6
 only in accordance with the terms of that license and with the
a27a279701f8 Initial revision
claus
parents:
diff changeset
     7
 inclusion of the above copyright notice.   This software may not
a27a279701f8 Initial revision
claus
parents:
diff changeset
     8
 be provided or otherwise made available to, or used by, any
a27a279701f8 Initial revision
claus
parents:
diff changeset
     9
 other person.  No title to or ownership of the software is
a27a279701f8 Initial revision
claus
parents:
diff changeset
    10
 hereby transferred.
a27a279701f8 Initial revision
claus
parents:
diff changeset
    11
"
a27a279701f8 Initial revision
claus
parents:
diff changeset
    12
453
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
    13
'From Smalltalk/X, Version:2.10.7 on 28-oct-1995 at 17:10:25'                   !
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
    14
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    15
Object subclass:#Smalltalk
453
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
    16
	 instanceVariableNames:''
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
    17
	 classVariableNames:'ExitBlocks CachedClasses SystemPath StartupClass StartupSelector
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
    18
                StartupArguments CachedAbbreviations SilentLoading Initializing
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
    19
                StandAlone LogDoits LoadBinaries RealSystemPath ResourcePath
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
    20
                SourcePath BitmapPath BinaryPath FileInPath'
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
    21
	 poolDictionaries:''
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
    22
	 category:'System-Support'
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    23
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
    24
a27a279701f8 Initial revision
claus
parents:
diff changeset
    25
Smalltalk comment:'
5
67342904af11 *** empty log message ***
claus
parents: 3
diff changeset
    26
COPYRIGHT (c) 1988 by Claus Gittinger
159
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
    27
	     All Rights Reserved
95
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
    28
453
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
    29
$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.69 1995-10-28 16:45:10 cg Exp $
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    30
'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
    31
70
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
    32
!Smalltalk class methodsFor:'documentation'!
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
    33
95
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
    34
version
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
    35
"
453
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
    36
$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.69 1995-10-28 16:45:10 cg Exp $
95
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
    37
"
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
    38
!
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
    39
70
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
    40
documentation
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
    41
"
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
    42
    This is one of the central classes in the system;
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
    43
    it provides all system-startup, shutdown and maintenance support.
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
    44
    Also global variables are kept here.
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
    45
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
    46
    As you will notice, this is NOT a Dictionary
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
    47
     - my implementation of globals is totally different
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
    48
       (due to the need to be able to access globals from c-code as well).
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
    49
    However, it provides the known enumeration protocol.
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
    50
    It may change to become a subclass of collection at some time ...
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
    51
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
    52
    Instance variables:
159
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
    53
					none - all handling is done in the VM
70
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
    54
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
    55
    Class variables:
159
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
    56
	ExitBlocks      <Collection>    blocks to evaluate before system is
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
    57
					left. Not currently used.
70
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
    58
159
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
    59
	CachedClasses   <Collection>    known classes (cached for faster enumeration)
70
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
    60
159
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
    61
	SystemPath      <Collection>    path to search for system files (sources, bitmaps etc)
70
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
    62
159
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
    63
	StartupClass    <Class>         class, which gets initial message 
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
    64
					(right after VM initialization)
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
    65
	StartupSelector <Symbol>        message sent to StartupClass
70
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
    66
159
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
    67
	CachedAbbreviations
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
    68
			<Dictionary>    className to filename mappings
70
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
    69
159
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
    70
	SilentLoading   <Boolean>       suppresses messages during fileIn and in compiler
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
    71
					(can be set to true from a customized main)
122
1680ab5285c4 allow logging of doits;
claus
parents: 95
diff changeset
    72
159
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
    73
	LogDoits        <Boolean>       if true, doits are also logged in the changes
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
    74
					file. Default is false, since the changes file
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
    75
					may become huge ...
329
claus
parents: 326
diff changeset
    76
400
claus
parents: 396
diff changeset
    77
	LoadBinaries    <Boolean>       if true, we attempt to load classes rom a binary
390
claus
parents: 384
diff changeset
    78
					file, if present. If false, this is always suppressed.
claus
parents: 384
diff changeset
    79
329
claus
parents: 326
diff changeset
    80
	SourcePath      <Collection>    cached names of really existing directories
claus
parents: 326
diff changeset
    81
	BitmapPath                      These are remembered, since in NFS systems,
claus
parents: 326
diff changeset
    82
	ResourcePath                    the time to lookup files may become long
claus
parents: 326
diff changeset
    83
	BinaryPath                      (especially, if some directories are on machines
claus
parents: 326
diff changeset
    84
	FileInPath                      which are not up ...). Therefore, the set of really
claus
parents: 326
diff changeset
    85
					existing directories is cached when the SystemPath
claus
parents: 326
diff changeset
    86
					is walked the first time.
70
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
    87
"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    88
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
    89
453
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
    90
copyright
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
    91
"
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
    92
 COPYRIGHT (c) 1988 by Claus Gittinger
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
    93
	      All Rights Reserved
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
    94
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
    95
 This software is furnished under a license and may be used
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
    96
 only in accordance with the terms of that license and with the
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
    97
 inclusion of the above copyright notice.   This software may not
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
    98
 be provided or otherwise made available to, or used by, any
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
    99
 other person.  No title to or ownership of the software is
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   100
 hereby transferred.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   101
"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   102
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
   103
a27a279701f8 Initial revision
claus
parents:
diff changeset
   104
!Smalltalk class methodsFor:'initialization'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   105
325
claus
parents: 324
diff changeset
   106
initializeSystem
24
20cfbafcd0a3 *** empty log message ***
claus
parents: 13
diff changeset
   107
    "initialize all other classes; setup dispatcher processes etc.
211
58bb873aa83c *** empty log message ***
claus
parents: 202
diff changeset
   108
     This one is the first entry into the smalltalk world right after startup,
58bb873aa83c *** empty log message ***
claus
parents: 202
diff changeset
   109
     ususally followed by Smalltalk>>start.
58bb873aa83c *** empty log message ***
claus
parents: 202
diff changeset
   110
     Notice: this is not called when an image is restarted; in this
58bb873aa83c *** empty log message ***
claus
parents: 202
diff changeset
   111
     case the show starts in Smalltalk>>restart."
58bb873aa83c *** empty log message ***
claus
parents: 202
diff changeset
   112
348
claus
parents: 345
diff changeset
   113
    SilentLoading := false.
claus
parents: 345
diff changeset
   114
    Initializing := true.
claus
parents: 345
diff changeset
   115
211
58bb873aa83c *** empty log message ***
claus
parents: 202
diff changeset
   116
    "
58bb873aa83c *** empty log message ***
claus
parents: 202
diff changeset
   117
     define low-level debugging tools - graphical classes are not prepared yet
58bb873aa83c *** empty log message ***
claus
parents: 202
diff changeset
   118
     to handle things. 
58bb873aa83c *** empty log message ***
claus
parents: 202
diff changeset
   119
     This will bring us into the MiniDebugger when an error occurs
58bb873aa83c *** empty log message ***
claus
parents: 202
diff changeset
   120
     during startup
58bb873aa83c *** empty log message ***
claus
parents: 202
diff changeset
   121
    "
58bb873aa83c *** empty log message ***
claus
parents: 202
diff changeset
   122
    Inspector := MiniInspector.
58bb873aa83c *** empty log message ***
claus
parents: 202
diff changeset
   123
    Debugger := MiniDebugger.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   124
a27a279701f8 Initial revision
claus
parents:
diff changeset
   125
    self initGlobalsFromEnvironment.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   126
70
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
   127
    "
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
   128
     sorry - there are some, which MUST be initialized before ..
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
   129
     reason: if any error happens during init, we need Signals, Stdout etc. to be there
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
   130
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   131
    Object initialize.
423
claus
parents: 421
diff changeset
   132
    Signal initialize.
326
d2902942491d *** empty log message ***
claus
parents: 325
diff changeset
   133
    ObjectMemory initialize.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   134
    ExternalStream initialize.
211
58bb873aa83c *** empty log message ***
claus
parents: 202
diff changeset
   135
58bb873aa83c *** empty log message ***
claus
parents: 202
diff changeset
   136
    self initStandardStreams.    "/ setup Stdin, Stdout etc.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   137
70
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
   138
    "
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
   139
     sorry, path must be set before ...
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
   140
     reason: some classes need it during initialize (they might need resources, bitmaps etc)
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
   141
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   142
    self initSystemPath.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   143
70
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
   144
    "
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
   145
     must init display here - some classes (Color, Form) need it during initialize
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
   146
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   147
    Workstation notNil ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
   148
	Workstation initialize
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   149
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   150
a27a279701f8 Initial revision
claus
parents:
diff changeset
   151
    Compiler := ByteCodeCompiler.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   152
    Compiler isNil ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
   153
	"
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
   154
	 ByteCodeCompiler is not in the system (i.e. has not been linked in)
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
   155
	 this allows at least immediate evaluations for runtime systems without compiler
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
   156
	 NOTICE: a parser is always needed, otherwise we cannot read resource files etc.
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
   157
	"
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
   158
	Compiler := Parser
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   159
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   160
70
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
   161
    "
325
claus
parents: 324
diff changeset
   162
     now, finally, initialize all other classes
70
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
   163
    "
325
claus
parents: 324
diff changeset
   164
    self initializeModules.
claus
parents: 324
diff changeset
   165
claus
parents: 324
diff changeset
   166
"/    self allBehaviorsDo:[:aClass |
159
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
   167
"/ 'init ' print. aClass name printNL.
329
claus
parents: 326
diff changeset
   168
"/      aClass initialize
325
claus
parents: 324
diff changeset
   169
"/    ].
159
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
   170
321
5472c14f6ef5 *** empty log message ***
claus
parents: 314
diff changeset
   171
    Display notNil ifTrue:[
329
claus
parents: 326
diff changeset
   172
	Display initialize.
321
5472c14f6ef5 *** empty log message ***
claus
parents: 314
diff changeset
   173
    ].
70
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
   174
    self initInterrupts.
325
claus
parents: 324
diff changeset
   175
    self initUserPreferences.    
claus
parents: 324
diff changeset
   176
!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   177
325
claus
parents: 324
diff changeset
   178
initializeModules
claus
parents: 324
diff changeset
   179
    "perform module specific initialization and
claus
parents: 324
diff changeset
   180
     send #initialize to all classes.
claus
parents: 324
diff changeset
   181
     Notice: this is not called when an image is restarted"
claus
parents: 324
diff changeset
   182
%{
claus
parents: 324
diff changeset
   183
    init_registered_modules(3 COMMA_CON);
claus
parents: 324
diff changeset
   184
%}
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   185
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   186
122
1680ab5285c4 allow logging of doits;
claus
parents: 95
diff changeset
   187
initUserPreferences
1680ab5285c4 allow logging of doits;
claus
parents: 95
diff changeset
   188
    "setup other stuff"
1680ab5285c4 allow logging of doits;
claus
parents: 95
diff changeset
   189
390
claus
parents: 384
diff changeset
   190
    LogDoits := false.
claus
parents: 384
diff changeset
   191
    LoadBinaries := false.
122
1680ab5285c4 allow logging of doits;
claus
parents: 95
diff changeset
   192
!
1680ab5285c4 allow logging of doits;
claus
parents: 95
diff changeset
   193
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   194
initGlobalsFromEnvironment
a27a279701f8 Initial revision
claus
parents:
diff changeset
   195
    "setup globals from the shell-environment"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   196
211
58bb873aa83c *** empty log message ***
claus
parents: 202
diff changeset
   197
    |envString i langString terrString|
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   198
70
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
   199
    "
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
   200
     extract Language and LanguageTerritory from LANG variable.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   201
     the language and territory must not be abbreviated,
211
58bb873aa83c *** empty log message ***
claus
parents: 202
diff changeset
   202
     valid are for example: english_usa
58bb873aa83c *** empty log message ***
claus
parents: 202
diff changeset
   203
			    english
58bb873aa83c *** empty log message ***
claus
parents: 202
diff changeset
   204
			    german
58bb873aa83c *** empty log message ***
claus
parents: 202
diff changeset
   205
			    german_austria
70
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
   206
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   207
211
58bb873aa83c *** empty log message ***
claus
parents: 202
diff changeset
   208
    Language := #english.
58bb873aa83c *** empty log message ***
claus
parents: 202
diff changeset
   209
    LanguageTerritory := #usa.
58bb873aa83c *** empty log message ***
claus
parents: 202
diff changeset
   210
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   211
    envString := OperatingSystem getEnvironment:'LANG'.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   212
    envString notNil ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
   213
	i := envString indexOf:$_.
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
   214
	(i == 0) ifTrue:[
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
   215
	    langString := envString.
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
   216
	    terrString := envString
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
   217
	] ifFalse:[
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
   218
	    langString := envString copyTo:(i - 1).
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
   219
	    terrString := envString copyFrom:(i + 1)
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
   220
	].
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
   221
	Language := langString asSymbol.
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
   222
	LanguageTerritory := terrString asSymbol
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   223
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   224
70
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
   225
    "
211
58bb873aa83c *** empty log message ***
claus
parents: 202
diff changeset
   226
     Smalltalk initGlobalsFromEnvironment
70
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
   227
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   228
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   229
a27a279701f8 Initial revision
claus
parents:
diff changeset
   230
initStandardTools
95
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   231
    "predefine some tools which we will need later
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   232
     - if the view-classes exist,
a27a279701f8 Initial revision
claus
parents:
diff changeset
   233
       they will redefine Inspector and Debugger for graphical interfaces"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   234
a27a279701f8 Initial revision
claus
parents:
diff changeset
   235
    "redefine debug-tools, if view-classes exist"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   236
95
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   237
    Display notNil ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
   238
	InspectorView notNil ifTrue:[
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
   239
	    Inspector := InspectorView
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
   240
	].
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
   241
	DebugView notNil ifTrue:[
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
   242
	    Debugger := DebugView
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
   243
	].
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
   244
	Display initialize
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   245
    ]
a27a279701f8 Initial revision
claus
parents:
diff changeset
   246
    "Smalltalk initStandardTools"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   247
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   248
a27a279701f8 Initial revision
claus
parents:
diff changeset
   249
initStandardStreams
a27a279701f8 Initial revision
claus
parents:
diff changeset
   250
    "initialize some well-known streams"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   251
a27a279701f8 Initial revision
claus
parents:
diff changeset
   252
    Stdout := NonPositionableExternalStream forStdout.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   253
    Stderr := NonPositionableExternalStream forStderr.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   254
    Stdin := NonPositionableExternalStream forStdin.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   255
    Printer := PrinterStream.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   256
    Transcript := Stderr
a27a279701f8 Initial revision
claus
parents:
diff changeset
   257
a27a279701f8 Initial revision
claus
parents:
diff changeset
   258
    "Smalltalk initStandardStreams"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   259
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   260
a27a279701f8 Initial revision
claus
parents:
diff changeset
   261
initInterrupts
a27a279701f8 Initial revision
claus
parents:
diff changeset
   262
    "initialize interrupts"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   263
a27a279701f8 Initial revision
claus
parents:
diff changeset
   264
    OperatingSystem enableUserInterrupts.
77
6c38ca59927f *** empty log message ***
claus
parents: 70
diff changeset
   265
    OperatingSystem enableHardSignalInterrupts.
2
claus
parents: 1
diff changeset
   266
    OperatingSystem enableFpExceptionInterrupts.
claus
parents: 1
diff changeset
   267
claus
parents: 1
diff changeset
   268
    ObjectMemory userInterruptHandler:self.
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   269
    ObjectMemory signalInterruptHandler:self.
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   270
    ObjectMemory recursionInterruptHandler:self.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   271
a27a279701f8 Initial revision
claus
parents:
diff changeset
   272
    "Smalltalk initInterrupts"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   273
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   274
a27a279701f8 Initial revision
claus
parents:
diff changeset
   275
initSystemPath
70
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
   276
    "setup path where system files are searched for.
7
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   277
     the default path is set to:
159
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
   278
	    .
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
   279
	    ..
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
   280
	    $HOME                    (if defined)
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
   281
	    $HOME/.smalltalk         (if defined & existing)
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
   282
	    $SMALLTALK_LIBDIR        (if defined & existing)
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
   283
	    /usr/local/lib/smalltalk (if existing)
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
   284
	    /usr/lib/smalltalk       (if existing)
70
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
   285
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
   286
     of course, it is possible to add entries from the 'smalltalk.rc'
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
   287
     startup file; add expressions such as:
159
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
   288
	    Smalltalk systemPath addFirst:'/foo/bar/baz'.
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
   289
	or: 
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
   290
	    Smalltalk systemPath addLast:'/fee/foe/foo'.
7
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   291
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   292
70
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
   293
    |p homePath|
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
   294
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
   295
    homePath := OperatingSystem getHomeDirectory.
443
Claus Gittinger <cg@exept.de>
parents: 423
diff changeset
   296
    homePath isNil ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 423
diff changeset
   297
	homePath := '.'
Claus Gittinger <cg@exept.de>
parents: 423
diff changeset
   298
    ].
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   299
70
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
   300
    "
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
   301
     the path is set to search files first locally
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
   302
     - this allows private stuff to override global stuff
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
   303
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   304
    SystemPath := OrderedCollection new.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   305
    SystemPath add:'.'.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   306
    SystemPath add:'..'.
70
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
   307
    SystemPath add:homePath.
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
   308
    (OperatingSystem isDirectory:(p := homePath , '/.smalltalk')) ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
   309
	SystemPath add:p
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   310
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   311
    p := OperatingSystem getEnvironment:'SMALLTALK_LIBDIR'.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   312
    p notNil ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
   313
	SystemPath add:p
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   314
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   315
    (OperatingSystem isDirectory:'/usr/local/lib/smalltalk') ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
   316
	SystemPath add:'/usr/local/lib/smalltalk'
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   317
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   318
    (OperatingSystem isDirectory:'/usr/lib/smalltalk') ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
   319
	SystemPath add:'/usr/lib/smalltalk'
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   320
    ].
329
claus
parents: 326
diff changeset
   321
    self flushPathCaches
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   322
95
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   323
    "
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   324
     Smalltalk initSystemPath
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   325
     Smalltalk systemPath
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   326
    "
162
79c831f473a9 neue minor release nr.
claus
parents: 161
diff changeset
   327
!
79c831f473a9 neue minor release nr.
claus
parents: 161
diff changeset
   328
79c831f473a9 neue minor release nr.
claus
parents: 161
diff changeset
   329
isInitialized
79c831f473a9 neue minor release nr.
claus
parents: 161
diff changeset
   330
    "this returns true, if the system is properly initialized;
79c831f473a9 neue minor release nr.
claus
parents: 161
diff changeset
   331
     i.e. false during startup. Especially, the whole viewing stuff is
79c831f473a9 neue minor release nr.
claus
parents: 161
diff changeset
   332
     not working correctly until initialized."
79c831f473a9 neue minor release nr.
claus
parents: 161
diff changeset
   333
79c831f473a9 neue minor release nr.
claus
parents: 161
diff changeset
   334
    ^ Initializing not
161
ed36169f354d *** empty log message ***
claus
parents: 159
diff changeset
   335
! !
ed36169f354d *** empty log message ***
claus
parents: 159
diff changeset
   336
453
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   337
!Smalltalk class methodsFor:'accessing'!
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   338
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   339
at:aKey
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   340
    "retrieve the value stored under aKey, a symbol. 
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   341
     Return nil if not present (this will be changed to trigger an error)"
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   342
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   343
%{  /* NOCONTEXT */
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   344
    extern OBJ __GLOBAL_GET();
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   345
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   346
    RETURN ( __GLOBAL_GET(aKey) );
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   347
%}
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   348
!
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   349
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   350
at:aKey ifAbsent:aBlock
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   351
    "retrieve the value stored at aKey.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   352
     If there is nothing stored under this key, return the value of
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   353
     the evaluation of aBlock."
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   354
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   355
    (self includesKey:aKey) ifTrue:[
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   356
	^ self at:aKey
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   357
    ].
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   358
    ^ aBlock value
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   359
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   360
    "
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   361
     Smalltalk at:#fooBar                       <- returns nil
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   362
     Smalltalk at:#fooBar ifAbsent:['sorry']    <- no error
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   363
    "
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   364
!
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   365
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   366
at:aKey put:aValue
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   367
    "store the argument aValue under aKey, a symbol"
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   368
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   369
"
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   370
    |oldValue|
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   371
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   372
%{
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   373
    extern OBJ __GLOBAL_SET();
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   374
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   375
    oldValue = __GLOBAL_SET(aKey, aValue, (OBJ *)0);
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   376
%}.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   377
    CachedClasses notNil ifTrue:[
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   378
	oldValue isBehavior ifTrue:[
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   379
	    CachedClasses remove:oldValue
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   380
	].
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   381
	aValue isBehavior ifTrue:[
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   382
	    CachedClasses add:aValue
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   383
	].
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   384
    ].
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   385
    ^ aValue
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   386
"
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   387
%{  /* NOCONTEXT */
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   388
    extern OBJ __GLOBAL_SET();
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   389
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   390
    (void) __GLOBAL_SET(aKey, aValue, (OBJ *)0);
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   391
%}.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   392
    CachedClasses := nil.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   393
    ^ aValue
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   394
!
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   395
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   396
includesKey:aKey
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   397
    "return true, if the key is known"
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   398
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   399
%{  /* NOCONTEXT */
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   400
    extern OBJ __GLOBAL_KEYKNOWN();
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   401
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   402
    RETURN ( __GLOBAL_KEYKNOWN(aKey) );
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   403
%}
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   404
!
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   405
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   406
removeKey:aKey
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   407
    "remove the argument from the globals dictionary"
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   408
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   409
    CachedClasses := nil.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   410
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   411
%{  /* NOCONTEXT */
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   412
    extern OBJ __GLOBAL_REMOVE();
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   413
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   414
    RETURN ( __GLOBAL_REMOVE(aKey) );
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   415
%}
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   416
!
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   417
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   418
keyAtValue:anObject
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   419
    "return the symbol under which anObject is stored - or nil"
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   420
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   421
    self keysDo:[:aKey |
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   422
	(self at:aKey) == anObject ifTrue:[^ aKey]
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   423
    ].
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   424
    ^ nil
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   425
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   426
    "Smalltalk keyAtValue:Object"
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   427
!
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   428
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   429
keys
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   430
    "return a collection with all keys in the Smalltalk dictionary"
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   431
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   432
    |keys|
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   433
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   434
    keys := IdentitySet new.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   435
    self keysDo:[:k | keys add:k].
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   436
    ^ keys
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   437
! !
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   438
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   439
!Smalltalk class methodsFor:'binary storage'!
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   440
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   441
addGlobalsTo: globalDictionary manager: manager
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   442
    |pools|
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   443
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   444
    pools := Set new.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   445
    self associationsDo:[:assoc |
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   446
	assoc value == self ifFalse:[
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   447
	    assoc value isClass ifTrue:[
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   448
		assoc value addGlobalsTo:globalDictionary manager:manager.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   449
		pools addAll:assoc value sharedPools
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   450
	    ] ifFalse:[
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   451
		globalDictionary at:assoc put:self
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   452
	    ].
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   453
	    assoc value isNil ifFalse:[
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   454
		globalDictionary at:assoc value put:self
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   455
	    ]
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   456
	]
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   457
    ].
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   458
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   459
    pools do:[:poolDictionary|
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   460
	poolDictionary addGlobalsTo:globalDictionary manager:manager
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   461
    ]
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   462
!
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   463
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   464
storeBinaryDefinitionOf: anObject on: stream manager: manager
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   465
    |string|
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   466
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   467
    anObject class == Association ifTrue:[
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   468
	string := 'Smalltalk associationAt: ', anObject key storeString
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   469
    ] ifFalse: [
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   470
	string := 'Smalltalk at: ', (self keyAtValue: anObject) storeString
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   471
    ].
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   472
    stream nextNumber:2 put:string size.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   473
    string do:[:char | stream nextPut:char asciiValue]
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   474
! !
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   475
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   476
!Smalltalk class methodsFor:'browsing'!
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   477
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   478
browseChanges
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   479
    "startup a changes browser"
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   480
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   481
    ChangesBrowser notNil ifTrue:[
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   482
	ChangesBrowser open
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   483
    ] ifFalse:[
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   484
	self warn:'no ChangesBrowser built in'
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   485
    ]
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   486
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   487
    "
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   488
     Smalltalk browseChanges
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   489
    "
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   490
!
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   491
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   492
browseAllSelect:aBlock
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   493
    "startup a browser for all methods for which aBlock returns true"
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   494
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   495
    SystemBrowser browseAllSelect:aBlock
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   496
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   497
    "
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   498
     Smalltalk browseAllSelect:[:m | m literals isNil]
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   499
    "
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   500
!
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   501
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   502
browseImplementorsOf:aSelectorSymbol
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   503
    "startup a browser for all methods implementing a particular message"
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   504
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   505
    SystemBrowser browseImplementorsOf:aSelectorSymbol
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   506
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   507
    "
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   508
     Smalltalk browseImplementorsOf:#at:put: 
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   509
    "
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   510
!
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   511
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   512
browseAllCallsOn:aSelectorSymbol
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   513
    "startup a browser for all methods sending a particular message"
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   514
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   515
    SystemBrowser browseAllCallsOn:aSelectorSymbol
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   516
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   517
    "
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   518
     Smalltalk browseAllCallsOn:#at:put: 
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   519
    "
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   520
! !
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   521
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   522
!Smalltalk class methodsFor:'class management'!
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   523
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   524
flushCachedClasses
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   525
    CachedClasses := nil
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   526
!
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   527
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   528
renameClass:aClass to:newName
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   529
    "rename aClass to newName"
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   530
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   531
    |oldName oldSym newSym names cSym value|
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   532
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   533
    oldName := aClass name.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   534
    oldSym := oldName asSymbol.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   535
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   536
    ((self at:oldSym) == aClass) ifFalse:[^ self].
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   537
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   538
    "rename the class"
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   539
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   540
    aClass setName:newName.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   541
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   542
    "and its meta"
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   543
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   544
    aClass class setName:(newName , 'class').
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   545
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   546
    "store it in Smalltalk"
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   547
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   548
    newSym := newName asSymbol.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   549
    self at:oldSym put:nil.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   550
    self removeKey:oldSym.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   551
    self at:newSym put:aClass.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   552
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   553
    "rename class variables"
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   554
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   555
    names := aClass classVariableString asCollectionOfWords.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   556
    names do:[:name |
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   557
	cSym := (oldSym , ':' , name) asSymbol.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   558
	value := self at:cSym.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   559
	self at:cSym put:nil.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   560
	self removeKey:cSym.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   561
	cSym := (newSym , ':' , name) asSymbol.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   562
	self at:cSym put:value.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   563
    ].
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   564
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   565
    aClass addChangeRecordForClassRename:oldName to:newName
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   566
!
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   567
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   568
removeClass:aClass
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   569
    "remove the argument, aClass from the smalltalk dictionary;
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   570
     we have to flush the caches since these methods are now void.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   571
     Also, class variables of aClass are removed."
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   572
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   573
    |sym cSym names oldName|
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   574
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   575
    oldName := aClass name.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   576
    sym := oldName asSymbol.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   577
    ((self at:sym) == aClass) ifFalse:[
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   578
	"check other name ..."
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   579
	(self includes:aClass) ifFalse:[
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   580
	    'SMALLTALK: no such class: ' errorPrint. oldName errorPrintNL.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   581
	    ^ self
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   582
	].
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   583
	"
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   584
	 the class has changed its name - without telling me ...
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   585
	 what should be done in this case ?
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   586
	"
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   587
	'SMALLTALK: class ' errorPrint. oldName errorPrint.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   588
	' has changed its name' errorPrintNL.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   589
	^ self
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   590
    ].
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   591
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   592
    self at:sym put:nil.    "nil it out for compiled accesses"
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   593
    self removeKey:sym.     "remove key - this actually fails, if there are
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   594
			     still compiled code references."
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   595
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   596
    "remove class variables"
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   597
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   598
    names := aClass classVariableString asCollectionOfWords.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   599
    names do:[:name |
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   600
	cSym := (sym , ':' , name) asSymbol.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   601
	self at:cSym asSymbol put:nil.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   602
	self removeKey:cSym
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   603
    ].
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   604
"
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   605
    actually could get along with less flushing
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   606
    (entries for aClass and subclasses only)
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   607
    but we have to delay this, until we have the set of subclasses
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   608
    at hand - for now, searching for all subclasses is way more
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   609
    expensive then cache flushing.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   610
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   611
    aClass allSubclassesDo:[:aSubclass |
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   612
	ObjectMemory flushInlineCachesForClass:aSubclass.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   613
	ObjectMemory flushMethodCacheFor:aSubclass
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   614
    ].
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   615
    ObjectMemory flushInlineCachesForClass:aClass.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   616
    ObjectMemory flushMethodCacheFor:aClass
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   617
"
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   618
    ObjectMemory flushInlineCaches.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   619
    ObjectMemory flushMethodCache.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   620
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   621
    aClass addChangeRecordForClassRemove:oldName.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   622
    self changed:#classRemove with:aClass.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   623
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   624
    aClass category:#removed.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   625
! !
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   626
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   627
!Smalltalk class methodsFor:'copying'!
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   628
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   629
shallowCopy
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   630
    "redefine copy - there is only one Smalltalk dictionary"
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   631
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   632
    ^ self
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   633
!
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   634
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   635
simpleDeepCopy
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   636
    "redefine copy - there is only one Smalltalk dictionary"
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   637
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   638
    ^ self
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   639
!
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   640
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   641
deepCopyUsing:aDictionary
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   642
    "redefine copy - there is only one Smalltalk dictionary"
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   643
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   644
    ^ self
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   645
!
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   646
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   647
deepCopy
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   648
    "redefine copy - there is only one Smalltalk dictionary"
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   649
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   650
    ^ self
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   651
! !
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   652
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   653
!Smalltalk class methodsFor:'debugging ST/X'!
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   654
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   655
debugBreakPoint
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   656
    "call the dummy debug function, on which a breakpoint
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   657
     can be put in adb, sdb, dbx or gdb.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   658
     WARNING: this method is for debugging only
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   659
	      it will be removed without notice."
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   660
%{
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   661
    _PATCHUPCONTEXTS(__context);
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   662
    debugBreakPoint();
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   663
%}
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   664
!
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   665
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   666
printPolyCaches
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   667
    "dump poly caches.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   668
     WARNING: this method is for debugging only
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   669
	      it will be removed without notice"
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   670
%{
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   671
    __dumpILCCaches();
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   672
%}
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   673
!
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   674
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   675
printStackBacktrace
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   676
    "print a stack backtrace - then continue.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   677
     (You may turn off the stack print with debugPrinting:false)
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   678
     WARNING: this method is for debugging only 
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   679
	      it will be removed without notice"
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   680
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   681
%{
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   682
    __printStack(__context);
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   683
%}
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   684
    "Smalltalk printStackBacktrace"
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   685
!
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   686
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   687
printSymbols
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   688
    "dump the internal symbol table.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   689
     WARNING: this method is for debugging only
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   690
	      it will be removed without notice"
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   691
%{
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   692
    __dumpSymbols();
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   693
%}
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   694
!
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   695
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   696
fatalAbort:aMessage
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   697
    "report a fatal-error; print a stack backtrace and exit with core dump
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   698
     (You may turn off the stack print with debugPrinting:false)"
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   699
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   700
%{
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   701
    char *msg;
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   702
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   703
    if (__isString(aMessage))
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   704
	msg = (char *) _stringVal(aMessage);
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   705
    else
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   706
	msg = "fatalAbort";
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   707
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   708
    __fatal0(__context, msg);
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   709
    /* NEVER RETURNS */
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   710
%}
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   711
!
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   712
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   713
fatalAbort
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   714
    "report a fatal-error, print a stack backtrace and exit with core dump.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   715
     (You may turn off the stack print with debugPrinting:false)"
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   716
%{
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   717
    __fatal0(__context, "fatalAbort");
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   718
    /* NEVER RETURNS */
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   719
%}
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   720
!
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   721
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   722
exitWithCoreDump
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   723
    "abort program and dump core"
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   724
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   725
%{  /* NOCONTEXT */
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   726
    abort();
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   727
    /* NEVER RETURNS */
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   728
%}
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   729
!
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   730
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   731
statistic
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   732
    "print some statistic data.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   733
     WARNING: this method is for debugging only 
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   734
	      it may be removed without notice"
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   735
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   736
%{  /* NOCONTEXT */
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   737
    __STATISTIC__();
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   738
%}
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   739
!
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   740
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   741
debugOn
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   742
    "turns some tracing on.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   743
     WARNING: this method is for debugging only 
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   744
	      it may be removed without notice"
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   745
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   746
    "LookupTrace := true.   "
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   747
    "AllocTrace := true.     "
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   748
    ObjectMemory flushCaches
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   749
!
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   750
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   751
debugOff
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   752
    "turns tracing off.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   753
     WARNING: this method is for debugging only 
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   754
	      it may be removed without notice"
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   755
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   756
    LookupTrace := nil.    
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   757
    ". AllocTrace := nil     "
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   758
!
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   759
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   760
executionDebugOn
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   761
    "turns tracing of interpreter on.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   762
     WARNING: this method is for debugging only 
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   763
	      it may be removed without notice"
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   764
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   765
    ExecutionTrace := true
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   766
!
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   767
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   768
executionDebugOff
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   769
    "turns tracing of interpreter off.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   770
     WARNING: this method is for debugging only 
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   771
	      it may be removed without notice"
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   772
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   773
    ExecutionTrace := nil
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   774
! !
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   775
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   776
!Smalltalk class methodsFor:'enumerating'!
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   777
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   778
do:aBlock
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   779
    "evaluate the argument, aBlock for all values in the Smalltalk dictionary"
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   780
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   781
    |work|
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   782
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   783
%{  /* NOREGISTER - work may not be placed into a register here */
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   784
    __GLOBALS_DO(&aBlock, &work COMMA_CON);
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   785
%}
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   786
!
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   787
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   788
allBehaviorsDo:aBlock
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   789
    "evaluate the argument, aBlock for all classes in the system"
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   790
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   791
    CachedClasses isNil ifTrue:[
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   792
	self allClasses
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   793
    ].
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   794
    CachedClasses do:aBlock
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   795
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   796
    "
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   797
     Smalltalk allBehaviorsDo:[:aClass | aClass name printNL]
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   798
    "
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   799
!
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   800
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   801
keysDo:aBlock
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   802
    "evaluate the argument, aBlock for all keys in the Smalltalk dictionary"
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   803
    |work|
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   804
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   805
%{  /* NOREGISTER - work may not be placed into a register here */
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   806
    __GLOBALKEYS_DO(&aBlock, &work COMMA_CON);
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   807
%}
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   808
!
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   809
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   810
allKeysDo:aBlock
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   811
    "evaluate the argument, aBlock for all keys in the Smalltalk dictionary"
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   812
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   813
    ^ self keysDo:aBlock
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   814
!
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   815
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   816
associationsDo:aBlock
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   817
    "evaluate the argument, aBlock for all key/value pairs 
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   818
     in the Smalltalk dictionary"
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   819
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   820
    self keysDo:[:aKey |
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   821
	aBlock value:(aKey -> (self at:aKey))
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   822
    ]
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   823
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   824
    "Smalltalk associationsDo:[:assoc | assoc printNL]"
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   825
!
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   826
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   827
keysAndValuesDo:aBlock
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   828
    "evaluate the two-arg block, aBlock for all keys and values"
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   829
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   830
    self keysDo:[:aKey |
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   831
	aBlock value:aKey value:(self at:aKey)
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   832
    ]
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   833
!
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   834
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   835
allClassesDo:aBlock
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   836
    "evaluate the argument, aBlock for all classes in the system.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   837
     Backward compatibility - use #allBehaviorsDo: for ST-80 compatibility."
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   838
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   839
    ^ self allBehaviorsDo:aBlock
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   840
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   841
    "
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   842
     Smalltalk allClassesDo:[:aClass | aClass name printNL]
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   843
    "
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   844
!
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   845
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   846
allClassesInCategory:aCategory do:aBlock
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   847
    "evaluate the argument, aBlock for all classes in the aCategory;
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   848
     The order of the classes is not defined."
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   849
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   850
    aCategory notNil ifTrue:[
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   851
	self allBehaviorsDo:[:aClass |
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   852
	    aClass isMeta ifFalse:[
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   853
		(aClass category = aCategory) ifTrue:[
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   854
		    aBlock value:aClass
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   855
		]
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   856
	    ]
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   857
	]
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   858
    ]
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   859
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   860
    "
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   861
     Smalltalk allClassesInCategory:'Views-Basic' do:[:aClass | aClass name printNL]
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   862
    "
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   863
!
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   864
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   865
allClassesInCategory:aCategory inOrderDo:aBlock
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   866
    "evaluate the argument, aBlock for all classes in aCategory;
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   867
     superclasses come first - then subclasses"
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   868
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   869
    |classes|
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   870
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   871
    aCategory notNil ifTrue:[
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   872
	classes := OrderedCollection new.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   873
	self allBehaviorsDo:[:aClass |
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   874
	    aClass isMeta ifFalse:[
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   875
		(aClass category = aCategory) ifTrue:[
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   876
		    classes add:aClass
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   877
		]
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   878
	    ]
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   879
	].
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   880
	classes topologicalSort:[:a :b | b isSubclassOf:a].
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   881
	classes do:aBlock
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   882
    ]
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   883
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   884
    "
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   885
     Smalltalk allClassesInCategory:'Views-Basic' inOrderDo:[:aClass | aClass name printNL]
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   886
    "
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   887
! !
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   888
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   889
!Smalltalk class methodsFor:'inspecting'!
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   890
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   891
inspectorClass
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   892
    "redefined to launch a DictionaryInspector
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   893
     (instead of the default Inspector)."
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   894
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   895
    ^ DictionaryInspectorView
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   896
! !
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   897
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   898
!Smalltalk class methodsFor:'message control'!
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   899
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   900
silentLoading
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   901
    "returns the Silentloading class variable."
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   902
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   903
     ^ SilentLoading
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   904
!
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   905
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   906
silentLoading:aBoolean
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   907
    "allows access to the Silentloading class variable, which controls
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   908
     messages from all kinds of system onto the transcript.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   909
     You can save a snapshot with this flag set to true, which makes
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   910
     the image come up silent. Can also be set, to read in files unlogged."
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   911
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   912
    |prev|
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   913
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   914
    prev := SilentLoading.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   915
    SilentLoading := aBoolean.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   916
    ^ prev
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   917
! !
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   918
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   919
!Smalltalk class methodsFor:'misc stuff'!
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   920
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   921
exit
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   922
    "finish Smalltalk system"
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   923
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   924
    ObjectMemory changed:#aboutToQuit.  "/ for ST-80 compatibility
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   925
    ExitBlocks notNil ifTrue:[
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   926
	ExitBlocks do:[:aBlock |
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   927
	    aBlock value
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   928
	]
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   929
    ].
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   930
    OperatingSystem exit
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   931
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   932
    "
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   933
     Smalltalk exit
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   934
    "
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   935
!
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   936
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   937
addExitBlock:aBlock
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   938
    "add a block to be executed when Smalltalk finishes.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   939
     This feature is currently not used anywhere - but could be useful for
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   940
     cleanup in stand alone applications."
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   941
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   942
    ExitBlocks isNil ifTrue:[
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   943
	ExitBlocks := OrderedCollection with:aBlock
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   944
    ] ifFalse:[
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   945
	ExitBlocks add:aBlock
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   946
    ]
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   947
!
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   948
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   949
sleep:aDelay
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   950
    "wait for aDelay seconds.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   951
     OBSOLETE: this is historical leftover and will be removed"
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   952
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   953
    OperatingSystem sleep:aDelay
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   954
! !
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   955
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   956
!Smalltalk class methodsFor:'queries'!
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   957
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   958
allClasses
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   959
    "return an unordered collection of all classes in the system.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   960
     Only globally anchored classes are returned 
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   961
     (i.e. anonymous ones have to be aquired by Behavior allSubInstances)"
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   962
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   963
    |classes|
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   964
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   965
    "/ you may wander, what this while is for, here ...
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   966
    "/ the reason is that if we modify the class hierarchy in
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   967
    "/ anothe view (background fileIn), while building up the
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   968
    "/ cachedClasses set, this may be flushed (invalidated) by the
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   969
    "/ other process in the meanwhile.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   970
    "/ If that happens, we restart the set-building here
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   971
    "/
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   972
    [(classes := CachedClasses) isNil] whileTrue:[
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   973
	CachedClasses := classes := IdentitySet new:800. 
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   974
	self do:[:anObject |
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   975
	    anObject notNil ifTrue:[
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   976
		anObject isBehavior ifTrue:[
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   977
		    classes add:anObject
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   978
		]
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   979
	    ]
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   980
	]
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   981
    ].
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   982
    ^ classes
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   983
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   984
    "
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   985
     Smalltalk allClasses
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   986
    "
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   987
!
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   988
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   989
classNamed:aString
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   990
    "return the class with name aString, or nil if absent.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   991
     To get to the metaClass, append 'class' to the string."
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   992
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   993
    |cls str sym|
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   994
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   995
    "be careful, to not invent new symbols ..."
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   996
    sym := aString asSymbolIfInterned.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   997
    sym notNil ifTrue:[
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   998
	cls := self at:sym ifAbsent:[].
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   999
	cls isNil ifTrue:[^ nil].
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1000
	cls isBehavior ifTrue:[^ cls]
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1001
    ].
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1002
    (aString endsWith:'class') ifTrue:[
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1003
	str := aString copyTo:(aString size - 5).
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1004
	sym := str asSymbolIfInterned.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1005
	sym notNil ifTrue:[
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1006
	    cls := self at:sym ifAbsent:[].
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1007
	    cls isNil ifTrue:[^ nil].
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1008
	    cls isBehavior ifTrue:[^ cls]
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1009
	]
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1010
    ].
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1011
    ^ nil
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1012
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1013
    "
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1014
     Smalltalk classNamed:'Object'    
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1015
     Smalltalk classNamed:'fooBar' 
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1016
     Smalltalk classNamed:'true'    
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1017
     Smalltalk classNamed:'Objectclass'    
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1018
     Smalltalk classNamed:'Metaclass'    
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1019
    "
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1020
!
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1021
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1022
numberOfGlobals
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1023
    "return the number of global variables in the system"
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1024
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1025
    |tally "{ Class: SmallInteger }" |
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1026
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1027
    tally := 0.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1028
    self do:[:obj | tally := tally + 1].
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1029
    ^ tally
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1030
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1031
    "Smalltalk numberOfGlobals"
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1032
!
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1033
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1034
cellAt:aName
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1035
    "return the address of a global cell
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1036
     - used internally for compiler only"
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1037
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1038
%{  /* NOCONTEXT */
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1039
    extern OBJ __GLOBAL_GETCELL();
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1040
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1041
    RETURN ( __GLOBAL_GETCELL(aName) );
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1042
%}
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1043
!
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1044
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1045
classNames
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1046
    "return a collection of all classNames in the system"
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1047
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1048
    ^ self allClasses collect:[:aClass | aClass name]
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1049
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1050
    "Smalltalk classNames"
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1051
!
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1052
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1053
classnameCompletion:aPartialClassName
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1054
    "given a partial classname, return an array consisting of
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1055
     2 entries: 1st: collection consisting of matching names
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1056
		2nd: the longest match"
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1057
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1058
    |matches best|
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1059
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1060
    matches := SortedCollection new.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1061
    self allClassesDo:[:aClass |
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1062
	aClass isMeta ifFalse:[
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1063
	    (aClass name startsWith:aPartialClassName) ifTrue:[
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1064
		matches add:aClass name
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1065
	    ]
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1066
	]
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1067
    ].
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1068
    matches isEmpty ifTrue:[
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1069
	^ Array with:aPartialClassName with:(Array with:aPartialClassName)
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1070
    ].
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1071
    matches size == 1 ifTrue:[
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1072
	^ Array with:matches first with:(matches asArray)
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1073
    ].
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1074
    best := matches longestCommonPrefix.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1075
    ^ Array with:best with:matches asArray
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1076
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1077
    "
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1078
     Smalltalk classnameCompletion:'Arr' 
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1079
     Smalltalk classnameCompletion:'Arra' 
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1080
    "
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1081
!
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1082
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1083
selectorCompletion:aPartialSymbolName
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1084
    "given a partial selector, return an array consisting of
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1085
     2 entries: 1st: collection consisting of matching implemented selectors
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1086
		2nd: the longest match"
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1087
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1088
    |matches best|
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1089
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1090
    matches := IdentitySet new.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1091
    self allClassesDo:[:aClass |
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1092
	aClass selectorArray do:[:aSelector |
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1093
	    (aSelector startsWith:aPartialSymbolName) ifTrue:[
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1094
		matches add:aSelector
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1095
	    ]
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1096
	].
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1097
	aClass class selectorArray do:[:aSelector |
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1098
	    (aSelector startsWith:aPartialSymbolName) ifTrue:[
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1099
		matches add:aSelector
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1100
	    ]
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1101
	]
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1102
    ].
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1103
    matches := matches asSortedCollection.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1104
    matches isEmpty ifTrue:[
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1105
	^ Array with:aPartialSymbolName with:(Array with:aPartialSymbolName)
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1106
    ].
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1107
    matches size == 1 ifTrue:[
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1108
	^ Array with:matches first with:(matches asArray)
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1109
    ].
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1110
    best := matches longestCommonPrefix.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1111
    ^ Array with:best with:matches asArray
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1112
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1113
    "
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1114
     Smalltalk selectorCompletion:'at:p'  
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1115
     Smalltalk selectorCompletion:'nextP' 
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1116
    "
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1117
!
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1118
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1119
includes:something
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1120
    "this should come from Collection.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1121
     will change the inheritance - Smalltalk is actually a collection"
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1122
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1123
    self do:[:element | element = something ifTrue:[^ true]].
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1124
    ^ false
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1125
!
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1126
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1127
references:anObject
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1128
    "redefined, since the references are only kept in the VM's symbol table"
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1129
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1130
    self keysAndValuesDo:[:key :val |
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1131
	(key == anObject) ifTrue:[^ true].
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1132
	(val == anObject ) ifTrue:[^ true].
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1133
    ].
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1134
    ^ super references:anObject
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1135
!
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1136
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1137
referencesDerivedInstanceOf:aClass
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1138
    "redefined, since the references are only kept in the VM's symbol table"
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1139
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1140
    self keysAndValuesDo:[:key :val |
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1141
	(key isKindOf:aClass) ifTrue:[^ true].
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1142
	(val isKindOf:aClass) ifTrue:[^ true].
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1143
    ].
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1144
    ^ super referencesDerivedInstanceOf:aClass
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1145
!
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1146
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1147
referencesInstanceOf:aClass
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1148
    "redefined, since the references are only kept in the VM's symbol table"
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1149
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1150
    self keysAndValuesDo:[:key :val |
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1151
	(key isMemberOf:aClass) ifTrue:[^ true].
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1152
	(val isMemberOf:aClass) ifTrue:[^ true].
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1153
    ].
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1154
    ^ super referencesInstanceOf:aClass
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1155
! !
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1156
161
ed36169f354d *** empty log message ***
claus
parents: 159
diff changeset
  1157
!Smalltalk class methodsFor:'startup'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1158
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1159
start
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1160
    "main startup, if there is a Display, initialize it
443
Claus Gittinger <cg@exept.de>
parents: 423
diff changeset
  1161
     and start dispatching; otherwise go into a read-eval-print loop."
Claus Gittinger <cg@exept.de>
parents: 423
diff changeset
  1162
Claus Gittinger <cg@exept.de>
parents: 423
diff changeset
  1163
    |idx haveStartupFile|
Claus Gittinger <cg@exept.de>
parents: 423
diff changeset
  1164
Claus Gittinger <cg@exept.de>
parents: 423
diff changeset
  1165
    haveStartupFile := true.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1166
    Initializing := true.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1167
70
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
  1168
    "
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
  1169
     while reading patches- and rc-file, do not add things into change-file
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
  1170
    "
421
claus
parents: 419
diff changeset
  1171
    Class withoutUpdatingChangesDo:[
423
claus
parents: 421
diff changeset
  1172
	"
claus
parents: 421
diff changeset
  1173
	 look for a '-e filename' argument - this will force evaluation of
claus
parents: 421
diff changeset
  1174
	 filename only, no standard startup
claus
parents: 421
diff changeset
  1175
	"
claus
parents: 421
diff changeset
  1176
	idx := Arguments indexOf:'-e'.
claus
parents: 421
diff changeset
  1177
	idx ~~ 0 ifTrue:[
421
claus
parents: 419
diff changeset
  1178
	    self fileIn:(Arguments at:idx + 1).
claus
parents: 419
diff changeset
  1179
	    self exit
423
claus
parents: 421
diff changeset
  1180
	].
claus
parents: 421
diff changeset
  1181
claus
parents: 421
diff changeset
  1182
	self secureFileIn:'patches'.
claus
parents: 421
diff changeset
  1183
claus
parents: 421
diff changeset
  1184
	(self secureFileIn:((Arguments at:1) , '.rc')) ifFalse:[
421
claus
parents: 419
diff changeset
  1185
	    "no .rc file where executable is; try default smalltalk.rc"
claus
parents: 419
diff changeset
  1186
	    (self secureFileIn:'smalltalk.rc') ifFalse:[
443
Claus Gittinger <cg@exept.de>
parents: 423
diff changeset
  1187
		Transcript showCr:'SMALLTALK: no startup rc-file found. Going into line-by-line interpreter.'.
Claus Gittinger <cg@exept.de>
parents: 423
diff changeset
  1188
		haveStartupFile := false.
421
claus
parents: 419
diff changeset
  1189
	    ]
423
claus
parents: 421
diff changeset
  1190
	].
7
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
  1191
    ].
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
  1192
70
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
  1193
    (SilentLoading == true) ifFalse:[   "i.e. undefined counts as false" 
159
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
  1194
	Transcript showCr:(self hello).
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
  1195
	Transcript showCr:(self copyrightString).
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
  1196
	Transcript cr.
70
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
  1197
159
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
  1198
	DemoMode ifTrue:[
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
  1199
	    Transcript showCr:'*** Restricted use:                              ***'.
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
  1200
	    Transcript showCr:'*** This program may be used for education only. ***'.
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
  1201
	    Transcript showCr:'*** Please read the files COPYRIGHT and LICENSE  ***'.
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
  1202
	    Transcript showCr:'*** for more details.                            ***'.
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
  1203
	    Transcript cr.
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
  1204
	].
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1205
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1206
85
claus
parents: 77
diff changeset
  1207
    "
357
claus
parents: 356
diff changeset
  1208
     enable the graphical debugger/inspector 
claus
parents: 356
diff changeset
  1209
     (they could have been (re)defined as autoloaded in the patches file)
85
claus
parents: 77
diff changeset
  1210
    "
claus
parents: 77
diff changeset
  1211
    self initStandardTools.
claus
parents: 77
diff changeset
  1212
claus
parents: 77
diff changeset
  1213
    "
95
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
  1214
     if there is a display, start its event dispatcher 
85
claus
parents: 77
diff changeset
  1215
    "
8
639f407faddd last version before big change in dispatch
claus
parents: 7
diff changeset
  1216
    Display notNil ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
  1217
	Display startDispatch.
8
639f407faddd last version before big change in dispatch
claus
parents: 7
diff changeset
  1218
    ].
24
20cfbafcd0a3 *** empty log message ***
claus
parents: 13
diff changeset
  1219
162
79c831f473a9 neue minor release nr.
claus
parents: 161
diff changeset
  1220
    Initializing := false.
79c831f473a9 neue minor release nr.
claus
parents: 161
diff changeset
  1221
24
20cfbafcd0a3 *** empty log message ***
claus
parents: 13
diff changeset
  1222
    (StartupClass notNil and:[StartupSelector notNil]) ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
  1223
	StartupClass perform:StartupSelector withArguments:StartupArguments.
24
20cfbafcd0a3 *** empty log message ***
claus
parents: 13
diff changeset
  1224
    ].
20cfbafcd0a3 *** empty log message ***
claus
parents: 13
diff changeset
  1225
95
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
  1226
    "
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
  1227
     if view-classes exist, start dispatching;
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
  1228
     otherwise go into a read-eval-print loop
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
  1229
    "
443
Claus Gittinger <cg@exept.de>
parents: 423
diff changeset
  1230
    (Display notNil and:[haveStartupFile]) ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
  1231
	Processor dispatchLoop
95
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
  1232
    ] ifFalse:[
159
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
  1233
	self readEvalPrint
95
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
  1234
    ].
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1235
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1236
    "done"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1237
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1238
    self exit
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1239
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1240
453
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1241
readEvalPrint
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1242
    "simple read-eval-print loop for non-graphical Minitalk"
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1243
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1244
    |text|
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1245
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1246
    'ST- ' print.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1247
    Stdin skipSeparators.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1248
    Stdin atEnd ifFalse:[
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1249
	text := Stdin nextChunk.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1250
	[text notNil] whileTrue:[
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1251
	    (Compiler evaluate:text) printNL.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1252
	    'ST- ' print.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1253
	    text := Stdin nextChunk
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1254
	].
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1255
    ].
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1256
    '' printNL
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1257
!
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1258
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1259
restart
24
20cfbafcd0a3 *** empty log message ***
claus
parents: 13
diff changeset
  1260
    "startup after an image has been loaded;
10
claus
parents: 8
diff changeset
  1261
     there are three change-notifications made to dependents of ObjectMemory,
claus
parents: 8
diff changeset
  1262
     which allow a stepwise re-init: #earlyRestart, #restarted and #returnFromSnapshot.
335
claus
parents: 329
diff changeset
  1263
10
claus
parents: 8
diff changeset
  1264
     #earlyRestart is send first, nothing has been setup yet.
159
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
  1265
		   (should be used to flush all device dependent entries)
335
claus
parents: 329
diff changeset
  1266
10
claus
parents: 8
diff changeset
  1267
     #restarted is send right after.
159
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
  1268
		   (should be used to recreate external resources (fds, bitmaps etc)
335
claus
parents: 329
diff changeset
  1269
10
claus
parents: 8
diff changeset
  1270
     #returnFromSnapshot is sent last
159
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
  1271
		   (should be used to restart processes, reOpen Streams which cannot
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
  1272
		    be automatically be reopened (i.e. Sockets, Pipes) and so on.
335
claus
parents: 329
diff changeset
  1273
		   (Notice that positionable fileStreams are already reopened and repositioned)
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1274
     "
10
claus
parents: 8
diff changeset
  1275
77
6c38ca59927f *** empty log message ***
claus
parents: 70
diff changeset
  1276
    |deb insp imageName|
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1277
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1278
    Initializing := true.
335
claus
parents: 329
diff changeset
  1279
claus
parents: 329
diff changeset
  1280
    "
claus
parents: 329
diff changeset
  1281
     flush cached path directories (may have changed in the meanwhile)
claus
parents: 329
diff changeset
  1282
    "
329
claus
parents: 326
diff changeset
  1283
    self flushPathCaches.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1284
95
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
  1285
    "temporary switch back to dumb interface - 
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
  1286
     to handle errors while view-stuff is not yet reinitialized"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1287
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1288
    insp := Inspector.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1289
    deb := Debugger.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1290
    Inspector := MiniInspector.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1291
    Debugger := MiniDebugger.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1292
335
claus
parents: 329
diff changeset
  1293
    "
claus
parents: 329
diff changeset
  1294
     reinitialize the Processor
claus
parents: 329
diff changeset
  1295
    "
claus
parents: 329
diff changeset
  1296
    Processor reinitialize.
claus
parents: 329
diff changeset
  1297
7
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
  1298
    ObjectMemory changed:#earlyRestart.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1299
    ObjectMemory changed:#restarted.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1300
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1301
    "
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1302
     some must be reinitialized before ...
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1303
     - sorry, but order is important
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1304
    "
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  1305
    Workstation notNil ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
  1306
	Workstation reinitialize.
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  1307
    ].
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1308
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1309
    ObjectMemory changed:#returnFromSnapshot.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1310
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1311
    OperatingSystem enableUserInterrupts.
77
6c38ca59927f *** empty log message ***
claus
parents: 70
diff changeset
  1312
    OperatingSystem enableHardSignalInterrupts.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1313
335
claus
parents: 329
diff changeset
  1314
    "now, display and view-stuff works;
claus
parents: 329
diff changeset
  1315
     back to the previous debugging interface
claus
parents: 329
diff changeset
  1316
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1317
    Inspector := insp.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1318
    Debugger := deb.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1319
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1320
    Initializing := false.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1321
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1322
    "
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1323
     if there is no Transcript, go to stderr
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1324
    "
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1325
    Transcript isNil ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
  1326
	self initStandardStreams.
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
  1327
	Transcript := Stderr
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1328
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1329
70
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
  1330
    (SilentLoading == true) ifFalse:[
159
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
  1331
	Transcript cr.
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
  1332
	Transcript showCr:('Smalltalk restarted from:' , ObjectMemory imageName).
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
  1333
	Transcript cr.
70
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
  1334
159
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
  1335
	DemoMode ifTrue:[
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
  1336
	    Transcript showCr:'*** Restricted use:                              ***'.
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
  1337
	    Transcript showCr:'*** This program may be used for education only. ***'.
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
  1338
	    Transcript showCr:'*** Please read the files COPYRIGHT and LICENSE  ***'.
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
  1339
	    Transcript showCr:'*** for more details.                            ***'.
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
  1340
	    Transcript cr.
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
  1341
	].
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1342
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1343
7
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
  1344
    "
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
  1345
     give user a chance to re-customize things
335
claus
parents: 329
diff changeset
  1346
     reading if smalltalk_r.rc may be suppressed by the
claus
parents: 329
diff changeset
  1347
     -fastStart argument.
7
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
  1348
    "
95
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
  1349
    (Arguments includes:'-faststart') ifFalse:[
423
claus
parents: 421
diff changeset
  1350
	Class withoutUpdatingChangesDo:[
421
claus
parents: 419
diff changeset
  1351
	    (self fileIn:((Arguments at:1) , '_r.rc')) ifFalse:[
423
claus
parents: 421
diff changeset
  1352
		"no _r.rc file where executable is; try default smalltalk_r.rc"
claus
parents: 421
diff changeset
  1353
		self fileIn:'smalltalk_r.rc'
421
claus
parents: 419
diff changeset
  1354
	    ].
claus
parents: 419
diff changeset
  1355
	]
7
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
  1356
    ].
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
  1357
95
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
  1358
    "
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
  1359
     if there is a display, start its event dispatcher 
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
  1360
    "
10
claus
parents: 8
diff changeset
  1361
    Display notNil ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
  1362
	Display startDispatch.
10
claus
parents: 8
diff changeset
  1363
    ].
claus
parents: 8
diff changeset
  1364
95
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
  1365
    "
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
  1366
     this allows firing an application by defining
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
  1367
     these two globals during snapshot ... or in main
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
  1368
    "
7
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
  1369
    (StartupClass notNil and:[StartupSelector notNil]) ifTrue:[
335
claus
parents: 329
diff changeset
  1370
	"
claus
parents: 329
diff changeset
  1371
	 allow more customization by reading an image specific rc-file
claus
parents: 329
diff changeset
  1372
	"
159
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
  1373
	imageName := ObjectMemory imageName.
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
  1374
	imageName notNil ifTrue:[
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
  1375
	    (imageName endsWith:'.img') ifTrue:[
359
claus
parents: 357
diff changeset
  1376
		imageName := imageName copyWithoutLast:4
claus
parents: 357
diff changeset
  1377
	    ].
claus
parents: 357
diff changeset
  1378
	    self fileIn:(imageName , '.rc')
159
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
  1379
	].
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
  1380
	StartupClass perform:StartupSelector withArguments:StartupArguments.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1381
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1382
95
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
  1383
    "
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
  1384
     if view-classes exist, start dispatching;
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
  1385
     otherwise go into a read-eval-print loop
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
  1386
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1387
    Display notNil ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
  1388
	Processor dispatchLoop
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1389
    ] ifFalse:[
159
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
  1390
	self readEvalPrint
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1391
    ].
95
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
  1392
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
  1393
    self exit
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1394
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1395
70
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
  1396
startupClass:aClass selector:aSymbol arguments:anArrayOrNil
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
  1397
    "set the class, selector and arguments to be performed when smalltalk
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
  1398
     starts. Setting those before saving a snapshot, will make the saved
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
  1399
     image come up executing your application (instead of the normal mainloop)"
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
  1400
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
  1401
    StartupClass := aClass.
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
  1402
    StartupSelector := aSymbol.
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
  1403
    StartupArguments := anArrayOrNil
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
  1404
!
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
  1405
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
  1406
startupClass
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
  1407
    "return the class, that will get the start message when smalltalk
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
  1408
     starts and its non-nil. Usually this is nil, but saving an image 
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
  1409
     with a non-nil StartupClass allows stand-alone applications"
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
  1410
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
  1411
    ^ StartupClass
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
  1412
!
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
  1413
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
  1414
startupSelector
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
  1415
    "return the selector, that will be sent to StartupClass"
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
  1416
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
  1417
    ^ StartupSelector
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
  1418
!
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
  1419
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
  1420
startupArguments
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
  1421
    "return the arguments passed to StartupClass"
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
  1422
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
  1423
    ^ StartupArguments
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
  1424
! !
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
  1425
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
  1426
!Smalltalk class methodsFor:'system management'!
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
  1427
88
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
  1428
language
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
  1429
    "return the language setting"
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
  1430
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
  1431
    ^ Language
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
  1432
!
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
  1433
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
  1434
languageTerritory
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
  1435
    "return the language territory setting"
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
  1436
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
  1437
    ^ LanguageTerritory
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
  1438
!
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
  1439
122
1680ab5285c4 allow logging of doits;
claus
parents: 95
diff changeset
  1440
logDoits
1680ab5285c4 allow logging of doits;
claus
parents: 95
diff changeset
  1441
    "return true if doits should go into the changes file
1680ab5285c4 allow logging of doits;
claus
parents: 95
diff changeset
  1442
     as well as changes - by default, this is off, since
1680ab5285c4 allow logging of doits;
claus
parents: 95
diff changeset
  1443
     it can blow up the changes file enormously ...
1680ab5285c4 allow logging of doits;
claus
parents: 95
diff changeset
  1444
    "
1680ab5285c4 allow logging of doits;
claus
parents: 95
diff changeset
  1445
1680ab5285c4 allow logging of doits;
claus
parents: 95
diff changeset
  1446
    ^ LogDoits
1680ab5285c4 allow logging of doits;
claus
parents: 95
diff changeset
  1447
1680ab5285c4 allow logging of doits;
claus
parents: 95
diff changeset
  1448
    "
1680ab5285c4 allow logging of doits;
claus
parents: 95
diff changeset
  1449
     LogDoits := false
1680ab5285c4 allow logging of doits;
claus
parents: 95
diff changeset
  1450
     LogDoits := true
1680ab5285c4 allow logging of doits;
claus
parents: 95
diff changeset
  1451
    "
1680ab5285c4 allow logging of doits;
claus
parents: 95
diff changeset
  1452
!
1680ab5285c4 allow logging of doits;
claus
parents: 95
diff changeset
  1453
453
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1454
searchPath:aPath for:aFileName in:aDirName
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1455
    "search aPath for a subdirectory named aDirectory with a file
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1456
     named aFileName"
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1457
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1458
    aPath do:[:dirName |
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1459
	|realName|
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1460
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1461
	(OperatingSystem isReadable:(realName := dirName , '/' , aDirName , '/' , aFileName)) ifTrue: [
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1462
	    ^ realName
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1463
	]
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1464
    ].
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1465
    ^ nil
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1466
!
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1467
122
1680ab5285c4 allow logging of doits;
claus
parents: 95
diff changeset
  1468
logDoits:aBoolean
1680ab5285c4 allow logging of doits;
claus
parents: 95
diff changeset
  1469
    "turn on/off logging of doits in the changes file.
1680ab5285c4 allow logging of doits;
claus
parents: 95
diff changeset
  1470
     By default, this is off, since it can blow up the 
1680ab5285c4 allow logging of doits;
claus
parents: 95
diff changeset
  1471
     changes file enormously ...
1680ab5285c4 allow logging of doits;
claus
parents: 95
diff changeset
  1472
    "
1680ab5285c4 allow logging of doits;
claus
parents: 95
diff changeset
  1473
1680ab5285c4 allow logging of doits;
claus
parents: 95
diff changeset
  1474
    LogDoits := aBoolean
1680ab5285c4 allow logging of doits;
claus
parents: 95
diff changeset
  1475
1680ab5285c4 allow logging of doits;
claus
parents: 95
diff changeset
  1476
!
1680ab5285c4 allow logging of doits;
claus
parents: 95
diff changeset
  1477
390
claus
parents: 384
diff changeset
  1478
loadBinaries:aBoolean
claus
parents: 384
diff changeset
  1479
    "turn on/off loading of binary objects"
claus
parents: 384
diff changeset
  1480
claus
parents: 384
diff changeset
  1481
    LoadBinaries := aBoolean
claus
parents: 384
diff changeset
  1482
!
claus
parents: 384
diff changeset
  1483
70
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
  1484
systemPath
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
  1485
    "return a collection of directorynames, where smalltalk
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
  1486
     looks for system files 
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
  1487
     (usually in subdirs such as resources, bitmaps, source etc.)
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
  1488
     see comment in Smalltalk>>initSystemPath."
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
  1489
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
  1490
    ^ SystemPath
77
6c38ca59927f *** empty log message ***
claus
parents: 70
diff changeset
  1491
6c38ca59927f *** empty log message ***
claus
parents: 70
diff changeset
  1492
    "
6c38ca59927f *** empty log message ***
claus
parents: 70
diff changeset
  1493
     Smalltalk systemPath
159
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
  1494
     Smalltalk systemPath addLast:'someOtherDirectoryPath'
77
6c38ca59927f *** empty log message ***
claus
parents: 70
diff changeset
  1495
    "
70
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
  1496
!
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
  1497
453
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1498
loadBinaries
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1499
    "return true, if binaries should be loaded into the system,
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1500
     false if this should be suppressed. The default is false (for now)."
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1501
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1502
    ^ LoadBinaries
329
claus
parents: 326
diff changeset
  1503
!
claus
parents: 326
diff changeset
  1504
claus
parents: 326
diff changeset
  1505
realSystemPath
claus
parents: 326
diff changeset
  1506
    "return the realSystemPath - thats the directorynames from
claus
parents: 326
diff changeset
  1507
     SystemPath which exist and are readable"
claus
parents: 326
diff changeset
  1508
claus
parents: 326
diff changeset
  1509
    RealSystemPath isNil ifTrue:[
claus
parents: 326
diff changeset
  1510
	RealSystemPath := SystemPath select:[:dirName |
claus
parents: 326
diff changeset
  1511
	    (OperatingSystem isDirectory:dirName)
claus
parents: 326
diff changeset
  1512
	    and:[OperatingSystem isReadable:dirName]
claus
parents: 326
diff changeset
  1513
	].
claus
parents: 326
diff changeset
  1514
    ].
claus
parents: 326
diff changeset
  1515
    ^ RealSystemPath
claus
parents: 326
diff changeset
  1516
!
claus
parents: 326
diff changeset
  1517
claus
parents: 326
diff changeset
  1518
constructPathFor:aDirectoryName
claus
parents: 326
diff changeset
  1519
    "search for aDirectory in SystemPath"
claus
parents: 326
diff changeset
  1520
claus
parents: 326
diff changeset
  1521
    ^ self realSystemPath select:[:dirName |
claus
parents: 326
diff changeset
  1522
	OperatingSystem isDirectory:(dirName , '/' , aDirectoryName)
claus
parents: 326
diff changeset
  1523
    ].
claus
parents: 326
diff changeset
  1524
!
claus
parents: 326
diff changeset
  1525
claus
parents: 326
diff changeset
  1526
getSourceFileName:aFileName
claus
parents: 326
diff changeset
  1527
    "search aFileName in some standard places 
claus
parents: 326
diff changeset
  1528
     (subdirectories named 'source' in SystemPath);
claus
parents: 326
diff changeset
  1529
     return the absolute filename or nil if none is found."
claus
parents: 326
diff changeset
  1530
claus
parents: 326
diff changeset
  1531
    (aFileName startsWith:'/') ifTrue:[
claus
parents: 326
diff changeset
  1532
	"dont use path for absolute file names"
claus
parents: 326
diff changeset
  1533
claus
parents: 326
diff changeset
  1534
	^ aFileName
claus
parents: 326
diff changeset
  1535
    ].
claus
parents: 326
diff changeset
  1536
claus
parents: 326
diff changeset
  1537
    SourcePath isNil ifTrue:[
claus
parents: 326
diff changeset
  1538
	SourcePath := self constructPathFor:'source'
claus
parents: 326
diff changeset
  1539
    ].
claus
parents: 326
diff changeset
  1540
claus
parents: 326
diff changeset
  1541
    ^ self searchPath:SourcePath for:aFileName in:'source' 
claus
parents: 326
diff changeset
  1542
claus
parents: 326
diff changeset
  1543
    "
claus
parents: 326
diff changeset
  1544
     Smalltalk getSourceFileName:'Smalltalk.st'
claus
parents: 326
diff changeset
  1545
    "
claus
parents: 326
diff changeset
  1546
!
claus
parents: 326
diff changeset
  1547
claus
parents: 326
diff changeset
  1548
getResourceFileName:aFileName
claus
parents: 326
diff changeset
  1549
    "search aFileName in some standard places 
claus
parents: 326
diff changeset
  1550
     (subdirectories named 'resource' in SystemPath);
claus
parents: 326
diff changeset
  1551
     return the absolute filename or nil if none is found."
70
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
  1552
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
  1553
    (aFileName startsWith:'/') ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
  1554
	"dont use path for absolute file names"
70
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
  1555
159
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
  1556
	^ aFileName
70
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
  1557
    ].
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
  1558
329
claus
parents: 326
diff changeset
  1559
    ResourcePath isNil ifTrue:[
claus
parents: 326
diff changeset
  1560
	ResourcePath := self constructPathFor:'resources'
claus
parents: 326
diff changeset
  1561
    ].
claus
parents: 326
diff changeset
  1562
claus
parents: 326
diff changeset
  1563
    ^ self searchPath:ResourcePath for:aFileName in:'resources' 
claus
parents: 326
diff changeset
  1564
claus
parents: 326
diff changeset
  1565
    "
claus
parents: 326
diff changeset
  1566
     Smalltalk getResourceFileName:'SBrowser.rs'
claus
parents: 326
diff changeset
  1567
    "
claus
parents: 326
diff changeset
  1568
!
claus
parents: 326
diff changeset
  1569
453
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1570
flushPathCaches
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1571
    RealSystemPath := ResourcePath := SourcePath := BitmapPath := BinaryPath := FileInPath := nil
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1572
!
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1573
329
claus
parents: 326
diff changeset
  1574
getBitmapFileName:aFileName
claus
parents: 326
diff changeset
  1575
    "search aFileName in some standard places 
claus
parents: 326
diff changeset
  1576
     (subdirectories named 'bitmaps' in SystemPath);
claus
parents: 326
diff changeset
  1577
     return the absolute filename or nil if none is found."
claus
parents: 326
diff changeset
  1578
claus
parents: 326
diff changeset
  1579
    (aFileName startsWith:'/') ifTrue:[
claus
parents: 326
diff changeset
  1580
	"dont use path for absolute file names"
claus
parents: 326
diff changeset
  1581
claus
parents: 326
diff changeset
  1582
	^ aFileName
claus
parents: 326
diff changeset
  1583
    ].
claus
parents: 326
diff changeset
  1584
claus
parents: 326
diff changeset
  1585
    BitmapPath isNil ifTrue:[
claus
parents: 326
diff changeset
  1586
	BitmapPath := self constructPathFor:'bitmaps'
claus
parents: 326
diff changeset
  1587
    ].
claus
parents: 326
diff changeset
  1588
claus
parents: 326
diff changeset
  1589
    ^ self searchPath:BitmapPath for:aFileName in:'bitmaps' 
claus
parents: 326
diff changeset
  1590
claus
parents: 326
diff changeset
  1591
    "
claus
parents: 326
diff changeset
  1592
     Smalltalk getBitmapFileName:'SBrowser.xbm'
claus
parents: 326
diff changeset
  1593
    "
claus
parents: 326
diff changeset
  1594
!
claus
parents: 326
diff changeset
  1595
453
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1596
getSystemFileName:aFileName
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1597
    "search aFileName in some standard places;
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1598
     return the absolute filename or nil if none is found.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1599
     see comment in Smalltalk>>initSystemPath."
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1600
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1601
    "credits for this method go to Markus ...."
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1602
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1603
    (aFileName startsWith:'/') ifTrue:[
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1604
	"dont use path for absolute file names"
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1605
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1606
	^ aFileName
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1607
    ].
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1608
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1609
    self realSystemPath do:[:dirName |
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1610
	|realName|
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1611
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1612
	realName := dirName , '/' , aFileName.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1613
	(OperatingSystem isReadable:realName) ifTrue: [
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1614
	    ^ realName
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1615
	]
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1616
    ].
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1617
    ^ nil
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1618
!
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1619
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1620
systemPath:aPath
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1621
    "set the collection of directorynames, where smalltalk
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1622
     looks for system files 
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1623
     (usually in subdirs such as resources, bitmaps, source etc.)
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1624
     see comment in Smalltalk>>initSystemPath."
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1625
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1626
    SystemPath := aPath.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1627
    self flushPathCaches
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1628
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1629
    "
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1630
     Smalltalk systemPath
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1631
     Smalltalk systemPath:(Smalltalk systemPath copy addLast:'someOtherDirectoryPath')
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1632
    "
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1633
!
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1634
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1635
systemFileStreamFor:aFileName
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1636
    "search aFileName in some standard places;
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1637
     return a readonly fileStream or nil if not found.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1638
     see comment in Smalltalk>>initSystemPath"
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1639
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1640
    |aString|
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1641
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1642
    aString := self getSystemFileName:aFileName.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1643
    aString notNil ifTrue:[
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1644
	^ FileStream readonlyFileNamed:aString
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1645
    ].
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1646
    ^ nil
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1647
!
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1648
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1649
bitmapFileStreamFor:aFileName
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1650
    "search aFileName in some standard places;
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1651
     return a readonly fileStream or nil if not found.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1652
     Searches in subdirectories named 'bitmaps' in SystemPath"
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1653
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1654
    |aString|
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1655
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1656
    aString := self getBitmapFileName:aFileName.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1657
    aString notNil ifTrue:[
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1658
	^ FileStream readonlyFileNamed:aString
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1659
    ].
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1660
    ^ nil
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1661
!
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1662
329
claus
parents: 326
diff changeset
  1663
getFileInFileName:aFileName
claus
parents: 326
diff changeset
  1664
    "search aFileName in some standard places 
claus
parents: 326
diff changeset
  1665
     (subdirectories named 'fileIn' in SystemPath);
claus
parents: 326
diff changeset
  1666
     return the absolute filename or nil if none is found."
claus
parents: 326
diff changeset
  1667
claus
parents: 326
diff changeset
  1668
    (aFileName startsWith:'/') ifTrue:[
claus
parents: 326
diff changeset
  1669
	"dont use path for absolute file names"
claus
parents: 326
diff changeset
  1670
claus
parents: 326
diff changeset
  1671
	^ aFileName
claus
parents: 326
diff changeset
  1672
    ].
claus
parents: 326
diff changeset
  1673
claus
parents: 326
diff changeset
  1674
    FileInPath isNil ifTrue:[
claus
parents: 326
diff changeset
  1675
	FileInPath := self constructPathFor:'fileIn'
claus
parents: 326
diff changeset
  1676
    ].
claus
parents: 326
diff changeset
  1677
claus
parents: 326
diff changeset
  1678
    ^ self searchPath:FileInPath for:aFileName in:'fileIn' 
claus
parents: 326
diff changeset
  1679
claus
parents: 326
diff changeset
  1680
!
claus
parents: 326
diff changeset
  1681
453
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1682
sourceFileStreamFor:aFileName
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1683
    "search aFileName in some standard places;
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1684
     return a readonly fileStream or nil if not found.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1685
     Searches in subdirectories named 'source' in SystemPath"
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1686
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1687
    |aString|
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1688
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1689
    aString := self getSourceFileName:aFileName.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1690
    aString notNil ifTrue:[
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1691
	^ FileStream readonlyFileNamed:aString
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1692
    ].
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1693
    ^ nil
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1694
!
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1695
329
claus
parents: 326
diff changeset
  1696
getBinaryFileName:aFileName
claus
parents: 326
diff changeset
  1697
    "search aFileName in some standard places 
claus
parents: 326
diff changeset
  1698
     (subdirectories named 'binary' in SystemPath);
claus
parents: 326
diff changeset
  1699
     return the absolute filename or nil if none is found."
claus
parents: 326
diff changeset
  1700
claus
parents: 326
diff changeset
  1701
    (aFileName startsWith:'/') ifTrue:[
claus
parents: 326
diff changeset
  1702
	"dont use path for absolute file names"
claus
parents: 326
diff changeset
  1703
claus
parents: 326
diff changeset
  1704
	^ aFileName
claus
parents: 326
diff changeset
  1705
    ].
claus
parents: 326
diff changeset
  1706
claus
parents: 326
diff changeset
  1707
    BinaryPath isNil ifTrue:[
claus
parents: 326
diff changeset
  1708
	BinaryPath := self constructPathFor:'binary'
claus
parents: 326
diff changeset
  1709
    ].
claus
parents: 326
diff changeset
  1710
claus
parents: 326
diff changeset
  1711
    ^ self searchPath:BinaryPath for:aFileName in:'binary' 
70
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
  1712
!
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
  1713
329
claus
parents: 326
diff changeset
  1714
resourceFileStreamFor:aFileName
claus
parents: 326
diff changeset
  1715
    "search aFileName in some standard places;
claus
parents: 326
diff changeset
  1716
     return a readonly fileStream or nil if not found.
claus
parents: 326
diff changeset
  1717
     Searches in subdirectories named 'resource' in SystemPath"
claus
parents: 326
diff changeset
  1718
claus
parents: 326
diff changeset
  1719
    |aString|
claus
parents: 326
diff changeset
  1720
claus
parents: 326
diff changeset
  1721
    aString := self getResourceFileName:aFileName.
claus
parents: 326
diff changeset
  1722
    aString notNil ifTrue:[
claus
parents: 326
diff changeset
  1723
	^ FileStream readonlyFileNamed:aString
claus
parents: 326
diff changeset
  1724
    ].
claus
parents: 326
diff changeset
  1725
    ^ nil
claus
parents: 326
diff changeset
  1726
!
claus
parents: 326
diff changeset
  1727
claus
parents: 326
diff changeset
  1728
fileInFileStreamFor:aFileName
claus
parents: 326
diff changeset
  1729
    "search aFileName in some standard places;
claus
parents: 326
diff changeset
  1730
     return a readonly fileStream or nil if not found.
claus
parents: 326
diff changeset
  1731
     Searches in subdirectories named 'fileIn' in SystemPath"
claus
parents: 326
diff changeset
  1732
claus
parents: 326
diff changeset
  1733
    |aString|
claus
parents: 326
diff changeset
  1734
claus
parents: 326
diff changeset
  1735
    aString := self getFileInFileName:aFileName.
claus
parents: 326
diff changeset
  1736
    aString notNil ifTrue:[
claus
parents: 326
diff changeset
  1737
	^ FileStream readonlyFileNamed:aString
claus
parents: 326
diff changeset
  1738
    ].
claus
parents: 326
diff changeset
  1739
    ^ nil
claus
parents: 326
diff changeset
  1740
!
claus
parents: 326
diff changeset
  1741
10
claus
parents: 8
diff changeset
  1742
readAbbreviations
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 191
diff changeset
  1743
    "read classname to filename mappings from include/abbrev.stc.
329
claus
parents: 326
diff changeset
  1744
     sigh - all for those poor sys5.3 or MSDOS people with short filenames ..."
10
claus
parents: 8
diff changeset
  1745
345
claus
parents: 335
diff changeset
  1746
    |aStream line words|
10
claus
parents: 8
diff changeset
  1747
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 191
diff changeset
  1748
    CachedAbbreviations := IdentityDictionary new.
329
claus
parents: 326
diff changeset
  1749
    aStream := self systemFileStreamFor:'include/abbrev.stc'.
10
claus
parents: 8
diff changeset
  1750
    aStream notNil ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
  1751
	[aStream atEnd] whileFalse:[
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
  1752
	    line := aStream nextLine.
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
  1753
	    line notNil ifTrue:[
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
  1754
		(line startsWith:'#') ifFalse:[
345
claus
parents: 335
diff changeset
  1755
		    words := line asCollectionOfWords.
claus
parents: 335
diff changeset
  1756
		    words size >= 2 ifTrue:[
claus
parents: 335
diff changeset
  1757
			CachedAbbreviations     
claus
parents: 335
diff changeset
  1758
				at:(words at:1) withoutSeparators asSymbol 
claus
parents: 335
diff changeset
  1759
				put:(words at:2) withoutSeparators.
claus
parents: 335
diff changeset
  1760
		    ]
claus
parents: 335
diff changeset
  1761
		]
claus
parents: 335
diff changeset
  1762
	    ]
claus
parents: 335
diff changeset
  1763
	].
claus
parents: 335
diff changeset
  1764
	aStream close
claus
parents: 335
diff changeset
  1765
    ]
claus
parents: 335
diff changeset
  1766
claus
parents: 335
diff changeset
  1767
    "
claus
parents: 335
diff changeset
  1768
     Smalltalk readAbbreviations
claus
parents: 335
diff changeset
  1769
    "
claus
parents: 335
diff changeset
  1770
!
claus
parents: 335
diff changeset
  1771
claus
parents: 335
diff changeset
  1772
libraryFileNameOfClass:aClassName
354
claus
parents: 352
diff changeset
  1773
    "read the libinfo file 'liblist.stc' and the abbreviation file 
claus
parents: 352
diff changeset
  1774
     'abbrev.stc' for an entry for aClassName.
claus
parents: 352
diff changeset
  1775
     Search for aClassName in the first col, and return the value found in
claus
parents: 352
diff changeset
  1776
     the 2nd (for the libinfo file) or the 3rd (for the abbrev file) col.
claus
parents: 352
diff changeset
  1777
     Return nil if no entry is found.
claus
parents: 352
diff changeset
  1778
345
claus
parents: 335
diff changeset
  1779
     A nil returns means that this class is either built-in or not present
claus
parents: 335
diff changeset
  1780
     in a package-class library (i.e. either as separate .o or separate .st file).
354
claus
parents: 352
diff changeset
  1781
     Otherwise, the returned name is the classLibrary object of that class."
345
claus
parents: 335
diff changeset
  1782
claus
parents: 335
diff changeset
  1783
    |aStream line words n|
claus
parents: 335
diff changeset
  1784
354
claus
parents: 352
diff changeset
  1785
    #('include/liblist.stc' 'include/abbrev.stc')
claus
parents: 352
diff changeset
  1786
    with:#(2 3) do:[:fileName :col |
claus
parents: 352
diff changeset
  1787
claus
parents: 352
diff changeset
  1788
	aStream := self systemFileStreamFor:fileName.
claus
parents: 352
diff changeset
  1789
	aStream notNil ifTrue:[
claus
parents: 352
diff changeset
  1790
	    [aStream atEnd] whileFalse:[
claus
parents: 352
diff changeset
  1791
		line := aStream nextLine.
claus
parents: 352
diff changeset
  1792
		line notNil ifTrue:[
claus
parents: 352
diff changeset
  1793
		    (line startsWith:'#') ifFalse:[
claus
parents: 352
diff changeset
  1794
			words := line asCollectionOfWords.
claus
parents: 352
diff changeset
  1795
			(n := words size) > 1 ifTrue:[
claus
parents: 352
diff changeset
  1796
			    (words at:1) = aClassName ifTrue:[
claus
parents: 352
diff changeset
  1797
				n >= col ifTrue:[
claus
parents: 352
diff changeset
  1798
				    ^ (words at:col) withoutSeparators
claus
parents: 352
diff changeset
  1799
				]
345
claus
parents: 335
diff changeset
  1800
			    ]
159
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
  1801
			]
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
  1802
		    ]
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
  1803
		]
357
claus
parents: 356
diff changeset
  1804
	    ].
claus
parents: 356
diff changeset
  1805
	    aStream close
159
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
  1806
	].
345
claus
parents: 335
diff changeset
  1807
    ].
354
claus
parents: 352
diff changeset
  1808
345
claus
parents: 335
diff changeset
  1809
    ^ nil
claus
parents: 335
diff changeset
  1810
claus
parents: 335
diff changeset
  1811
    "
claus
parents: 335
diff changeset
  1812
     Smalltalk libraryFileNameOfClass:'ClockView' 
claus
parents: 335
diff changeset
  1813
     Smalltalk libraryFileNameOfClass:'Bag' 
claus
parents: 335
diff changeset
  1814
    "
10
claus
parents: 8
diff changeset
  1815
!
claus
parents: 8
diff changeset
  1816
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 191
diff changeset
  1817
filenameAbbreviations
70
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
  1818
    "return a dictionary containing the classname-to-filename
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
  1819
     mappings. (needed for sys5.3 users, where filenames are limited
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
  1820
     to 14 chars)"
7
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
  1821
70
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
  1822
    CachedAbbreviations isNil ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
  1823
	self readAbbreviations
7
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
  1824
    ].
70
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
  1825
    ^ CachedAbbreviations
77
6c38ca59927f *** empty log message ***
claus
parents: 70
diff changeset
  1826
122
1680ab5285c4 allow logging of doits;
claus
parents: 95
diff changeset
  1827
    "flush with:
1680ab5285c4 allow logging of doits;
claus
parents: 95
diff changeset
  1828
77
6c38ca59927f *** empty log message ***
claus
parents: 70
diff changeset
  1829
     CachedAbbreviations := nil
6c38ca59927f *** empty log message ***
claus
parents: 70
diff changeset
  1830
    "
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 191
diff changeset
  1831
    "
40ca7cc6fb9c *** empty log message ***
claus
parents: 191
diff changeset
  1832
     Smalltalk filenameAbbreviations
40ca7cc6fb9c *** empty log message ***
claus
parents: 191
diff changeset
  1833
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1834
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1835
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1836
fileNameForClass:aClassName
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1837
    "return a good filename for aClassName -
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1838
     using abbreviation file if there is one"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1839
10
claus
parents: 8
diff changeset
  1840
    |fileName abbrev|
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1841
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1842
    fileName := aClassName.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1843
10
claus
parents: 8
diff changeset
  1844
    "first look, if the class exists and has a fileName"
claus
parents: 8
diff changeset
  1845
24
20cfbafcd0a3 *** empty log message ***
claus
parents: 13
diff changeset
  1846
" later ... - compiler should put the source file name into the class
10
claus
parents: 8
diff changeset
  1847
    Symbol hasInterned:aClassName ifTrue:[:sym |
159
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
  1848
	|class|
10
claus
parents: 8
diff changeset
  1849
159
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
  1850
	(Smalltalk includesKey:sym) ifTrue:[
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
  1851
	    class := Smalltalk at:sym.
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
  1852
	    class isClass ifTrue:[
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
  1853
		abbrev := class classFileName.
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
  1854
	    ]
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
  1855
	]
10
claus
parents: 8
diff changeset
  1856
    ].
claus
parents: 8
diff changeset
  1857
"
claus
parents: 8
diff changeset
  1858
7
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
  1859
    "look for abbreviation"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1860
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 191
diff changeset
  1861
    abbrev := self filenameAbbreviations at:fileName ifAbsent:[nil].
10
claus
parents: 8
diff changeset
  1862
    abbrev notNil ifTrue:[^ abbrev].
7
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
  1863
10
claus
parents: 8
diff changeset
  1864
    "no abbreviation found - if its a short name, take it"
claus
parents: 8
diff changeset
  1865
claus
parents: 8
diff changeset
  1866
    OperatingSystem maxFileNameLength < (fileName size + 3) ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
  1867
	"this will only be triggered on sys5.3 type systems"
216
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  1868
	self warn:'cant find short for ' , fileName , ' in abbreviation file'
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1869
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1870
    ^ fileName
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1871
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1872
2
claus
parents: 1
diff changeset
  1873
classNameForFile:aFileName
10
claus
parents: 8
diff changeset
  1874
    "return the className which corresponds to an abbreviated fileName,
claus
parents: 8
diff changeset
  1875
     or nil if no special translation applies. The given filename arg should
claus
parents: 8
diff changeset
  1876
     NOT include any suffix such as '.st'."
2
claus
parents: 1
diff changeset
  1877
357
claus
parents: 356
diff changeset
  1878
    ^ self filenameAbbreviations keyAtEqualValue:aFileName ifAbsent:[aFileName].
2
claus
parents: 1
diff changeset
  1879
329
claus
parents: 326
diff changeset
  1880
    "
claus
parents: 326
diff changeset
  1881
     Smalltalk classNameForFile:'DrawObj'
claus
parents: 326
diff changeset
  1882
    "
2
claus
parents: 1
diff changeset
  1883
!
claus
parents: 1
diff changeset
  1884
345
claus
parents: 335
diff changeset
  1885
fileInClass:aClassName fromObject:aFileName
70
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
  1886
    "read in the named object file and dynamic-link it into the system
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
  1887
     - look for it in some standard places;
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
  1888
     return true if ok, false if failed."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1889
356
claus
parents: 354
diff changeset
  1890
    |path ok|
329
claus
parents: 326
diff changeset
  1891
70
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
  1892
    "
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
  1893
     check if the dynamic loader class is in
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
  1894
    "
390
claus
parents: 384
diff changeset
  1895
    (LoadBinaries not or:[ObjectFileLoader isNil]) ifTrue:[^ false].
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1896
329
claus
parents: 326
diff changeset
  1897
    (path := self getBinaryFileName:aFileName) isNil ifTrue:[^ false].
356
claus
parents: 354
diff changeset
  1898
    ok := (ObjectFileLoader loadClass:aClassName fromObjectFile:path) notNil.
claus
parents: 354
diff changeset
  1899
    ok ifTrue:[
claus
parents: 354
diff changeset
  1900
	Transcript show:'  loaded ' , aClassName , ' from ' ; showCr:aFileName.
claus
parents: 354
diff changeset
  1901
    ].
claus
parents: 354
diff changeset
  1902
    ^ ok
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1903
70
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
  1904
    "
345
claus
parents: 335
diff changeset
  1905
     Smalltalk fileInClass:'AbstractPath' fromObject:'../../goodies/Paths/AbstrPath.so' 
claus
parents: 335
diff changeset
  1906
     Smalltalk fileInClass:'ClockView' fromObject:'../../libwidg3/libwidg3.so' 
70
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
  1907
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1908
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1909
321
5472c14f6ef5 *** empty log message ***
claus
parents: 314
diff changeset
  1910
secureFileIn:aFileName
5472c14f6ef5 *** empty log message ***
claus
parents: 314
diff changeset
  1911
    "read in the named file, looking for it at standard places.
5472c14f6ef5 *** empty log message ***
claus
parents: 314
diff changeset
  1912
     Catch any error during fileIn. Return true if ok, false if failed"
5472c14f6ef5 *** empty log message ***
claus
parents: 314
diff changeset
  1913
5472c14f6ef5 *** empty log message ***
claus
parents: 314
diff changeset
  1914
    (SignalSet 
5472c14f6ef5 *** empty log message ***
claus
parents: 314
diff changeset
  1915
	with:AbortSignal
5472c14f6ef5 *** empty log message ***
claus
parents: 314
diff changeset
  1916
	with:Process terminateSignal)
5472c14f6ef5 *** empty log message ***
claus
parents: 314
diff changeset
  1917
    handle:[:ex |
5472c14f6ef5 *** empty log message ***
claus
parents: 314
diff changeset
  1918
	ex return
5472c14f6ef5 *** empty log message ***
claus
parents: 314
diff changeset
  1919
    ] do:[
5472c14f6ef5 *** empty log message ***
claus
parents: 314
diff changeset
  1920
	^ self fileIn:aFileName
5472c14f6ef5 *** empty log message ***
claus
parents: 314
diff changeset
  1921
    ].
5472c14f6ef5 *** empty log message ***
claus
parents: 314
diff changeset
  1922
    ^ false
5472c14f6ef5 *** empty log message ***
claus
parents: 314
diff changeset
  1923
!
5472c14f6ef5 *** empty log message ***
claus
parents: 314
diff changeset
  1924
453
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1925
silentFileIn:aFilename
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1926
    "same as fileIn:, but do not output 'compiled...'-messages on Transcript.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1927
     Main use is during startup."
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1928
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1929
    |wasSilent|
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1930
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1931
    wasSilent := self silentLoading:true.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1932
    [
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1933
	self fileIn:aFilename
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1934
    ] valueNowOrOnUnwindDo:[
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1935
	self silentLoading:wasSilent
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1936
    ]
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1937
!
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1938
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1939
fileIn:aFileName
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1940
    "read in the named file - look for it in some standard places;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1941
     return true if ok, false if failed"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1942
453
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1943
    ^ self fileIn:aFileName lazy:nil silent:nil logged:false 
329
claus
parents: 326
diff changeset
  1944
claus
parents: 326
diff changeset
  1945
    "
claus
parents: 326
diff changeset
  1946
     Smalltalk fileIn:'source/TicTacToe.st'
claus
parents: 326
diff changeset
  1947
    "
453
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1948
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1949
    "Created: 28.10.1995 / 17:06:28 / cg"
329
claus
parents: 326
diff changeset
  1950
!
claus
parents: 326
diff changeset
  1951
400
claus
parents: 396
diff changeset
  1952
fileIn:aFileName logged:logged
claus
parents: 396
diff changeset
  1953
    "read in the named file - look for it in some standard places;
claus
parents: 396
diff changeset
  1954
     return true if ok, false if failed.
claus
parents: 396
diff changeset
  1955
     The argument logged controls, if the changefile is to be updated."
claus
parents: 396
diff changeset
  1956
claus
parents: 396
diff changeset
  1957
    ^ self fileIn:aFileName lazy:nil silent:nil logged:logged 
claus
parents: 396
diff changeset
  1958
claus
parents: 396
diff changeset
  1959
    "
claus
parents: 396
diff changeset
  1960
     Smalltalk fileIn:'source/TicTacToe.st' logged:false
claus
parents: 396
diff changeset
  1961
    "
claus
parents: 396
diff changeset
  1962
!
claus
parents: 396
diff changeset
  1963
329
claus
parents: 326
diff changeset
  1964
fileIn:aFileName lazy:lazy
claus
parents: 326
diff changeset
  1965
    "read in the named file - look for it in some standard places;
claus
parents: 326
diff changeset
  1966
     return true if ok, false if failed.
claus
parents: 326
diff changeset
  1967
     If lazy is true, no code is generated for methods, instead stups
claus
parents: 326
diff changeset
  1968
     are created which compile themself when first executed. This allows
claus
parents: 326
diff changeset
  1969
     for much faster fileIn (but slows down the first execution later).
claus
parents: 326
diff changeset
  1970
     Since no syntax checks are done when doing lazy fileIn, use this only for
claus
parents: 326
diff changeset
  1971
     code which is known to be syntactically correct."
claus
parents: 326
diff changeset
  1972
453
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1973
    ^ self fileIn:aFileName lazy:lazy silent:nil logged:false 
329
claus
parents: 326
diff changeset
  1974
claus
parents: 326
diff changeset
  1975
    "
claus
parents: 326
diff changeset
  1976
     Smalltalk fileIn:'source/TicTacToe.st' lazy:true
claus
parents: 326
diff changeset
  1977
    "
453
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1978
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1979
    "Created: 28.10.1995 / 17:06:36 / cg"
400
claus
parents: 396
diff changeset
  1980
!
claus
parents: 396
diff changeset
  1981
claus
parents: 396
diff changeset
  1982
fileIn:aFileName lazy:lazy silent:silent logged:logged
claus
parents: 396
diff changeset
  1983
    "read in the named file - look for it in some standard places;
claus
parents: 396
diff changeset
  1984
     return true if ok, false if failed.
claus
parents: 396
diff changeset
  1985
     If lazy is true, no code is generated for methods, instead stups
claus
parents: 396
diff changeset
  1986
     are created which compile themself when first executed. This allows
claus
parents: 396
diff changeset
  1987
     for much faster fileIn (but slows down the first execution later).
claus
parents: 396
diff changeset
  1988
     Since no syntax checks are done when doing lazy fileIn, use this only for
claus
parents: 396
diff changeset
  1989
     code which is known to be syntactically correct.
claus
parents: 396
diff changeset
  1990
     If silent is true, no compiler messages are output to the transcript.
claus
parents: 396
diff changeset
  1991
     Giving nil for silent/lazy will use the current settings."
claus
parents: 396
diff changeset
  1992
421
claus
parents: 419
diff changeset
  1993
    |aStream path wasLazy wasSilent morePath oldSystemPath oldRealPath|
122
1680ab5285c4 allow logging of doits;
claus
parents: 95
diff changeset
  1994
1680ab5285c4 allow logging of doits;
claus
parents: 95
diff changeset
  1995
    "
1680ab5285c4 allow logging of doits;
claus
parents: 95
diff changeset
  1996
     an object or shared object ?
1680ab5285c4 allow logging of doits;
claus
parents: 95
diff changeset
  1997
    "
1680ab5285c4 allow logging of doits;
claus
parents: 95
diff changeset
  1998
    ((aFileName endsWith:'.o')
1680ab5285c4 allow logging of doits;
claus
parents: 95
diff changeset
  1999
    or:[(aFileName endsWith:'.obj')
1680ab5285c4 allow logging of doits;
claus
parents: 95
diff changeset
  2000
    or:[aFileName endsWith:'.so']]) ifTrue:[
390
claus
parents: 384
diff changeset
  2001
	(LoadBinaries not or:[ObjectFileLoader isNil]) ifTrue:[^ false].
329
claus
parents: 326
diff changeset
  2002
	path := self getBinaryFileName:aFileName.
122
1680ab5285c4 allow logging of doits;
claus
parents: 95
diff changeset
  2003
	path isNil ifTrue:[^ false].
1680ab5285c4 allow logging of doits;
claus
parents: 95
diff changeset
  2004
	^ ObjectFileLoader loadObjectFile:aFileName
1680ab5285c4 allow logging of doits;
claus
parents: 95
diff changeset
  2005
    ].
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2006
329
claus
parents: 326
diff changeset
  2007
    (aFileName startsWith:'source/') ifTrue:[
claus
parents: 326
diff changeset
  2008
	aStream := self sourceFileStreamFor:(aFileName copyFrom:8)
claus
parents: 326
diff changeset
  2009
    ] ifFalse:[
claus
parents: 326
diff changeset
  2010
	(aFileName startsWith:'fileIn/') ifTrue:[
claus
parents: 326
diff changeset
  2011
	    aStream := self fileInFileStreamFor:(aFileName copyFrom:8)
claus
parents: 326
diff changeset
  2012
	] ifFalse:[
claus
parents: 326
diff changeset
  2013
	    aStream := self systemFileStreamFor:aFileName.
375
claus
parents: 366
diff changeset
  2014
	    (aStream notNil and:[aFileName includes:$/]) ifTrue:[
362
claus
parents: 360
diff changeset
  2015
		"/ temporarily prepend the files directory
claus
parents: 360
diff changeset
  2016
		"/ to the searchPath.
claus
parents: 360
diff changeset
  2017
		"/ This allows fileIn-driver files to refer to local
claus
parents: 360
diff changeset
  2018
		"/ files via a relative path, and drivers to fileIn other
claus
parents: 360
diff changeset
  2019
		"/ drivers ...
claus
parents: 360
diff changeset
  2020
		morePath := aStream pathName asFilename directoryName.
claus
parents: 360
diff changeset
  2021
	    ]
329
claus
parents: 326
diff changeset
  2022
	]
claus
parents: 326
diff changeset
  2023
    ].
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2024
    aStream isNil ifTrue:[^ false].
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2025
329
claus
parents: 326
diff changeset
  2026
    lazy notNil ifTrue:[wasLazy := Compiler compileLazy:lazy].
claus
parents: 326
diff changeset
  2027
    silent notNil ifTrue:[wasSilent := self silentLoading:silent].
claus
parents: 326
diff changeset
  2028
    [
423
claus
parents: 421
diff changeset
  2029
	Class updateChangeFileQuerySignal handle:[:ex |
421
claus
parents: 419
diff changeset
  2030
	    ex proceedWith:logged
423
claus
parents: 421
diff changeset
  2031
	] do:[
421
claus
parents: 419
diff changeset
  2032
	    oldSystemPath := SystemPath copy.
claus
parents: 419
diff changeset
  2033
	    morePath notNil ifTrue:[
423
claus
parents: 421
diff changeset
  2034
		SystemPath addFirst:morePath.
claus
parents: 421
diff changeset
  2035
		oldRealPath := RealSystemPath.
claus
parents: 421
diff changeset
  2036
		RealSystemPath := nil.
421
claus
parents: 419
diff changeset
  2037
	    ].
claus
parents: 419
diff changeset
  2038
	    aStream fileIn
claus
parents: 419
diff changeset
  2039
	]
329
claus
parents: 326
diff changeset
  2040
    ] valueNowOrOnUnwindDo:[
362
claus
parents: 360
diff changeset
  2041
	morePath notNil ifTrue:[
claus
parents: 360
diff changeset
  2042
	    SystemPath := oldSystemPath.
claus
parents: 360
diff changeset
  2043
	    RealSystemPath := oldRealPath.
claus
parents: 360
diff changeset
  2044
	].
329
claus
parents: 326
diff changeset
  2045
	lazy notNil ifTrue:[Compiler compileLazy:wasLazy]. 
claus
parents: 326
diff changeset
  2046
	silent notNil ifTrue:[self silentLoading:wasSilent].
claus
parents: 326
diff changeset
  2047
	aStream close
claus
parents: 326
diff changeset
  2048
    ].
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2049
    ^ true
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2050
77
6c38ca59927f *** empty log message ***
claus
parents: 70
diff changeset
  2051
    "
329
claus
parents: 326
diff changeset
  2052
     Smalltalk fileIn:'source/TicTacToe.st' lazy:true silent:true
77
6c38ca59927f *** empty log message ***
claus
parents: 70
diff changeset
  2053
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2054
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2055
453
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2056
fileIn:aFileName lazy:lazy silent:silent
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2057
    "read in the named file - look for it in some standard places;
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2058
     return true if ok, false if failed.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2059
     If lazy is true, no code is generated for methods, instead stups
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2060
     are created which compile themself when first executed. This allows
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2061
     for much faster fileIn (but slows down the first execution later).
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2062
     Since no syntax checks are done when doing lazy fileIn, use this only for
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2063
     code which is known to be syntactically correct.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2064
     If silent is true, no compiler messages are output to the transcript.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2065
     Giving nil for silent/lazy will use the current settings."
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2066
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2067
    ^ self fileIn:aFileName lazy:lazy silent:silent logged:false
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2068
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2069
    "Created: 28.10.1995 / 17:06:41 / cg"
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2070
!
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2071
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2072
fileInChanges
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2073
    "read in the last changes file - bringing the system to the state it
70
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
  2074
     had when left the last time.
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
  2075
     WARNING: this method is rubbish: it should only read things after the
400
claus
parents: 396
diff changeset
  2076
	      last '**snapshot**' - entry 
claus
parents: 396
diff changeset
  2077
	      (instead of the complete changes file)."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2078
70
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
  2079
    "
400
claus
parents: 396
diff changeset
  2080
     do NOT update the changes file now ...
70
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
  2081
    "
400
claus
parents: 396
diff changeset
  2082
    self fileIn:'changes' logged:false
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2083
77
6c38ca59927f *** empty log message ***
claus
parents: 70
diff changeset
  2084
    "
6c38ca59927f *** empty log message ***
claus
parents: 70
diff changeset
  2085
     Smalltalk fileInChanges 
6c38ca59927f *** empty log message ***
claus
parents: 70
diff changeset
  2086
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2087
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2088
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2089
fileInClass:aClassName
10
claus
parents: 8
diff changeset
  2090
    "find a source/object file for aClassName and -if found - load it.
95
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
  2091
     search is in some standard places trying driver-file (.ld), object-file (.o) and 
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
  2092
     finally source file (.st) in that order.
70
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
  2093
     The file is first searched for using the class name, then the abbreviated name."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2094
216
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  2095
    ^ self fileInClass:aClassName initialize:true lazy:false silent:false
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  2096
!
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  2097
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  2098
fileInClass:aClassName initialize:doInit
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  2099
    "find a source/object file for aClassName and -if found - load it.
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  2100
     search is in some standard places trying driver-file (.ld), object-file (.o) and 
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  2101
     finally source file (.st) in that order.
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  2102
     The file is first searched for using the class name, then the abbreviated name."
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  2103
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  2104
    ^ self fileInClass:aClassName initialize:doInit lazy:false silent:false
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  2105
!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2106
216
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  2107
fileInClass:aClassName initialize:doInit lazy:loadLazy silent:beSilent 
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  2108
    "find a source/object file for aClassName and -if found - load it.
345
claus
parents: 335
diff changeset
  2109
     search is in some standard places, trying driver-file (.ld), object-file (.o) and 
claus
parents: 335
diff changeset
  2110
     finally source file (.st), in that order.
claus
parents: 335
diff changeset
  2111
     The file is first searched for using the class name, then the abbreviated name.
claus
parents: 335
diff changeset
  2112
     The argument doInit controlls if the class should be sent a #initialize after the
claus
parents: 335
diff changeset
  2113
     load; loadLazy tells if it should be loaded lazyly. beSilent tells if the compiler
claus
parents: 335
diff changeset
  2114
     should not send notes to the transcript."
claus
parents: 335
diff changeset
  2115
claus
parents: 335
diff changeset
  2116
    |shortName libName newClass ok wasLazy wasSilent|
216
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  2117
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  2118
    wasLazy := Compiler compileLazy:loadLazy.
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  2119
    wasSilent := self silentLoading:beSilent.
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  2120
7
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
  2121
    [
216
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  2122
	Class withoutUpdatingChangesDo:
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  2123
	[
329
claus
parents: 326
diff changeset
  2124
	    ok := false.
claus
parents: 326
diff changeset
  2125
159
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
  2126
	    "
216
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  2127
	     first, look for a loader-driver file (in fileIn/xxx.ld)
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  2128
	    "
329
claus
parents: 326
diff changeset
  2129
	    (ok := self fileIn:('fileIn/' , aClassName , '.ld') lazy:loadLazy silent:beSilent)
159
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
  2130
	    ifFalse:[
216
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  2131
		shortName := self fileNameForClass:aClassName.
159
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
  2132
		"
216
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  2133
		 try abbreviated driver-file (in fileIn/xxx.ld)
159
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
  2134
		"
329
claus
parents: 326
diff changeset
  2135
		shortName ~= aClassName ifTrue:[
claus
parents: 326
diff changeset
  2136
		    ok := self fileIn:('fileIn/' , shortName , '.ld') lazy:loadLazy silent:beSilent
claus
parents: 326
diff changeset
  2137
		].
claus
parents: 326
diff changeset
  2138
		ok ifFalse:[
216
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  2139
		    "
345
claus
parents: 335
diff changeset
  2140
		     then, if dynamic linking is available, 
216
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  2141
		    "
390
claus
parents: 384
diff changeset
  2142
		    (LoadBinaries and:[ObjectFileLoader notNil]) ifTrue:[
345
claus
parents: 335
diff changeset
  2143
			"
claus
parents: 335
diff changeset
  2144
			 first look for a class packages shared binary in binary/xxx.o
claus
parents: 335
diff changeset
  2145
			"
claus
parents: 335
diff changeset
  2146
			libName := self libraryFileNameOfClass:aClassName.
claus
parents: 335
diff changeset
  2147
			libName notNil ifTrue:[
claus
parents: 335
diff changeset
  2148
			    (ok := self fileInClass:aClassName fromObject:(libName, '.so'))
159
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
  2149
			    ifFalse:[
345
claus
parents: 335
diff changeset
  2150
				ok := self fileInClass:aClassName fromObject:(libName, '.o')
claus
parents: 335
diff changeset
  2151
			    ].
claus
parents: 335
diff changeset
  2152
			].
claus
parents: 335
diff changeset
  2153
claus
parents: 335
diff changeset
  2154
			"
claus
parents: 335
diff changeset
  2155
			 then, look for a shared binary in binary/xxx.o
claus
parents: 335
diff changeset
  2156
			"
claus
parents: 335
diff changeset
  2157
			ok ifFalse:[
claus
parents: 335
diff changeset
  2158
			    (ok := self fileInClass:aClassName fromObject:(aClassName, '.so'))
claus
parents: 335
diff changeset
  2159
			    ifFalse:[
claus
parents: 335
diff changeset
  2160
				(ok := self fileInClass:aClassName fromObject:(aClassName, '.o'))
claus
parents: 335
diff changeset
  2161
				ifFalse:[
claus
parents: 335
diff changeset
  2162
				    shortName ~= aClassName ifTrue:[
claus
parents: 335
diff changeset
  2163
					(ok := self fileInClass:aClassName fromObject:(shortName, '.so'))
claus
parents: 335
diff changeset
  2164
					ifFalse:[
claus
parents: 335
diff changeset
  2165
					    ok := self fileInClass:aClassName fromObject:(shortName, '.o')
claus
parents: 335
diff changeset
  2166
					]
claus
parents: 335
diff changeset
  2167
				    ].
216
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  2168
				].
159
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
  2169
			    ].
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
  2170
			].
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
  2171
		    ].
77
6c38ca59927f *** empty log message ***
claus
parents: 70
diff changeset
  2172
216
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  2173
		    "
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  2174
		     if that did not work, look for an st-source file ...
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  2175
		    "
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  2176
		    ok ifFalse:[
329
claus
parents: 326
diff changeset
  2177
			(ok := self fileIn:(aClassName , '.st') lazy:loadLazy silent:beSilent)
159
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
  2178
			ifFalse:[
329
claus
parents: 326
diff changeset
  2179
			    shortName ~= aClassName ifTrue:[
claus
parents: 326
diff changeset
  2180
				ok := self fileIn:(shortName , '.st') lazy:loadLazy silent:beSilent
claus
parents: 326
diff changeset
  2181
			    ].
claus
parents: 326
diff changeset
  2182
			    ok ifFalse:[
216
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  2183
				"
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  2184
				 ... and in the standard source-directory
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  2185
				"
329
claus
parents: 326
diff changeset
  2186
				(ok := self fileIn:('source/' , aClassName , '.st') lazy:loadLazy silent:beSilent)
216
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  2187
				ifFalse:[
329
claus
parents: 326
diff changeset
  2188
				    shortName ~= aClassName ifTrue:[
claus
parents: 326
diff changeset
  2189
					ok := self fileIn:('source/' , shortName , '.st') lazy:loadLazy silent:beSilent
claus
parents: 326
diff changeset
  2190
				    ]
216
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  2191
				]
159
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
  2192
			    ]
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
  2193
			]
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
  2194
		    ]
216
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  2195
		].
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  2196
	    ]
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  2197
	].
329
claus
parents: 326
diff changeset
  2198
	ok ifTrue:[
claus
parents: 326
diff changeset
  2199
	    newClass := self at:(aClassName asSymbol).
claus
parents: 326
diff changeset
  2200
	    newClass notNil ifTrue:[
claus
parents: 326
diff changeset
  2201
		doInit ifTrue:[
claus
parents: 326
diff changeset
  2202
		    newClass initialize
claus
parents: 326
diff changeset
  2203
		]
216
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  2204
	    ]
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  2205
	].
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  2206
    ] valueNowOrOnUnwindDo:[
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  2207
	Compiler compileLazy:wasLazy. 
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  2208
	self silentLoading:wasSilent
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 191
diff changeset
  2209
    ].
159
514c749165c3 *** empty log message ***
claus
parents: 146
diff changeset
  2210
216
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  2211
    ^ newClass
191
38d331e1e6b1 added compressSOurces
claus
parents: 162
diff changeset
  2212
!
38d331e1e6b1 added compressSOurces
claus
parents: 162
diff changeset
  2213
453
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2214
fileInClass:aClassName initialize:doInit lazy:loadLazy
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2215
    "find a source/object file for aClassName and -if found - load it.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2216
     search is in some standard places trying driver-file (.ld), object-file (.o) and 
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2217
     finally source file (.st) in that order.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2218
     The file is first searched for using the class name, then the abbreviated name."
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2219
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2220
     ^ self fileInClass:aClassName initialize:doInit lazy:loadLazy silent:false
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2221
!
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2222
191
38d331e1e6b1 added compressSOurces
claus
parents: 162
diff changeset
  2223
compressSources
38d331e1e6b1 added compressSOurces
claus
parents: 162
diff changeset
  2224
    "compress the sources file, and remove all method source strings
38d331e1e6b1 added compressSOurces
claus
parents: 162
diff changeset
  2225
     from the system and replace them by refs to a string in the source file.
38d331e1e6b1 added compressSOurces
claus
parents: 162
diff changeset
  2226
     This is a bit different in ST/X than in other smalltalks,
38d331e1e6b1 added compressSOurces
claus
parents: 162
diff changeset
  2227
     since we use per-class sourcefiles for the compiled classes,
38d331e1e6b1 added compressSOurces
claus
parents: 162
diff changeset
  2228
     and a mix of in-memory strings and one-for-all sourceFile for
38d331e1e6b1 added compressSOurces
claus
parents: 162
diff changeset
  2229
     incremental compiled methods.
38d331e1e6b1 added compressSOurces
claus
parents: 162
diff changeset
  2230
     Therefore, only those sources which are not coming from compiled
38d331e1e6b1 added compressSOurces
claus
parents: 162
diff changeset
  2231
     methods are put into the 'st.src' file - all others are untouched.
38d331e1e6b1 added compressSOurces
claus
parents: 162
diff changeset
  2232
     This is being automated - so dont care for now."
38d331e1e6b1 added compressSOurces
claus
parents: 162
diff changeset
  2233
38d331e1e6b1 added compressSOurces
claus
parents: 162
diff changeset
  2234
    "
38d331e1e6b1 added compressSOurces
claus
parents: 162
diff changeset
  2235
     first, find all methods which contain either a string-ref
38d331e1e6b1 added compressSOurces
claus
parents: 162
diff changeset
  2236
     or an external string in the 'st.src' file
38d331e1e6b1 added compressSOurces
claus
parents: 162
diff changeset
  2237
    "
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 191
diff changeset
  2238
    |newStream table source pos fileName|
191
38d331e1e6b1 added compressSOurces
claus
parents: 162
diff changeset
  2239
38d331e1e6b1 added compressSOurces
claus
parents: 162
diff changeset
  2240
    newStream := 'src.tmp' asFilename writeStream.
38d331e1e6b1 added compressSOurces
claus
parents: 162
diff changeset
  2241
    newStream isNil ifTrue:[
38d331e1e6b1 added compressSOurces
claus
parents: 162
diff changeset
  2242
	self error:'cannot create new temporary source file'.
38d331e1e6b1 added compressSOurces
claus
parents: 162
diff changeset
  2243
	^ self
38d331e1e6b1 added compressSOurces
claus
parents: 162
diff changeset
  2244
    ].
38d331e1e6b1 added compressSOurces
claus
parents: 162
diff changeset
  2245
38d331e1e6b1 added compressSOurces
claus
parents: 162
diff changeset
  2246
    table := IdentityDictionary new:100.
38d331e1e6b1 added compressSOurces
claus
parents: 162
diff changeset
  2247
329
claus
parents: 326
diff changeset
  2248
    Method allSubInstancesDo:[:aMethod |
191
38d331e1e6b1 added compressSOurces
claus
parents: 162
diff changeset
  2249
	source := nil.
38d331e1e6b1 added compressSOurces
claus
parents: 162
diff changeset
  2250
	aMethod sourcePosition notNil ifTrue:[
38d331e1e6b1 added compressSOurces
claus
parents: 162
diff changeset
  2251
	    aMethod sourceFilename = 'st.src' ifTrue:[
38d331e1e6b1 added compressSOurces
claus
parents: 162
diff changeset
  2252
		source := aMethod source.
38d331e1e6b1 added compressSOurces
claus
parents: 162
diff changeset
  2253
	    ]
38d331e1e6b1 added compressSOurces
claus
parents: 162
diff changeset
  2254
	] ifFalse:[
38d331e1e6b1 added compressSOurces
claus
parents: 162
diff changeset
  2255
	    source := aMethod source
38d331e1e6b1 added compressSOurces
claus
parents: 162
diff changeset
  2256
	].
38d331e1e6b1 added compressSOurces
claus
parents: 162
diff changeset
  2257
38d331e1e6b1 added compressSOurces
claus
parents: 162
diff changeset
  2258
	source notNil ifTrue:[
38d331e1e6b1 added compressSOurces
claus
parents: 162
diff changeset
  2259
	    pos := newStream position.
38d331e1e6b1 added compressSOurces
claus
parents: 162
diff changeset
  2260
	    newStream nextChunkPut:source.
38d331e1e6b1 added compressSOurces
claus
parents: 162
diff changeset
  2261
38d331e1e6b1 added compressSOurces
claus
parents: 162
diff changeset
  2262
	    "
38d331e1e6b1 added compressSOurces
claus
parents: 162
diff changeset
  2263
	     dont change the methods info - maybe some write error
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 191
diff changeset
  2264
	     occurs later, in that case we abort and leave everything
191
38d331e1e6b1 added compressSOurces
claus
parents: 162
diff changeset
  2265
	     untouched.
38d331e1e6b1 added compressSOurces
claus
parents: 162
diff changeset
  2266
	    "
38d331e1e6b1 added compressSOurces
claus
parents: 162
diff changeset
  2267
	    table at:aMethod put:pos
38d331e1e6b1 added compressSOurces
claus
parents: 162
diff changeset
  2268
	]
38d331e1e6b1 added compressSOurces
claus
parents: 162
diff changeset
  2269
    ].
38d331e1e6b1 added compressSOurces
claus
parents: 162
diff changeset
  2270
38d331e1e6b1 added compressSOurces
claus
parents: 162
diff changeset
  2271
    newStream close.
38d331e1e6b1 added compressSOurces
claus
parents: 162
diff changeset
  2272
38d331e1e6b1 added compressSOurces
claus
parents: 162
diff changeset
  2273
    "
38d331e1e6b1 added compressSOurces
claus
parents: 162
diff changeset
  2274
     now, rename the new source file,
38d331e1e6b1 added compressSOurces
claus
parents: 162
diff changeset
  2275
    "
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 191
diff changeset
  2276
    fileName := (ObjectMemory nameForSources).
40ca7cc6fb9c *** empty log message ***
claus
parents: 191
diff changeset
  2277
    ('src.tmp' asFilename renameTo:fileName) ifFalse:[
191
38d331e1e6b1 added compressSOurces
claus
parents: 162
diff changeset
  2278
	self error:'cannot rename temporary file to new source file'.
38d331e1e6b1 added compressSOurces
claus
parents: 162
diff changeset
  2279
	^ self
38d331e1e6b1 added compressSOurces
claus
parents: 162
diff changeset
  2280
    ].
38d331e1e6b1 added compressSOurces
claus
parents: 162
diff changeset
  2281
38d331e1e6b1 added compressSOurces
claus
parents: 162
diff changeset
  2282
    "good - now go over all changed methods, and change their
38d331e1e6b1 added compressSOurces
claus
parents: 162
diff changeset
  2283
     source reference"
38d331e1e6b1 added compressSOurces
claus
parents: 162
diff changeset
  2284
38d331e1e6b1 added compressSOurces
claus
parents: 162
diff changeset
  2285
    table keysAndValuesDo:[:aMethod :pos |
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 191
diff changeset
  2286
	aMethod sourceFilename:fileName position:pos.
271
624d7d25dcea *** empty log message ***
claus
parents: 267
diff changeset
  2287
"/        aMethod printNL.
191
38d331e1e6b1 added compressSOurces
claus
parents: 162
diff changeset
  2288
    ].
38d331e1e6b1 added compressSOurces
claus
parents: 162
diff changeset
  2289
38d331e1e6b1 added compressSOurces
claus
parents: 162
diff changeset
  2290
    "
38d331e1e6b1 added compressSOurces
claus
parents: 162
diff changeset
  2291
     Smalltalk compressSources
38d331e1e6b1 added compressSOurces
claus
parents: 162
diff changeset
  2292
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2293
! !
2
claus
parents: 1
diff changeset
  2294
453
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2295
!Smalltalk class methodsFor:'time-versions'!
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2296
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2297
majorVersionNr
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2298
    "return the major version number.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2299
     This is only incremented for very fundamental changes,
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2300
     which make old object files totally incompatible
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2301
     (for example, if the layout/representation of fundamental
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2302
      classes changes)."
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2303
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2304
    ^ 2
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2305
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2306
    "
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2307
     Smalltalk majorVersionNr
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2308
    "
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2309
!
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2310
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2311
minorVersionNr
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2312
    "return the minor version number.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2313
     This is incremented for changes which make some old object
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2314
     files incompatible, or the protocol changes such that some
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2315
     classes need rework."
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2316
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2317
    ^ 10
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2318
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2319
    "
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2320
     Smalltalk minorVersionNr
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2321
    "
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2322
!
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2323
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2324
revisionNr
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2325
    "return the revision number.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2326
     Incremented for releases which fix bugs/add features
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2327
     and represent a stable workable version which got published
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2328
     to the outside world."
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2329
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2330
    ^ 7
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2331
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2332
    " 
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2333
     Smalltalk revisionNr
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2334
    "
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2335
!
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2336
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2337
versionString
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2338
    "return the version string"
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2339
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2340
    ^ (self majorVersionNr printString ,
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2341
       '.',
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2342
       self minorVersionNr printString ,
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2343
       '.',
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2344
       self revisionNr printString)
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2345
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2346
    "
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2347
     Smalltalk versionString
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2348
    "
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2349
!
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2350
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2351
versionDate
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2352
    "return the version date - thats the date when the smalltalk
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2353
     executable was linked."
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2354
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2355
%{
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2356
#ifdef VERSIONDATE_STRING
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2357
    RETURN ( _MKSTRING(VERSIONDATE_STRING COMMA_SND) );
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2358
#endif
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2359
%}.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2360
    ^ '12-oct-1995'
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2361
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2362
    "
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2363
     Smalltalk versionDate
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2364
    "
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2365
!
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2366
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2367
releaseNr
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2368
    "return the revision number.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2369
     Incremented for releases which fix bugs/add features."
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2370
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2371
    ^ 2
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2372
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2373
    " 
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2374
     Smalltalk releaseNr 
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2375
    "
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2376
!
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2377
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2378
configuration
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2379
    "for developers only: return the configuration, with which
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2380
     this smalltalk was compiled."
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2381
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2382
%{
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2383
    extern char *__getConfigurationString();
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2384
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2385
    RETURN (__MKSTRING(__getConfigurationString() COMMA_SND));
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2386
%}
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2387
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2388
    "
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2389
     Smalltalk configuration
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2390
    "
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2391
!
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2392
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2393
copyrightString
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2394
    "return a copyright string"
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2395
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2396
    ^ 'Copyright (c) 1988-95 by Claus Gittinger'
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2397
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2398
    "
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2399
     Smalltalk copyrightString
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2400
    "
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2401
!
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2402
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2403
hello
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2404
    "return a greeting string"
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2405
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2406
    "stupid: this should come from a resource file ...
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2407
     but I dont use it here, to allow mini-systems without
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2408
     Resource-stuff."
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2409
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2410
    (Language == #german) ifTrue:[
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2411
	^ 'Willkommen bei SmallTalk/X - Version '
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2412
	  , self versionString , ' vom ' , self versionDate
2
claus
parents: 1
diff changeset
  2413
    ].
453
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2414
    (Language == #french) ifTrue:[
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2415
	^ 'Bienvenue ` SmallTalk/X - version '
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2416
	  , self versionString , ' de ' , self versionDate
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2417
    ].
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2418
    ^ 'Hello World - here is SmallTalk/X version '
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2419
      , self versionString , ' of ' , self versionDate
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2420
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2421
    "
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2422
     Smalltalk hello
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2423
    "
2
claus
parents: 1
diff changeset
  2424
!
claus
parents: 1
diff changeset
  2425
453
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2426
timeStamp
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2427
    "return a string useful for timestamping a file.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2428
     The returned string is padded with spaces for a constant
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2429
     length (to avoid changing a files size in fileOut with unchanged
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2430
     class)."
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2431
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2432
    ^ ('''From Smalltalk/X, Version:' , (Smalltalk versionString) , ' on '
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2433
       , Date today printString , ' at ' , Time now printString
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2434
       , '''') paddedTo:80 with:(Character space)
2
claus
parents: 1
diff changeset
  2435
! !
453
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2436