Smalltalk.st
author Stefan Vogel <sv@exept.de>
Fri, 20 Sep 2019 10:31:23 +0200
changeset 24799 a6a33fc6a3c3
parent 24741 bdf7f00ee97b
child 24807 cf61f14ef49f
permissions -rw-r--r--
#QUALITY by stefan class: Smalltalk class added: #checkClass:forVersion:
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
24136
0f13645d4faf #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24123
diff changeset
     1
"{ Encoding: utf8 }"
0f13645d4faf #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24123
diff changeset
     2
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
     3
"
5
67342904af11 *** empty log message ***
claus
parents: 3
diff changeset
     4
 COPYRIGHT (c) 1988 by Claus Gittinger
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
     5
	      All Rights Reserved
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
     6
a27a279701f8 Initial revision
claus
parents:
diff changeset
     7
 This software is furnished under a license and may be used
a27a279701f8 Initial revision
claus
parents:
diff changeset
     8
 only in accordance with the terms of that license and with the
a27a279701f8 Initial revision
claus
parents:
diff changeset
     9
 inclusion of the above copyright notice.   This software may not
a27a279701f8 Initial revision
claus
parents:
diff changeset
    10
 be provided or otherwise made available to, or used by, any
a27a279701f8 Initial revision
claus
parents:
diff changeset
    11
 other person.  No title to or ownership of the software is
a27a279701f8 Initial revision
claus
parents:
diff changeset
    12
 hereby transferred.
a27a279701f8 Initial revision
claus
parents:
diff changeset
    13
"
5363
0070ef95a033 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
    14
"{ Package: 'stx:libbasic' }"
0070ef95a033 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5333
diff changeset
    15
17279
5e8cf598ce7e class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17095
diff changeset
    16
"{ NameSpace: Smalltalk }"
5e8cf598ce7e class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17095
diff changeset
    17
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    18
Object subclass:#Smalltalk
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
    19
	instanceVariableNames:''
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
    20
	classVariableNames:'StartBlocks ImageStartBlocks ExitBlocks CachedClasses
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
    21
		NumberOfClassesHint SystemPath StartupClass StartupSelector
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
    22
		StartupArguments CommandLine CommandName CommandLineArguments
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
    23
		CachedAbbreviations VerboseStartup VerboseLoading Verbose
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
    24
		SilentLoading Initializing StandAlone HeadlessOperation IsPlugin
20831
020ba0f38412 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 20830
diff changeset
    25
		IsSharedLibraryComponent IsSTScript IsRepl DebuggingStandAlone
21020
55d520adcce5 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21019
diff changeset
    26
		Silent Debugging LogDoits LoadBinaries RealSystemPath
55d520adcce5 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21019
diff changeset
    27
		ResourcePath SourcePath BinaryPath FileInPath PackagePath
55d520adcce5 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21019
diff changeset
    28
		BinaryDirName ResourceDirName SourceDirName BitmapDirName
55d520adcce5 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21019
diff changeset
    29
		PackageDirName FileInDirName ChangeFileName ImageStartTime
55d520adcce5 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21019
diff changeset
    30
		ImageRestartTime DemoMode SaveEmergencyImage SpecialObjectArray
55d520adcce5 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21019
diff changeset
    31
		CallbackSignal ClassesFailedToInitialize HasNoConsole IgnoreHalt
20615
8fbfa364a4aa #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 20603
diff changeset
    32
		PackageToPathMapping IgnoreAssertions LanguageModifier
8fbfa364a4aa #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 20603
diff changeset
    33
		LanguageCodeset'
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
    34
	poolDictionaries:''
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
    35
	category:'System-Support'
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    36
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
    37
20832
81f3da354a97 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 20831
diff changeset
    38
Smalltalk comment:''
8845
17288e4e99eb remember, where autoload decl came from
Claus Gittinger <cg@exept.de>
parents: 8821
diff changeset
    39
!
17288e4e99eb remember, where autoload decl came from
Claus Gittinger <cg@exept.de>
parents: 8821
diff changeset
    40
1750
36ff7e62388a care for privateClasses in remove
Claus Gittinger <cg@exept.de>
parents: 1713
diff changeset
    41
!Smalltalk class methodsFor:'documentation'!
70
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
    42
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
    43
copyright
617
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
    44
"
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
    45
 COPYRIGHT (c) 1988 by Claus Gittinger
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
    46
	      All Rights Reserved
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
    47
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
    48
 This software is furnished under a license and may be used
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
    49
 only in accordance with the terms of that license and with the
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
    50
 inclusion of the above copyright notice.   This software may not
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
    51
 be provided or otherwise made available to, or used by, any
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
    52
 other person.  No title to or ownership of the software is
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
    53
 hereby transferred.
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
    54
"
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
    55
!
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
    56
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
    57
documentation
70
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
    58
"
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
    59
    This is one of the central classes in the system;
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
    60
    it provides all system-startup, shutdown and maintenance support.
745
d16f199a1551 added imageStart & restart timestamps
Claus Gittinger <cg@exept.de>
parents: 736
diff changeset
    61
    Also global variables are (conceptionally) kept here.
70
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
    62
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
    63
    As you will notice, this is NOT a Dictionary
3062
5b8a2aa07108 write an emergency snapshot image,
Claus Gittinger <cg@exept.de>
parents: 3044
diff changeset
    64
    - my implementation of globals is totally different
5b8a2aa07108 write an emergency snapshot image,
Claus Gittinger <cg@exept.de>
parents: 3044
diff changeset
    65
      due to the need to be able to access globals from c-code as well,
5b8a2aa07108 write an emergency snapshot image,
Claus Gittinger <cg@exept.de>
parents: 3044
diff changeset
    66
      I do not use associations for globals, but instead keep the
5b8a2aa07108 write an emergency snapshot image,
Claus Gittinger <cg@exept.de>
parents: 3044
diff changeset
    67
      name<->value relations in the VM and access globals via utility
5b8a2aa07108 write an emergency snapshot image,
Claus Gittinger <cg@exept.de>
parents: 3044
diff changeset
    68
      functions found there.
5b8a2aa07108 write an emergency snapshot image,
Claus Gittinger <cg@exept.de>
parents: 3044
diff changeset
    69
70
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
    70
    However, it provides the known enumeration protocol.
3062
5b8a2aa07108 write an emergency snapshot image,
Claus Gittinger <cg@exept.de>
parents: 3044
diff changeset
    71
    It may change to become a subclass of collection at some time,
5b8a2aa07108 write an emergency snapshot image,
Claus Gittinger <cg@exept.de>
parents: 3044
diff changeset
    72
    to inherit more collection stuff ...
70
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
    73
745
d16f199a1551 added imageStart & restart timestamps
Claus Gittinger <cg@exept.de>
parents: 736
diff changeset
    74
1286
4270a0b4917d documentation
Claus Gittinger <cg@exept.de>
parents: 1222
diff changeset
    75
    [Instance variables:]
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
    76
					none - all handling is done in the VM
1286
4270a0b4917d documentation
Claus Gittinger <cg@exept.de>
parents: 1222
diff changeset
    77
4270a0b4917d documentation
Claus Gittinger <cg@exept.de>
parents: 1222
diff changeset
    78
    [Class variables:]
4270a0b4917d documentation
Claus Gittinger <cg@exept.de>
parents: 1222
diff changeset
    79
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
    80
	StartBlocks     <Collection>    blocks to be executed in a separate process after
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
    81
					everything has been initialized. These blocks will
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
    82
					be deleted after execution and therefore not be
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
    83
					executed after an image restart. Initial processes
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
    84
					(such as the Launcher) are usually started here.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
    85
					These blocks are added by smalltalk.rc/private.rc etc.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
    86
					via #addStartBlock during early initialization.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
    87
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
    88
	ImageStartBlocks
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
    89
			<Collection>    blocks to be executed in a separate process after
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
    90
					everything has been initialized. These blocks will be
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
    91
					executed after an image restart.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
    92
					These blocks are usually added by smalltalk_r.rc etc.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
    93
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
    94
	ExitBlocks      <Collection>    blocks to evaluate before system is
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
    95
					left. Not currently used (GNU-ST compatibility).
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
    96
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
    97
	SystemPath      <Collection>    path to search for system files (sources, bitmaps etc)
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
    98
					Set to a default here, but typically changed from some
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
    99
					startup.rc file
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   100
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   101
	PackagePath     <Collection>    path to search for package.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   102
					This is going to replace the above systemPath, and a classes
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   103
					resources will eventually searched in its package directory.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   104
					This list defines the path, where packages are searched for,
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   105
					initially this is something like /opt/smalltalk/packages.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   106
					Set to a default here, but typically changed from some
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   107
					startup.rc file
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   108
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   109
	StartupClass    <Class>         class and selector, where the system starts up
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   110
	StartupSelector <Symbol>        (right after VM initialization)
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   111
	StartupArguments <Array>        If an image is saved while those being nonNil,
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   112
					the image will come up there.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   113
					Allows for customized images to be generated from a standard ST/X.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   114
					StandAlone programs also set those during initialization.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   115
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   116
	CommandLine          <String>   Unix (OS-) command line
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   117
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   118
	CommandName          <String>   the command (i.e. argv[0])
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   119
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   120
	CommandLineArguments <Array>    Unix (OS-) command line arguments broken into words
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   121
					CommandName has been stripped off.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   122
					(initially set by the VM)
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   123
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   124
	SilentLoading   <Boolean>       OBSOLETE:
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   125
					suppresses messages during fileIn and in compiler
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   126
					(can be set to true from a customized main.c)
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   127
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   128
	VerboseLoading   <Boolean>      generate messages during fileIn and in compiler
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   129
					(can be set to true from a customized main.c)
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   130
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   131
	Initializing    <Boolean>       true while (re-)initializing
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   132
					Controls the behavior of certain error
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   133
					reporters (for example: suppress dialogBoxes)
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   134
					while the system is not yet fit for full operation.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   135
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   136
	StandAlone      <Boolean>       true, if this is a standalone app;
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   137
					if true the process scheduler watches for
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   138
					which processes are still running, and
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   139
					exits ST/X, when the last non-background
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   140
					and non-system process exits.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   141
					Can be set in an application-specific startup script,
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   142
					or, for standAlone programs, by C-code during initialization.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   143
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   144
	HeadlessOperation               if true, a non-existing Display connection
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   145
			<Boolean>       will NOT lead to an error-exit during startup.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   146
					Default is false.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   147
					Can be set in an application-specific startup script,
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   148
					or, for standAlone programs, by C-code during initialization.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   149
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   150
	LogDoits        <Boolean>       if true, doits are also logged in the changes
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   151
					file. Default is false, since the changes file
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   152
					may become huge if every tiny doIt is saved there ...
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   153
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   154
	LoadBinaries    <Boolean>       if true, we attempt to load classes rom a binary
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   155
					file, if present. If false, this is always suppressed.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   156
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   157
	SaveEmergencyImage <Boolean>    if true (the default), an emergency image
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   158
					is saved, if the main Display looses its
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   159
					connection. This is useful if you have a
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   160
					flaky display connection (serial line)
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   161
					and want to have your stuff saved automatically
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   162
					in case of a broken connection.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   163
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   164
	IgnoreAssertions  <Boolean>     if true, assertions are ignored (i.e. no errors reported).
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   165
					Usually false in the development system, true in a standalone deployed app.
1650
b4b36961d1bc Add StartBlocks and ImageStartBlocks.
Stefan Vogel <sv@exept.de>
parents: 1647
diff changeset
   166
745
d16f199a1551 added imageStart & restart timestamps
Claus Gittinger <cg@exept.de>
parents: 736
diff changeset
   167
    strictly private classVariables (helpers):
d16f199a1551 added imageStart & restart timestamps
Claus Gittinger <cg@exept.de>
parents: 736
diff changeset
   168
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   169
	CachedClasses   <Collection>    known classes (cached for faster class enumeration)
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   170
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   171
	CachedAbbreviations
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   172
			<Dictionary>    className to filename mappings
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   173
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   174
	RealSystemPath  <Collection>    cached collection of directories along the path
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   175
					which really exist. Caching avoids long checks
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   176
					for existing directories on broken NFS volumes.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   177
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   178
	SourcePath      <Collection>    cached names of really existing directories
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   179
					These are remembered, as in NFS systems,
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   180
	ResourcePath                    the time to lookup files may become long
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   181
	BinaryPath                      (especially, if some directories are on machines
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   182
	FileInPath                      which are not up ...).
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   183
					Therefore, the set of really
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   184
					existing directories is cached when the SystemPath
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   185
					is walked the first time.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   186
					A consequence is that you have to invoke
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   187
					flushSystemPath, when you create any of those
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   188
					directories while running
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   189
					(and want the running ST/X to look there)
3062
5b8a2aa07108 write an emergency snapshot image,
Claus Gittinger <cg@exept.de>
parents: 3044
diff changeset
   190
1286
4270a0b4917d documentation
Claus Gittinger <cg@exept.de>
parents: 1222
diff changeset
   191
4270a0b4917d documentation
Claus Gittinger <cg@exept.de>
parents: 1222
diff changeset
   192
    [author:]
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   193
	Claus Gittinger
3062
5b8a2aa07108 write an emergency snapshot image,
Claus Gittinger <cg@exept.de>
parents: 3044
diff changeset
   194
5b8a2aa07108 write an emergency snapshot image,
Claus Gittinger <cg@exept.de>
parents: 3044
diff changeset
   195
    [see also:]
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   196
	ObjectMemory
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   197
	StandaloneStartup
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   198
	GetOpt
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   199
	ReadEvalPrintLoop
70
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
   200
"
8945
519d441bdcb4 resources: also search for
Claus Gittinger <cg@exept.de>
parents: 8913
diff changeset
   201
!
519d441bdcb4 resources: also search for
Claus Gittinger <cg@exept.de>
parents: 8913
diff changeset
   202
519d441bdcb4 resources: also search for
Claus Gittinger <cg@exept.de>
parents: 8913
diff changeset
   203
readme_resources
519d441bdcb4 resources: also search for
Claus Gittinger <cg@exept.de>
parents: 8913
diff changeset
   204
"
519d441bdcb4 resources: also search for
Claus Gittinger <cg@exept.de>
parents: 8913
diff changeset
   205
    What is a resource file:
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   206
	resource files contain language transformation and sometimes
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   207
	UI-look specifics such as icons etc.
8945
519d441bdcb4 resources: also search for
Claus Gittinger <cg@exept.de>
parents: 8913
diff changeset
   208
519d441bdcb4 resources: also search for
Claus Gittinger <cg@exept.de>
parents: 8913
diff changeset
   209
    Where are resources stored in the image:
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   210
	Resource files are only read on demand (i.e. when needed) and only read once
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   211
	i.e. they are cached in the image).
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   212
	The cached data is held in a per-class class-instVar named 'ClassResources'.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   213
	With only a few exceptions, the only classes which need resources are the GUI
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   214
	classes under the SimpleView hierarchy.
8945
519d441bdcb4 resources: also search for
Claus Gittinger <cg@exept.de>
parents: 8913
diff changeset
   215
519d441bdcb4 resources: also search for
Claus Gittinger <cg@exept.de>
parents: 8913
diff changeset
   216
    How does the system find resources:
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   217
	The idea is that the system-provided resource files can be overwritten
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   218
	by the user or an application configuration.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   219
	This works via a hierarchy of directories where resources are searched for,
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   220
	with the systems standard resource-files being at the end of that chain.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   221
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   222
	When searching for a resource file for class X, the following files are searched
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   223
	in order:
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   224
		{ResourcePath} / resources / X.rs
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   225
		{SystemPath} / (CLASSES-PACKAGE-PATH) / X.rs
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   226
		{ResourcePath} / (CLASSES-PACKAGE-PATH) / X.rs
8945
519d441bdcb4 resources: also search for
Claus Gittinger <cg@exept.de>
parents: 8913
diff changeset
   227
"
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
   228
! !
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
   229
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
   230
!Smalltalk class methodsFor:'initialization'!
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
   231
11057
a87e5e1574ca startup error handling
Claus Gittinger <cg@exept.de>
parents: 11054
diff changeset
   232
basicInitializeSystem
16180
ddb5cec2ab0b class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16170
diff changeset
   233
    "initialize all other classes.
16655
14df7efaf339 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16642
diff changeset
   234
     This one is the very first entry into the smalltalk world
14df7efaf339 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16642
diff changeset
   235
     [with error handling, via the initializeSystem],
14df7efaf339 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16642
diff changeset
   236
     right after startup, usually immediately followed by Smalltalk>>start.
14df7efaf339 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16642
diff changeset
   237
11057
a87e5e1574ca startup error handling
Claus Gittinger <cg@exept.de>
parents: 11054
diff changeset
   238
     Notice:
23628
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
   239
        this is NOT called when an image is restarted; in this
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
   240
        case the show starts in Smalltalk>>restart."
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
   241
23670
12331a3a54a0 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23628
diff changeset
   242
    "/ 'basicInitializeSystem' infoPrintCR.
23628
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
   243
    
19992
635ac6a17b68 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 19984
diff changeset
   244
    OrderedCollection initialize.
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   245
20615
8fbfa364a4aa #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 20603
diff changeset
   246
    Smalltalk at:#Compiler put:ByteCodeCompiler.
13771
42c23bea6aaf *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 13675
diff changeset
   247
    Compiler isNil ifTrue:[
23628
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
   248
        "
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
   249
         ByteCodeCompiler is not in the system (i.e. has not been linked in)
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
   250
         this allows at least immediate evaluations for runtime systems without compiler
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
   251
         NOTICE: a parser is always needed, otherwise we cannot read resource files etc.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
   252
        "
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
   253
        Smalltalk at:#Compiler put:Parser
16164
5d9fdce75cd1 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16161
diff changeset
   254
    ].
13771
42c23bea6aaf *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 13675
diff changeset
   255
11057
a87e5e1574ca startup error handling
Claus Gittinger <cg@exept.de>
parents: 11054
diff changeset
   256
    "/
a87e5e1574ca startup error handling
Claus Gittinger <cg@exept.de>
parents: 11054
diff changeset
   257
    "/ start catching SIGSEGV and SIGBUS
a87e5e1574ca startup error handling
Claus Gittinger <cg@exept.de>
parents: 11054
diff changeset
   258
    "/
a87e5e1574ca startup error handling
Claus Gittinger <cg@exept.de>
parents: 11054
diff changeset
   259
    OperatingSystem enableHardSignalInterrupts.
a87e5e1574ca startup error handling
Claus Gittinger <cg@exept.de>
parents: 11054
diff changeset
   260
a87e5e1574ca startup error handling
Claus Gittinger <cg@exept.de>
parents: 11054
diff changeset
   261
    self initGlobalsFromEnvironment.
a87e5e1574ca startup error handling
Claus Gittinger <cg@exept.de>
parents: 11054
diff changeset
   262
a87e5e1574ca startup error handling
Claus Gittinger <cg@exept.de>
parents: 11054
diff changeset
   263
    "/
a87e5e1574ca startup error handling
Claus Gittinger <cg@exept.de>
parents: 11054
diff changeset
   264
    "/ sorry - there are some, which MUST be initialized before ..
a87e5e1574ca startup error handling
Claus Gittinger <cg@exept.de>
parents: 11054
diff changeset
   265
    "/ reason: if any error happens during init, we need Signals, Stdout etc. to be there
a87e5e1574ca startup error handling
Claus Gittinger <cg@exept.de>
parents: 11054
diff changeset
   266
    "/
15265
9a8afa1b41cb class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15225
diff changeset
   267
    SmallInteger initialize.
11057
a87e5e1574ca startup error handling
Claus Gittinger <cg@exept.de>
parents: 11054
diff changeset
   268
    Object initialize.
18283
f0c2bf4a129a class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18251
diff changeset
   269
    UninterpretedBytes initialize.
21599
32f9f39dedce #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 21592
diff changeset
   270
    ProcessorScheduler initialize.          "make sure Processor exists (RecursionLock needs it)"
16691
2a12b888e973 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16675
diff changeset
   271
    OperatingSystem initialize.
11057
a87e5e1574ca startup error handling
Claus Gittinger <cg@exept.de>
parents: 11054
diff changeset
   272
    Stream initialize.
a87e5e1574ca startup error handling
Claus Gittinger <cg@exept.de>
parents: 11054
diff changeset
   273
    PositionableStream initialize.
a87e5e1574ca startup error handling
Claus Gittinger <cg@exept.de>
parents: 11054
diff changeset
   274
    Filename initialize.
a87e5e1574ca startup error handling
Claus Gittinger <cg@exept.de>
parents: 11054
diff changeset
   275
    ObjectMemory initialize.
a87e5e1574ca startup error handling
Claus Gittinger <cg@exept.de>
parents: 11054
diff changeset
   276
    ExternalStream initialize.
a87e5e1574ca startup error handling
Claus Gittinger <cg@exept.de>
parents: 11054
diff changeset
   277
a87e5e1574ca startup error handling
Claus Gittinger <cg@exept.de>
parents: 11054
diff changeset
   278
    self initStandardStreams.    "/ setup Stdin, Stdout etc.
a87e5e1574ca startup error handling
Claus Gittinger <cg@exept.de>
parents: 11054
diff changeset
   279
a87e5e1574ca startup error handling
Claus Gittinger <cg@exept.de>
parents: 11054
diff changeset
   280
    "/
a87e5e1574ca startup error handling
Claus Gittinger <cg@exept.de>
parents: 11054
diff changeset
   281
    "/ sorry, path must be set before ...
a87e5e1574ca startup error handling
Claus Gittinger <cg@exept.de>
parents: 11054
diff changeset
   282
    "/ reason: some classes need it during initialize (they might need resources, bitmaps etc)
a87e5e1574ca startup error handling
Claus Gittinger <cg@exept.de>
parents: 11054
diff changeset
   283
    "/
17534
66817b8c13a3 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17439
diff changeset
   284
    "/ but, on OSX we need the CharacterEncoder to be initialized
66817b8c13a3 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17439
diff changeset
   285
    CharacterEncoder initialize.
11057
a87e5e1574ca startup error handling
Claus Gittinger <cg@exept.de>
parents: 11054
diff changeset
   286
    self initSystemPath.
a87e5e1574ca startup error handling
Claus Gittinger <cg@exept.de>
parents: 11054
diff changeset
   287
a87e5e1574ca startup error handling
Claus Gittinger <cg@exept.de>
parents: 11054
diff changeset
   288
    "/
14427
37ef5d66ea2a changed: #basicInitializeSystem
sr
parents: 14426
diff changeset
   289
    "/ in case, someone needs the objectFileLoader early
37ef5d66ea2a changed: #basicInitializeSystem
sr
parents: 14426
diff changeset
   290
    "/
16675
39e0cf323c6b class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16668
diff changeset
   291
    ObjectFileLoader notNil ifTrue:[
23628
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
   292
        ObjectFileLoader initialize.
16675
39e0cf323c6b class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16668
diff changeset
   293
    ].
14427
37ef5d66ea2a changed: #basicInitializeSystem
sr
parents: 14426
diff changeset
   294
37ef5d66ea2a changed: #basicInitializeSystem
sr
parents: 14426
diff changeset
   295
    "/
11057
a87e5e1574ca startup error handling
Claus Gittinger <cg@exept.de>
parents: 11054
diff changeset
   296
    "/ now, finally, initialize all other classes
a87e5e1574ca startup error handling
Claus Gittinger <cg@exept.de>
parents: 11054
diff changeset
   297
    "/
a87e5e1574ca startup error handling
Claus Gittinger <cg@exept.de>
parents: 11054
diff changeset
   298
    self initializeModules.
a87e5e1574ca startup error handling
Claus Gittinger <cg@exept.de>
parents: 11054
diff changeset
   299
a87e5e1574ca startup error handling
Claus Gittinger <cg@exept.de>
parents: 11054
diff changeset
   300
    ImageStartTime := Timestamp now.
a87e5e1574ca startup error handling
Claus Gittinger <cg@exept.de>
parents: 11054
diff changeset
   301
a87e5e1574ca startup error handling
Claus Gittinger <cg@exept.de>
parents: 11054
diff changeset
   302
    self initInterrupts.
a87e5e1574ca startup error handling
Claus Gittinger <cg@exept.de>
parents: 11054
diff changeset
   303
    self initUserPreferences.
a87e5e1574ca startup error handling
Claus Gittinger <cg@exept.de>
parents: 11054
diff changeset
   304
16668
b88318df967d flush cached class resources AFTER reading the user preferences
Claus Gittinger <cg@exept.de>
parents: 16666
diff changeset
   305
    "/ just to make sure: if any prefs affect any resources,
b88318df967d flush cached class resources AFTER reading the user preferences
Claus Gittinger <cg@exept.de>
parents: 16666
diff changeset
   306
    "/ flush them here, so they are reread in any case.
b88318df967d flush cached class resources AFTER reading the user preferences
Claus Gittinger <cg@exept.de>
parents: 16666
diff changeset
   307
    "/ required for some apps, for example to show the menu correctly (see launcher's help menu)
16675
39e0cf323c6b class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16668
diff changeset
   308
    ApplicationModel notNil ifTrue:[
23628
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
   309
        ApplicationModel flushAllClassResources.
16675
39e0cf323c6b class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16668
diff changeset
   310
    ].
16668
b88318df967d flush cached class resources AFTER reading the user preferences
Claus Gittinger <cg@exept.de>
parents: 16666
diff changeset
   311
11057
a87e5e1574ca startup error handling
Claus Gittinger <cg@exept.de>
parents: 11054
diff changeset
   312
    "/
a87e5e1574ca startup error handling
Claus Gittinger <cg@exept.de>
parents: 11054
diff changeset
   313
    "/ give classes a chance to perform 2nd-level initialization
a87e5e1574ca startup error handling
Claus Gittinger <cg@exept.de>
parents: 11054
diff changeset
   314
    "/ now, we are certain, that all other classes have been initialized
a87e5e1574ca startup error handling
Claus Gittinger <cg@exept.de>
parents: 11054
diff changeset
   315
    "/ (especially: streams and signals can now be used)
a87e5e1574ca startup error handling
Claus Gittinger <cg@exept.de>
parents: 11054
diff changeset
   316
    "/
a87e5e1574ca startup error handling
Claus Gittinger <cg@exept.de>
parents: 11054
diff changeset
   317
    ObjectMemory changed:#initialized.
a87e5e1574ca startup error handling
Claus Gittinger <cg@exept.de>
parents: 11054
diff changeset
   318
a87e5e1574ca startup error handling
Claus Gittinger <cg@exept.de>
parents: 11054
diff changeset
   319
    "Modified: / 05-12-2006 / 21:48:58 / cg"
14427
37ef5d66ea2a changed: #basicInitializeSystem
sr
parents: 14426
diff changeset
   320
    "Modified: / 24-10-2012 / 18:45:15 / sr"
21599
32f9f39dedce #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 21592
diff changeset
   321
    "Modified: / 27-02-2017 / 20:39:14 / stefan"
23670
12331a3a54a0 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23628
diff changeset
   322
    "Modified: / 06-02-2019 / 18:01:17 / Claus Gittinger"
11057
a87e5e1574ca startup error handling
Claus Gittinger <cg@exept.de>
parents: 11054
diff changeset
   323
!
a87e5e1574ca startup error handling
Claus Gittinger <cg@exept.de>
parents: 11054
diff changeset
   324
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
   325
initGlobalsFromEnvironment
617
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
   326
    "setup globals from the shell-environment"
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
   327
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
   328
    |envString i langString terrString|
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
   329
5406
4a6995b61c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5400
diff changeset
   330
    StandAlone isNil ifTrue:[
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   331
	StandAlone := false.
5406
4a6995b61c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5400
diff changeset
   332
    ].
6559
2ec6d0d1b821 Changed Workstation initialization
Stefan Vogel <sv@exept.de>
parents: 6539
diff changeset
   333
    HeadlessOperation isNil ifTrue:[
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   334
	HeadlessOperation := false.
6559
2ec6d0d1b821 Changed Workstation initialization
Stefan Vogel <sv@exept.de>
parents: 6539
diff changeset
   335
    ].
5406
4a6995b61c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5400
diff changeset
   336
617
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
   337
    "
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
   338
     extract Language and LanguageTerritory from LANG variable.
5846
a972d0e7e06b Parsing of de_DE
Stefan Vogel <sv@exept.de>
parents: 5841
diff changeset
   339
     valid are for example:
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   340
			    en_en / en
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   341
			    en_us
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   342
			    en_gb
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   343
			    de_de / de
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   344
			    de_at       (for Austria)
5846
a972d0e7e06b Parsing of de_DE
Stefan Vogel <sv@exept.de>
parents: 5841
diff changeset
   345
    "
a972d0e7e06b Parsing of de_DE
Stefan Vogel <sv@exept.de>
parents: 5841
diff changeset
   346
a972d0e7e06b Parsing of de_DE
Stefan Vogel <sv@exept.de>
parents: 5841
diff changeset
   347
    Language := #en.
994
6163ae7aaf9b territory defaults to #us (instead of #usa)
Claus Gittinger <cg@exept.de>
parents: 977
diff changeset
   348
    LanguageTerritory := #us.
617
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
   349
5846
a972d0e7e06b Parsing of de_DE
Stefan Vogel <sv@exept.de>
parents: 5841
diff changeset
   350
a972d0e7e06b Parsing of de_DE
Stefan Vogel <sv@exept.de>
parents: 5841
diff changeset
   351
    "Format of LANG is: language[_territory][.codeset][@modifier]
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   352
	language        ISO-639  Language code
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   353
	territory       ISO-3166 Contry code"
7779
6d88d32bdd64 Language stuff: use OperatingSystem>>getLanguage to get
Stefan Vogel <sv@exept.de>
parents: 7763
diff changeset
   354
6d88d32bdd64 Language stuff: use OperatingSystem>>getLanguage to get
Stefan Vogel <sv@exept.de>
parents: 7763
diff changeset
   355
    envString := OperatingSystem getLanguage.
21928
b14c2d0608e0 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 21782
diff changeset
   356
    envString notEmptyOrNil ifTrue:[
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   357
	i := envString indexOf:$@.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   358
	(i ~~ 0) ifTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   359
	    LanguageModifier := (envString copyFrom:(i + 1)) asLowercase asSymbol.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   360
	    envString := envString copyTo:(i - 1).
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   361
	] ifFalse:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   362
	    LanguageModifier := nil.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   363
	].
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   364
	i := envString indexOf:$..
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   365
	(i ~~ 0) ifTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   366
	    LanguageCodeset := (envString copyFrom:(i + 1)) asLowercase asSymbol.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   367
	    envString := envString copyTo:(i - 1).
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   368
	] ifFalse:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   369
	    LanguageCodeset := #'iso8859-1'.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   370
	].
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   371
	i := envString indexOf:$_.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   372
	(i == 0) ifTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   373
	    langString := envString.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   374
	    terrString := envString
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   375
	] ifFalse:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   376
	    langString := envString copyTo:(i - 1).
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   377
	    terrString := envString copyFrom:(i + 1)
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   378
	].
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   379
	langString := langString asLowercase.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   380
	terrString := terrString asLowercase.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   381
	(langString = 'c' or:[terrString = 'c']) ifTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   382
	    ('Smalltalk [info]: ignoring wrong LANG setting (',langString,'_',terrString,') - using english') infoPrintCR.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   383
	] ifFalse:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   384
	    Language := langString asSymbol.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   385
	    LanguageTerritory := terrString asSymbol
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   386
	]
617
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
   387
    ].
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
   388
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
   389
    "
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
   390
     Smalltalk initGlobalsFromEnvironment
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
   391
    "
994
6163ae7aaf9b territory defaults to #us (instead of #usa)
Claus Gittinger <cg@exept.de>
parents: 977
diff changeset
   392
14011
d33d2c6497f4 changed: #initGlobalsFromEnvironment
Claus Gittinger <cg@exept.de>
parents: 13998
diff changeset
   393
    "Modified: / 14-02-2012 / 15:25:08 / cg"
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
   394
!
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
   395
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
   396
initInterrupts
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
   397
    "initialize interrupts"
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
   398
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
   399
    OperatingSystem enableUserInterrupts.
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
   400
    OperatingSystem enableHardSignalInterrupts.
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
   401
    OperatingSystem enableCrashSignalInterrupts.
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
   402
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
   403
    ObjectMemory userInterruptHandler:self.
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
   404
    ObjectMemory signalInterruptHandler:self.
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
   405
    ObjectMemory recursionInterruptHandler:self.
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
   406
14805
33c5758318a6 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 14793
diff changeset
   407
    OperatingSystem isOSXlike ifTrue:[
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   408
	"/ OSX sends SIGABRT for NSExceptions
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   409
	OperatingSystem operatingSystemSignal:(OperatingSystem sigABRT) install:NSException.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   410
	OperatingSystem enableAbortInterrupts.
14805
33c5758318a6 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 14793
diff changeset
   411
    ].
33c5758318a6 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 14793
diff changeset
   412
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
   413
    "
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
   414
     Smalltalk initInterrupts
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
   415
    "
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
   416
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
   417
    "Modified: 20.8.1997 / 09:35:49 / stefan"
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
   418
!
617
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
   419
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
   420
initStandardStreams
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
   421
    "initialize some well-known streams"
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
   422
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
   423
    Stdout := NonPositionableExternalStream forStdout.
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
   424
    Stderr := NonPositionableExternalStream forStderr.
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
   425
    Stdin := NonPositionableExternalStream forStdin.
10145
cca90547778e allow for different OS's to initialize the Printer differently
Claus Gittinger <cg@exept.de>
parents: 10143
diff changeset
   426
    PrinterStream notNil ifTrue:[
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   427
	Printer := PrinterStream defaultPrinter.
10145
cca90547778e allow for different OS's to initialize the Printer differently
Claus Gittinger <cg@exept.de>
parents: 10143
diff changeset
   428
    ].
617
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
   429
    Transcript := Stderr
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
   430
963
fef0f2ed2709 more for standAlone (nonGraphical) mode
Claus Gittinger <cg@exept.de>
parents: 962
diff changeset
   431
    "
fef0f2ed2709 more for standAlone (nonGraphical) mode
Claus Gittinger <cg@exept.de>
parents: 962
diff changeset
   432
     Smalltalk initStandardStreams
fef0f2ed2709 more for standAlone (nonGraphical) mode
Claus Gittinger <cg@exept.de>
parents: 962
diff changeset
   433
    "
10145
cca90547778e allow for different OS's to initialize the Printer differently
Claus Gittinger <cg@exept.de>
parents: 10143
diff changeset
   434
cca90547778e allow for different OS's to initialize the Printer differently
Claus Gittinger <cg@exept.de>
parents: 10143
diff changeset
   435
    "Modified: / 25-10-2006 / 17:36:46 / cg"
617
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
   436
!
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
   437
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
   438
initStandardTools
10646
39e8fbfed83c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10645
diff changeset
   439
    "predefine some tools which we might need later
617
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
   440
     - if the view-classes exist,
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
   441
       they will redefine Inspector and Debugger for graphical interfaces"
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
   442
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
   443
    Display notNil ifTrue:[
24062
d95c06ef5614 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 23873
diff changeset
   444
        InspectorView notNil ifTrue:[
d95c06ef5614 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 23873
diff changeset
   445
            Inspector := InspectorView
d95c06ef5614 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 23873
diff changeset
   446
        ].
d95c06ef5614 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 23873
diff changeset
   447
        DebugView notNil ifTrue:[
d95c06ef5614 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 23873
diff changeset
   448
            Debugger := DebugView
d95c06ef5614 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 23873
diff changeset
   449
        ].
d95c06ef5614 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 23873
diff changeset
   450
        "/ Display initialize
13303
1aa90c41dd35 changed: #initStandardTools
Claus Gittinger <cg@exept.de>
parents: 13212
diff changeset
   451
    ].
1aa90c41dd35 changed: #initStandardTools
Claus Gittinger <cg@exept.de>
parents: 13212
diff changeset
   452
1aa90c41dd35 changed: #initStandardTools
Claus Gittinger <cg@exept.de>
parents: 13212
diff changeset
   453
    "/ make the changeFilePath an absolute one,
1aa90c41dd35 changed: #initStandardTools
Claus Gittinger <cg@exept.de>
parents: 13212
diff changeset
   454
    "/ in case some stupid windows fileDialog changes the current directory...
13323
68e5bb82f5f7 changed: #loadPackage:fromClassLibrary:
Stefan Vogel <sv@exept.de>
parents: 13303
diff changeset
   455
    ObjectMemory
24062
d95c06ef5614 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 23873
diff changeset
   456
        nameForChanges:(Filename currentDirectory / ObjectMemory nameForChangesLocal) pathName
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
   457
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
   458
    "
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
   459
     Smalltalk initStandardTools
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
   460
    "
13303
1aa90c41dd35 changed: #initStandardTools
Claus Gittinger <cg@exept.de>
parents: 13212
diff changeset
   461
1aa90c41dd35 changed: #initStandardTools
Claus Gittinger <cg@exept.de>
parents: 13212
diff changeset
   462
    "Modified: / 09-02-2011 / 20:44:47 / cg"
24062
d95c06ef5614 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 23873
diff changeset
   463
    "Modified: / 11-04-2019 / 18:07:24 / Stefan Vogel"
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
   464
!
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
   465
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
   466
initSystemPath
617
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
   467
    "setup path where system files are searched for.
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
   468
     the default path is set to:
23433
247788b989f6 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23419
diff changeset
   469
            .
247788b989f6 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23419
diff changeset
   470
            <directory of exe>       (WIN32 only)
247788b989f6 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23419
diff changeset
   471
            $HOME                    (if defined)
247788b989f6 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23419
diff changeset
   472
            $HOME/.smalltalk         (if defined & existing)
247788b989f6 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23419
diff changeset
   473
            $SMALLTALK_LIBDIR        (if defined & existing)
247788b989f6 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23419
diff changeset
   474
            $STX_LIBDIR              (if defined & existing)
247788b989f6 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23419
diff changeset
   475
            $STX_TOPDIR              (if defined & existing)
247788b989f6 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23419
diff changeset
   476
            REGISTRY('HKEY_LOCAL_MACHINE\Software\eXept\Smalltalk/X\<CurrentVersion>\LibDir') (WIN32 only)
247788b989f6 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23419
diff changeset
   477
            REGISTRY('HKEY_LOCAL_MACHINE\Software\eXept\Smalltalk/X\LibDir')                  (WIN32 only)
247788b989f6 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23419
diff changeset
   478
            <standard places>
9021
6541db62a929 systemPath setup changed
Claus Gittinger <cg@exept.de>
parents: 9020
diff changeset
   479
6541db62a929 systemPath setup changed
Claus Gittinger <cg@exept.de>
parents: 9020
diff changeset
   480
     standard places (unix):
23433
247788b989f6 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23419
diff changeset
   481
            /opt/smalltalk/<release> (if existing)
247788b989f6 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23419
diff changeset
   482
            /opt/smalltalk           (if existing)
247788b989f6 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23419
diff changeset
   483
            /usr/local/lib/smalltalk (if existing)
247788b989f6 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23419
diff changeset
   484
            /usr/lib/smalltalk       (if existing)
247788b989f6 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23419
diff changeset
   485
            /lib/smalltalk           (if existing)
4001
fa75465bd263 made systemPath setup OS-specific
Claus Gittinger <cg@exept.de>
parents: 3991
diff changeset
   486
fa75465bd263 made systemPath setup OS-specific
Claus Gittinger <cg@exept.de>
parents: 3991
diff changeset
   487
     win32:
23433
247788b989f6 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23419
diff changeset
   488
            \programs\exept\smalltalk (if existing)
247788b989f6 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23419
diff changeset
   489
            \programs\smalltalk       (if existing)
247788b989f6 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23419
diff changeset
   490
            \smalltalk                (if existing)
4001
fa75465bd263 made systemPath setup OS-specific
Claus Gittinger <cg@exept.de>
parents: 3991
diff changeset
   491
fa75465bd263 made systemPath setup OS-specific
Claus Gittinger <cg@exept.de>
parents: 3991
diff changeset
   492
     vms:
23433
247788b989f6 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23419
diff changeset
   493
            $stx:lib                 (if existing)
247788b989f6 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23419
diff changeset
   494
            $stx:root                (if existing)
617
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
   495
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
   496
     of course, it is possible to add entries from the 'smalltalk.rc'
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
   497
     startup file; add expressions such as:
23433
247788b989f6 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23419
diff changeset
   498
            Smalltalk systemPath addFirst:'/foo/bar/baz'.
247788b989f6 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23419
diff changeset
   499
        or:
247788b989f6 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23419
diff changeset
   500
            Smalltalk systemPath addLast:'/fee/foe/foo'.
4001
fa75465bd263 made systemPath setup OS-specific
Claus Gittinger <cg@exept.de>
parents: 3991
diff changeset
   501
fa75465bd263 made systemPath setup OS-specific
Claus Gittinger <cg@exept.de>
parents: 3991
diff changeset
   502
     However, smalltalk.rc itself must be found along the above path.
617
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
   503
    "
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
   504
2928
39c23e287c81 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2912
diff changeset
   505
    ChangeFileName := 'changes'.
39c23e287c81 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2912
diff changeset
   506
    OperatingSystem isVMSlike ifTrue:[
23433
247788b989f6 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23419
diff changeset
   507
        BitmapDirName := 'bitmaps.dir'.
247788b989f6 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23419
diff changeset
   508
        BinaryDirName := 'binary.dir'.
247788b989f6 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23419
diff changeset
   509
        SourceDirName := 'source.dir'.
247788b989f6 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23419
diff changeset
   510
        ResourceDirName := 'resources.dir'.
247788b989f6 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23419
diff changeset
   511
        FileInDirName := 'filein.dir'.
247788b989f6 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23419
diff changeset
   512
        PackageDirName := 'packages.dir'.
2928
39c23e287c81 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2912
diff changeset
   513
    ] ifFalse:[
23433
247788b989f6 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23419
diff changeset
   514
        BitmapDirName := 'bitmaps'.
247788b989f6 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23419
diff changeset
   515
        BinaryDirName := 'binary'.
247788b989f6 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23419
diff changeset
   516
        SourceDirName := 'source'.
23450
704f8e20673d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23449
diff changeset
   517
        "/ ResourceDirName := 'resources'.
23433
247788b989f6 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23419
diff changeset
   518
        ResourceDirName := '.resources'.
247788b989f6 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23419
diff changeset
   519
        FileInDirName := 'fileIn'.
247788b989f6 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23419
diff changeset
   520
        PackageDirName := 'packages'.
23450
704f8e20673d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23449
diff changeset
   521
        OperatingSystem isOSXlike ifTrue:[
704f8e20673d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23449
diff changeset
   522
            PackageDirName := 'Packages'.
23470
bd1dde092c48 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23467
diff changeset
   523
            ResourceDirName := '../Resources'.
23450
704f8e20673d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23449
diff changeset
   524
        ].
23462
3936518a03ef #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23450
diff changeset
   525
        OperatingSystem isMSWINDOWSlike ifTrue:[
3936518a03ef #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23450
diff changeset
   526
            ResourceDirName := 'resources'.
3936518a03ef #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23450
diff changeset
   527
        ].
16234
ea850c2ab6bc class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 16211
diff changeset
   528
    ].
ea850c2ab6bc class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 16211
diff changeset
   529
ea850c2ab6bc class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 16211
diff changeset
   530
    SystemPath isEmptyOrNil ifTrue:[
23433
247788b989f6 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23419
diff changeset
   531
        SystemPath := OperatingSystem defaultSystemPath.
247788b989f6 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23419
diff changeset
   532
        self flushPathCaches
16234
ea850c2ab6bc class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 16211
diff changeset
   533
    ].
ea850c2ab6bc class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 16211
diff changeset
   534
ea850c2ab6bc class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 16211
diff changeset
   535
    PackagePath isEmptyOrNil ifTrue:[
23433
247788b989f6 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23419
diff changeset
   536
        PackagePath := OperatingSystem defaultPackagePath.
18868
0856cde0eaa4 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18794
diff changeset
   537
    ].
0856cde0eaa4 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18794
diff changeset
   538
    self addWorkspaceDirectoryToPackagePath.
20663
0c2ac3c3937e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 20640
diff changeset
   539
    self addIdeTopDirectoryToPackagePath.
617
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
   540
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
   541
    "
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
   542
     Smalltalk initSystemPath
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
   543
     Smalltalk systemPath
11679
69e588cca61f Do not use relative pathnames when searching for packages, etc.
Stefan Vogel <sv@exept.de>
parents: 11670
diff changeset
   544
20640
751b68301857 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 20615
diff changeset
   545
     SystemPath := nil.
751b68301857 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 20615
diff changeset
   546
     PackagePath := nil.
11679
69e588cca61f Do not use relative pathnames when searching for packages, etc.
Stefan Vogel <sv@exept.de>
parents: 11670
diff changeset
   547
     OperatingSystem defaultSystemPath
69e588cca61f Do not use relative pathnames when searching for packages, etc.
Stefan Vogel <sv@exept.de>
parents: 11670
diff changeset
   548
     OperatingSystem defaultPackagePath
617
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
   549
    "
5139
135e98726986 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 5138
diff changeset
   550
23462
3936518a03ef #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23450
diff changeset
   551
    "Modified: / 24-12-1999 / 00:23:35 / cg"
23470
bd1dde092c48 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23467
diff changeset
   552
    "Modified: / 25-10-2018 / 23:51:35 / Claus Gittinger"
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
   553
!
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
   554
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
   555
initUserPreferences
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
   556
    "setup other stuff"
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
   557
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
   558
    LogDoits := false.
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
   559
    LoadBinaries := false.
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
   560
    SaveEmergencyImage := (StandAlone ~~ true).
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
   561
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
   562
    "Modified: / 24.10.1997 / 18:22:47 / cg"
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
   563
!
617
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
   564
7526
97c36c93e3d9 *** empty log message ***
penk
parents: 7525
diff changeset
   565
initializeClass:aClass
97c36c93e3d9 *** empty log message ***
penk
parents: 7525
diff changeset
   566
    "sent from VM via #initializeModules"
97c36c93e3d9 *** empty log message ***
penk
parents: 7525
diff changeset
   567
7527
00be4f63fa1d *** empty log message ***
penk
parents: 7526
diff changeset
   568
    Error handle:[:ex |
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   569
	ObjectMemory printStackBacktrace.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   570
	ClassesFailedToInitialize isNil ifTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   571
	    ClassesFailedToInitialize := IdentitySet new.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   572
	].
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   573
	ClassesFailedToInitialize add:aClass.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   574
	('Smalltalk [warning]: error during initialize of ' , aClass name,': ', ex description printString) errorPrintCR.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   575
	ex suspendedContext fullPrintAll.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   576
	'------------------------------------------------' errorPrintCR.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   577
	(Debugging == true) ifTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   578
	    ex reject
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   579
	].
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
   580
    ] do:[
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   581
	aClass initialize
13675
b5730280715d changed: #initializeClass:
Claus Gittinger <cg@exept.de>
parents: 13621
diff changeset
   582
    ].
b5730280715d changed: #initializeClass:
Claus Gittinger <cg@exept.de>
parents: 13621
diff changeset
   583
b5730280715d changed: #initializeClass:
Claus Gittinger <cg@exept.de>
parents: 13621
diff changeset
   584
    "Modified: / 11-09-2011 / 17:01:32 / cg"
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
   585
!
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
   586
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
   587
initializeModules
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
   588
    "perform module specific initialization and
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
   589
     send #initialize to all classes.
16180
ddb5cec2ab0b class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16170
diff changeset
   590
     Notice: this is NOT called when an image is restarted"
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
   591
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
   592
    self initializeModulesOnce.
23773
a505a886fb49 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 23748
diff changeset
   593
    ClassesFailedToInitialize notEmptyOrNil ifTrue:[
a505a886fb49 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 23748
diff changeset
   594
        ('Smalltalk [info]: retry initialization of failed class(es)...') infoPrintCR.
a505a886fb49 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 23748
diff changeset
   595
        ClassesFailedToInitialize := nil.
a505a886fb49 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 23748
diff changeset
   596
        self initializeModulesOnce.
a505a886fb49 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 23748
diff changeset
   597
        ClassesFailedToInitialize notEmptyOrNil ifTrue:[
a505a886fb49 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 23748
diff changeset
   598
            ('Smalltalk [error]: class(es) persist to fail during initialize') errorPrintCR.
a505a886fb49 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 23748
diff changeset
   599
        ]
10122
697f05af913b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10118
diff changeset
   600
    ].
697f05af913b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10118
diff changeset
   601
697f05af913b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10118
diff changeset
   602
    ProjectDefinition initializeAllProjectDefinitions.
697f05af913b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10118
diff changeset
   603
697f05af913b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10118
diff changeset
   604
    "Modified: / 23-10-2006 / 16:40:39 / cg"
23773
a505a886fb49 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 23748
diff changeset
   605
    "Modified: / 22-02-2019 / 16:36:52 / Stefan Vogel"
7527
00be4f63fa1d *** empty log message ***
penk
parents: 7526
diff changeset
   606
!
00be4f63fa1d *** empty log message ***
penk
parents: 7526
diff changeset
   607
7563
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
   608
initializeModulesOnce
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
   609
    "perform module specific initialization and
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
   610
     send #initialize to all classes.
7527
00be4f63fa1d *** empty log message ***
penk
parents: 7526
diff changeset
   611
     Notice: this is not called when an image is restarted"
4963
308de981ea7d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4959
diff changeset
   612
617
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
   613
%{
18349
b5180d38c630 comments only
Claus Gittinger <cg@exept.de>
parents: 18329
diff changeset
   614
#ifdef __SCHTEAM__
b5180d38c630 comments only
Claus Gittinger <cg@exept.de>
parents: 18329
diff changeset
   615
    STClass.initializeAllClasses(__c__);
b5180d38c630 comments only
Claus Gittinger <cg@exept.de>
parents: 18329
diff changeset
   616
    return __c__._RETURN_self();
b5180d38c630 comments only
Claus Gittinger <cg@exept.de>
parents: 18329
diff changeset
   617
#else
1688
8a42db1eea60 removed all COMMA_CON / CON_COMMA uses
Claus Gittinger <cg@exept.de>
parents: 1682
diff changeset
   618
    __init_registered_modules__(3);
4963
308de981ea7d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4959
diff changeset
   619
1481
90a28fd060bc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1480
diff changeset
   620
    @global(DemoMode) = __getDemoMode() ? true : false;
5410
859c010edb47 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5406
diff changeset
   621
    RETURN (self);
18349
b5180d38c630 comments only
Claus Gittinger <cg@exept.de>
parents: 18329
diff changeset
   622
#endif /* not SCHTEAM */
5410
859c010edb47 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5406
diff changeset
   623
%}.
859c010edb47 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5406
diff changeset
   624
    ^ self primitiveFailed
617
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
   625
!
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
   626
7563
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
   627
initializeSystem
16655
14df7efaf339 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16642
diff changeset
   628
    "initialize all classes; setup dispatcher processes etc.
3499
5f8715a97ff5 switching to OS-subclasses
Claus Gittinger <cg@exept.de>
parents: 3492
diff changeset
   629
     This one is the very first entry into the smalltalk world,
16655
14df7efaf339 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16642
diff changeset
   630
     right after startup, usually immediately followed by Smalltalk>>start.
14df7efaf339 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16642
diff changeset
   631
     Here, a few specific initializations are done, then the actual initialization is
14df7efaf339 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16642
diff changeset
   632
     done inside an error handler in basicInitializeSystem.
10071
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
   633
     Notice:
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   634
	this is called by the VM's main entry. You will not find senders from Smalltalk.
18385
2d0a9c256e0e class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 18384
diff changeset
   635
     Also Notice:
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   636
	this is NOT called when an image is restarted;
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   637
	in this case the show starts in Smalltalk>>restart."
211
58bb873aa83c *** empty log message ***
claus
parents: 202
diff changeset
   638
19510
80255da5931a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19492
diff changeset
   639
    |idx shellArgs|
6841
37bc69fc9240 set StandAlone flag earlier (during initSystem);
Claus Gittinger <cg@exept.de>
parents: 6837
diff changeset
   640
12861
5086a864ae3e changed:
Claus Gittinger <cg@exept.de>
parents: 12813
diff changeset
   641
    NumberOfClassesHint := 10000.
8964
91b012315d91 Avoid rehashing of sets in #allClasses..
Stefan Vogel <sv@exept.de>
parents: 8960
diff changeset
   642
3499
5f8715a97ff5 switching to OS-subclasses
Claus Gittinger <cg@exept.de>
parents: 3492
diff changeset
   643
    Initializing := true.
5f8715a97ff5 switching to OS-subclasses
Claus Gittinger <cg@exept.de>
parents: 3492
diff changeset
   644
    AbstractOperatingSystem initializeConcreteClass.
5f8715a97ff5 switching to OS-subclasses
Claus Gittinger <cg@exept.de>
parents: 3492
diff changeset
   645
18307
c1d97d109f88 also care for empty cmd-line args (could be empty OrderedCollection)
Claus Gittinger <cg@exept.de>
parents: 18293
diff changeset
   646
    CommandLineArguments isEmptyOrNil ifTrue:[
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   647
	CommandLineArguments := #('stx') asOrderedCollection.
5400
af8fdc4d3e02 kludge (for rel5)
Claus Gittinger <cg@exept.de>
parents: 5373
diff changeset
   648
    ].
4006
c7ad38c52eb9 must set CommandLineArguments earlier (to be available in initializeSystem)
Claus Gittinger <cg@exept.de>
parents: 4001
diff changeset
   649
    CommandLine := CommandLineArguments copy.
c7ad38c52eb9 must set CommandLineArguments earlier (to be available in initializeSystem)
Claus Gittinger <cg@exept.de>
parents: 4001
diff changeset
   650
    CommandLineArguments := CommandLineArguments asOrderedCollection.
6842
a5110421e4ab more for standAlone start
Claus Gittinger <cg@exept.de>
parents: 6841
diff changeset
   651
    CommandName := CommandLineArguments removeFirst. "/ the command
4006
c7ad38c52eb9 must set CommandLineArguments earlier (to be available in initializeSystem)
Claus Gittinger <cg@exept.de>
parents: 4001
diff changeset
   652
21021
1f8d5bc2a53e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21020
diff changeset
   653
    SilentLoading := Silent := false.
1f8d5bc2a53e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21020
diff changeset
   654
    VerboseLoading := VerboseStartup := Verbose := false.
19427
cde32174b580 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19426
diff changeset
   655
    DebuggingStandAlone := Debugging := false.
19510
80255da5931a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19492
diff changeset
   656
80255da5931a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19492
diff changeset
   657
    "/ if no argument was given, look for an environment variable named
80255da5931a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19492
diff changeset
   658
    "/ STX_DEFAULT_ARGS. If set, take that.
80255da5931a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19492
diff changeset
   659
    "/ if any argument was given, unless a --noShellArgs argument is given,
80255da5931a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19492
diff changeset
   660
    "/ slice in the value from "STX_MORE_ARGS" at the beginning.
80255da5931a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19492
diff changeset
   661
    "/
80255da5931a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19492
diff changeset
   662
    "/ These allow for args like "--quick --infoPrint" to be automatically prepended
19511
96c72a572feb #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 19510
diff changeset
   663
    idx := CommandLineArguments indexOfAny:#('--noShellArgs' '--noshellargs').
19510
80255da5931a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19492
diff changeset
   664
    (idx ~~ 0) ifTrue:[
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   665
	CommandLineArguments removeIndex:idx.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   666
    ] ifFalse:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   667
	CommandLineArguments isEmpty ifTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   668
	    shellArgs := OperatingSystem getEnvironment:'STX_DEFAULT_ARGS'.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   669
	    shellArgs notEmptyOrNil ifTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   670
		shellArgs := shellArgs asCollectionOfWords.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   671
		CommandLineArguments addAll:shellArgs.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   672
	    ].
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   673
	] ifFalse:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   674
	    "/ prepend shell environment args from "STX_ARGS"
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   675
	    shellArgs := OperatingSystem getEnvironment:'STX_MORE_ARGS'.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   676
	    shellArgs notEmptyOrNil ifTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   677
		shellArgs := shellArgs asCollectionOfWords.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   678
		CommandLineArguments addAllFirst:shellArgs.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   679
	    ].
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   680
	].
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   681
    ].
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   682
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   683
    self initializeVerboseFlags.
14432
ac02f979ac12 debugging code removed
Claus Gittinger <cg@exept.de>
parents: 14431
diff changeset
   684
11057
a87e5e1574ca startup error handling
Claus Gittinger <cg@exept.de>
parents: 11054
diff changeset
   685
    Error handle:[:ex |
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   686
	StandAlone ifTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   687
	    DebuggingStandAlone ifFalse:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   688
		'Startup Error - use "--debug" command line argument for more info' errorPrintCR.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   689
		Smalltalk exit:1.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   690
	    ].
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   691
	    'Smalltalk [error]: Error during early initialization:' errorPrintCR.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   692
	    thisContext fullPrintAll.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   693
	].
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   694
	ex reject.
11057
a87e5e1574ca startup error handling
Claus Gittinger <cg@exept.de>
parents: 11054
diff changeset
   695
    ] do:[
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   696
	self basicInitializeSystem
14432
ac02f979ac12 debugging code removed
Claus Gittinger <cg@exept.de>
parents: 14431
diff changeset
   697
    ].
13091
bc840cd6f1ae --verboseLoading command line arg (shlib loading trace)
Claus Gittinger <cg@exept.de>
parents: 13061
diff changeset
   698
bc840cd6f1ae --verboseLoading command line arg (shlib loading trace)
Claus Gittinger <cg@exept.de>
parents: 13061
diff changeset
   699
    "Modified: / 12-10-2010 / 11:27:47 / cg"
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
   700
!
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
   701
18669
11586f97d3ec class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 18668
diff changeset
   702
initializeVerboseFlags
11586f97d3ec class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 18668
diff changeset
   703
    |idx|
11586f97d3ec class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 18668
diff changeset
   704
21021
1f8d5bc2a53e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21020
diff changeset
   705
    StandAlone ifTrue:[
23677
1543d88d416d #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23670
diff changeset
   706
        InfoPrinting := Verbose := false.
23628
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
   707
        ObjectMemory infoPrinting:false.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
   708
        IgnoreAssertions := true.
21021
1f8d5bc2a53e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21020
diff changeset
   709
    ] ifFalse:[
23628
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
   710
        IgnoreAssertions := false.
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   711
    ].
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
   712
19430
2e309bb80f95 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19429
diff changeset
   713
    (idx := CommandLineArguments indexOf:'--ignoreHalt') ~~ 0 ifTrue:[
23628
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
   714
        CommandLineArguments removeIndex:idx.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
   715
        IgnoreHalt := true.
19430
2e309bb80f95 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19429
diff changeset
   716
    ].
20855
4f5dd0743af3 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 20854
diff changeset
   717
    (idx := CommandLineArguments indexOf:'--noIgnoreHalt') ~~ 0 ifTrue:[
23628
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
   718
        CommandLineArguments removeIndex:idx.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
   719
        IgnoreHalt := false.
20855
4f5dd0743af3 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 20854
diff changeset
   720
    ].
4f5dd0743af3 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 20854
diff changeset
   721
    (idx := CommandLineArguments indexOf:'--ignoreAssert') ~~ 0 ifTrue:[
23628
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
   722
        CommandLineArguments removeIndex:idx.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
   723
        IgnoreAssertions := true.
20855
4f5dd0743af3 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 20854
diff changeset
   724
    ].
4f5dd0743af3 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 20854
diff changeset
   725
    (idx := CommandLineArguments indexOf:'--noIgnoreAssert') ~~ 0 ifTrue:[
23628
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
   726
        CommandLineArguments removeIndex:idx.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
   727
        IgnoreAssertions := false.
20855
4f5dd0743af3 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 20854
diff changeset
   728
    ].
22314
2c625b367211 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22241
diff changeset
   729
    (idx := CommandLineArguments indexOf:'--assert') ~~ 0 ifTrue:[
23628
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
   730
        CommandLineArguments removeIndex:idx.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
   731
        IgnoreAssertions := false.
22314
2c625b367211 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22241
diff changeset
   732
    ].
18669
11586f97d3ec class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 18668
diff changeset
   733
    (idx := CommandLineArguments indexOf:'--silentStartup') ~~ 0 ifTrue:[
23628
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
   734
        CommandLineArguments removeIndex:idx.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
   735
        SilentLoading := true.
18669
11586f97d3ec class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 18668
diff changeset
   736
    ].
11586f97d3ec class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 18668
diff changeset
   737
    (idx := CommandLineArguments indexOf:'--verboseLoading') ~~ 0 ifTrue:[
23628
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
   738
        CommandLineArguments removeIndex:idx.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
   739
        VerboseLoading := true.
18669
11586f97d3ec class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 18668
diff changeset
   740
    ].
11586f97d3ec class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 18668
diff changeset
   741
    (idx := CommandLineArguments indexOf:'--verboseStartup') ~~ 0 ifTrue:[
23628
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
   742
        CommandLineArguments removeIndex:idx.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
   743
        VerboseLoading := true.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
   744
        VerboseStartup := true.
18669
11586f97d3ec class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 18668
diff changeset
   745
    ].
20855
4f5dd0743af3 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 20854
diff changeset
   746
4f5dd0743af3 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 20854
diff changeset
   747
    "/ reinterpret those, in case given after the VM options.
4f5dd0743af3 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 20854
diff changeset
   748
    (idx := CommandLineArguments indexOf:'--debugPrint') ~~ 0 ifTrue:[
23628
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
   749
        CommandLineArguments removeIndex:idx.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
   750
        ObjectMemory debugPrinting:true.
20855
4f5dd0743af3 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 20854
diff changeset
   751
    ].
4f5dd0743af3 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 20854
diff changeset
   752
    (idx := CommandLineArguments indexOf:'--infoPrint') ~~ 0 ifTrue:[
23628
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
   753
        CommandLineArguments removeIndex:idx.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
   754
        ObjectMemory infoPrinting:true.
23679
3f4a3d56ed3e #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23678
diff changeset
   755
        Object infoPrinting:true.
20855
4f5dd0743af3 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 20854
diff changeset
   756
    ].
4f5dd0743af3 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 20854
diff changeset
   757
18669
11586f97d3ec class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 18668
diff changeset
   758
    (idx := CommandLineArguments indexOf:'--verbose') ~~ 0 ifTrue:[
23679
3f4a3d56ed3e #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23678
diff changeset
   759
        StandAlone ifFalse:[ CommandLineArguments removeIndex:idx ].
23628
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
   760
        Object infoPrinting:true.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
   761
        Verbose := true.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
   762
        VerboseLoading := true.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
   763
        VerboseStartup := true.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
   764
        Logger notNil ifTrue:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
   765
            Logger loggingThreshold: Logger severityALL.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
   766
        ].
21020
55d520adcce5 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21019
diff changeset
   767
    ].
55d520adcce5 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21019
diff changeset
   768
55d520adcce5 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21019
diff changeset
   769
    Silent := false.
55d520adcce5 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21019
diff changeset
   770
    (idx := CommandLineArguments indexOf:'--silent') ~~ 0 ifTrue:[
23679
3f4a3d56ed3e #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23678
diff changeset
   771
        StandAlone ifFalse:[ CommandLineArguments removeIndex:idx ].
23628
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
   772
        Silent := SilentLoading := true.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
   773
        Object infoPrinting:false.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
   774
        ObjectMemory infoPrinting:false.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
   775
        ObjectMemory debugPrinting:false.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
   776
        Verbose := VerboseLoading := VerboseStartup := false.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
   777
        Logger notNil ifTrue:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
   778
            Logger loggingThreshold: Logger severityNONE
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
   779
        ].
18669
11586f97d3ec class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 18668
diff changeset
   780
    ].
21021
1f8d5bc2a53e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21020
diff changeset
   781
1f8d5bc2a53e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21020
diff changeset
   782
    idx := CommandLineArguments indexOf:'--debug'.
1f8d5bc2a53e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21020
diff changeset
   783
    Debugging := (idx ~~ 0).
1f8d5bc2a53e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21020
diff changeset
   784
1f8d5bc2a53e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21020
diff changeset
   785
    StandAlone ifTrue:[
23628
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
   786
        DebuggingStandAlone := Debugging.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
   787
        DebuggingStandAlone ifTrue:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
   788
            Inspector := MiniInspector.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
   789
            Debugger := MiniDebugger.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
   790
            IgnoreAssertions := false.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
   791
        ].
21021
1f8d5bc2a53e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21020
diff changeset
   792
    ] ifFalse:[
23628
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
   793
        "/
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
   794
        "/ define low-level debugging tools - graphical classes are not prepared yet
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
   795
        "/ to handle things.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
   796
        "/ This will bring us into the MiniDebugger when an error occurs during startup.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
   797
        "/
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
   798
        Inspector := MiniInspector.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
   799
        Debugger := MiniDebugger.
21021
1f8d5bc2a53e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21020
diff changeset
   800
    ].
22314
2c625b367211 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22241
diff changeset
   801
2c625b367211 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22241
diff changeset
   802
    "Modified: / 12-10-2017 / 17:48:11 / cg"
23679
3f4a3d56ed3e #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23678
diff changeset
   803
    "Modified: / 06-02-2019 / 21:15:30 / Claus Gittinger"
18669
11586f97d3ec class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 18668
diff changeset
   804
!
11586f97d3ec class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 18668
diff changeset
   805
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
   806
isInitialized
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
   807
    "this returns true, if the system is properly initialized;
16170
ca4d03def070 endOfDipatch if running scripts
Claus Gittinger <cg@exept.de>
parents: 16164
diff changeset
   808
     i.e. false during startup.
15980
83b70fa9bf0a class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15958
diff changeset
   809
     Especially, the whole display/viewing stuff and process escheduling
83b70fa9bf0a class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15958
diff changeset
   810
     is not working correctly until initialized."
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
   811
18251
9b7f8e531a16 isInitialized query during very early start
Claus Gittinger <cg@exept.de>
parents: 18248
diff changeset
   812
    Initializing isNil ifTrue:[^ false]. "/ if called very early
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
   813
    ^ Initializing not
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
   814
!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   815
7563
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
   816
reinitStandardStreams
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
   817
    "reinitialize some well-known streams.
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
   818
     Tis must be done very early during startup, to allow for
477
8710aba7876b oops - making id's real objects requires a store macro
Claus Gittinger <cg@exept.de>
parents: 457
diff changeset
   819
     debug and trace messages to be output
8710aba7876b oops - making id's real objects requires a store macro
Claus Gittinger <cg@exept.de>
parents: 457
diff changeset
   820
     (otherwise, the file-descriptors are invalid)"
8710aba7876b oops - making id's real objects requires a store macro
Claus Gittinger <cg@exept.de>
parents: 457
diff changeset
   821
8710aba7876b oops - making id's real objects requires a store macro
Claus Gittinger <cg@exept.de>
parents: 457
diff changeset
   822
    Stdout reOpen. Stderr reOpen. Stdin reOpen.
161
ed36169f354d *** empty log message ***
claus
parents: 159
diff changeset
   823
! !
ed36169f354d *** empty log message ***
claus
parents: 159
diff changeset
   824
16593
aa343f9d9918 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16582
diff changeset
   825
!Smalltalk class methodsFor:'Compatibility-GNU'!
aa343f9d9918 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16582
diff changeset
   826
aa343f9d9918 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16582
diff changeset
   827
system:command
aa343f9d9918 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16582
diff changeset
   828
    "GNU-Smalltalk compatibility: execute an OS command"
aa343f9d9918 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16582
diff changeset
   829
23714
bf5edd45306c #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23683
diff changeset
   830
    ^ OperatingSystem executeCommand:command
16593
aa343f9d9918 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16582
diff changeset
   831
aa343f9d9918 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16582
diff changeset
   832
    "
aa343f9d9918 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16582
diff changeset
   833
     Smalltalk system:'ls'
aa343f9d9918 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16582
diff changeset
   834
    "
23714
bf5edd45306c #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23683
diff changeset
   835
bf5edd45306c #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23683
diff changeset
   836
    "Modified: / 10-02-2019 / 22:49:39 / Claus Gittinger"
16593
aa343f9d9918 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16582
diff changeset
   837
! !
aa343f9d9918 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16582
diff changeset
   838
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
   839
!Smalltalk class methodsFor:'Compatibility-Squeak'!
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
   840
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
   841
beep
17343
ed954add0878 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17328
diff changeset
   842
    "output an audible beep or bell"
ed954add0878 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17328
diff changeset
   843
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
   844
    Screen current beep
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
   845
!
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
   846
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
   847
garbageCollect
15009
cd08c3e66a57 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 14987
diff changeset
   848
    "for Squeak compatibility"
cd08c3e66a57 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 14987
diff changeset
   849
cd08c3e66a57 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 14987
diff changeset
   850
    ObjectMemory garbageCollect
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
   851
!
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
   852
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
   853
garbageCollectMost
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
   854
    "collect recently created garbage; return the amount of freeSpace.
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
   855
     In ST/X, only the newSpace is collected here, and the sum of
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
   856
     newSpace + freeListSpace is returned."
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
   857
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
   858
    ObjectMemory scavenge.
15009
cd08c3e66a57 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 14987
diff changeset
   859
    ^ ObjectMemory freeSpace + (ObjectMemory newSpaceSize - ObjectMemory newSpaceUsed)
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
   860
!
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
   861
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
   862
isMorphic
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
   863
    ^ false
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
   864
!
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
   865
10844
348d03bba747 squeak compatibility
Claus Gittinger <cg@exept.de>
parents: 10738
diff changeset
   866
platformName
348d03bba747 squeak compatibility
Claus Gittinger <cg@exept.de>
parents: 10738
diff changeset
   867
    "not yet fully implemented (I have to figure out, what squeak returns in each case...)"
348d03bba747 squeak compatibility
Claus Gittinger <cg@exept.de>
parents: 10738
diff changeset
   868
348d03bba747 squeak compatibility
Claus Gittinger <cg@exept.de>
parents: 10738
diff changeset
   869
    ^ OperatingSystem platformName asUppercaseFirst
348d03bba747 squeak compatibility
Claus Gittinger <cg@exept.de>
parents: 10738
diff changeset
   870
348d03bba747 squeak compatibility
Claus Gittinger <cg@exept.de>
parents: 10738
diff changeset
   871
    "
348d03bba747 squeak compatibility
Claus Gittinger <cg@exept.de>
parents: 10738
diff changeset
   872
     Smalltalk platformName -> 'Win32'
348d03bba747 squeak compatibility
Claus Gittinger <cg@exept.de>
parents: 10738
diff changeset
   873
    "
348d03bba747 squeak compatibility
Claus Gittinger <cg@exept.de>
parents: 10738
diff changeset
   874
!
348d03bba747 squeak compatibility
Claus Gittinger <cg@exept.de>
parents: 10738
diff changeset
   875
12358
686986c54ccc added: #removeClassNamed:
Claus Gittinger <cg@exept.de>
parents: 12352
diff changeset
   876
removeClassNamed: aName
17576
2d611305d7e6 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17548
diff changeset
   877
    "Invoked from fileouts: if there is currently a class in the system named aName, then remove it.
2d611305d7e6 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17548
diff changeset
   878
     Also needed by the refactory browser.
2d611305d7e6 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17548
diff changeset
   879
     If anything untoward happens, report it in the Transcript."
12358
686986c54ccc added: #removeClassNamed:
Claus Gittinger <cg@exept.de>
parents: 12352
diff changeset
   880
686986c54ccc added: #removeClassNamed:
Claus Gittinger <cg@exept.de>
parents: 12352
diff changeset
   881
    | oldClass |
686986c54ccc added: #removeClassNamed:
Claus Gittinger <cg@exept.de>
parents: 12352
diff changeset
   882
686986c54ccc added: #removeClassNamed:
Claus Gittinger <cg@exept.de>
parents: 12352
diff changeset
   883
    (oldClass := self at: aName asSymbol ifAbsent: [nil]) isNil ifTrue:[
24414
e8fbf21c73b9 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24405
diff changeset
   884
        Transcript showCR:'Removal of class named %1 ignored because it does not exist.' with:aName.
e8fbf21c73b9 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24405
diff changeset
   885
        ^ self
12358
686986c54ccc added: #removeClassNamed:
Claus Gittinger <cg@exept.de>
parents: 12352
diff changeset
   886
    ].
686986c54ccc added: #removeClassNamed:
Claus Gittinger <cg@exept.de>
parents: 12352
diff changeset
   887
    oldClass removeFromSystem
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
   888
! !
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
   889
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
   890
!Smalltalk class methodsFor:'Compatibility-V''Age'!
6722
8388292bc41d allClassesImplementing & allMethodCategories
Claus Gittinger <cg@exept.de>
parents: 6715
diff changeset
   891
7563
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
   892
allClassesImplementing:aSelector
12304
b0dc1c58de1a changed: #allClassesImplementing:
Claus Gittinger <cg@exept.de>
parents: 12301
diff changeset
   893
    ^ self allClassesForWhich:[:cls | cls includesSelector:aSelector].
9506
93a214ce5997 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9496
diff changeset
   894
93a214ce5997 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9496
diff changeset
   895
    "Modified: / 10-08-2006 / 12:12:17 / cg"
9090
19cfbd910506 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9082
diff changeset
   896
!
19cfbd910506 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9082
diff changeset
   897
16459
447b9acb8163 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16269
diff changeset
   898
declareConstant:constantName poolName:poolNameArg value:value
447b9acb8163 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16269
diff changeset
   899
    "visualAge compatible pool variable declaration.
16562
Claus Gittinger <cg@exept.de>
parents: 16504
diff changeset
   900
     called when a V'age application is filed in
16459
447b9acb8163 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16269
diff changeset
   901
     (or one of its changes is accepted via the change browser)"
447b9acb8163 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16269
diff changeset
   902
447b9acb8163 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16269
diff changeset
   903
    |ns poolName pool|
447b9acb8163 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16269
diff changeset
   904
447b9acb8163 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16269
diff changeset
   905
    "/ when coming from the change-browser,
447b9acb8163 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16269
diff changeset
   906
    "/ a namespace override may be given...
447b9acb8163 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16269
diff changeset
   907
    ns := Class nameSpaceQuerySignal query.
447b9acb8163 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16269
diff changeset
   908
    (ns isNil or:[ns == Smalltalk]) ifTrue:[
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   909
	poolName := poolNameArg asSymbol
16459
447b9acb8163 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16269
diff changeset
   910
    ] ifFalse:[
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   911
	poolName := (ns name,'::',poolNameArg) asSymbol
16459
447b9acb8163 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16269
diff changeset
   912
    ].
9090
19cfbd910506 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9082
diff changeset
   913
    pool := self classNamed:poolName.
19cfbd910506 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9082
diff changeset
   914
    pool declareConstant:constantName value:value
19cfbd910506 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9082
diff changeset
   915
!
19cfbd910506 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9082
diff changeset
   916
16459
447b9acb8163 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16269
diff changeset
   917
declarePoolDictionary:poolDictionaryNameArg
447b9acb8163 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16269
diff changeset
   918
    "visualAge compatible pool declaration.
16562
Claus Gittinger <cg@exept.de>
parents: 16504
diff changeset
   919
     called when a V'age application is filed in
16459
447b9acb8163 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16269
diff changeset
   920
     (or one of its changes is accepted via the change browser)"
447b9acb8163 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16269
diff changeset
   921
447b9acb8163 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16269
diff changeset
   922
    |ns poolName|
447b9acb8163 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16269
diff changeset
   923
447b9acb8163 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16269
diff changeset
   924
    poolName := poolDictionaryNameArg asSymbol.
447b9acb8163 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16269
diff changeset
   925
447b9acb8163 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16269
diff changeset
   926
"/    "/ when coming from the change-browser,
447b9acb8163 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16269
diff changeset
   927
"/    "/ a namespace override may be given...
447b9acb8163 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16269
diff changeset
   928
"/    ns := Class nameSpaceQuerySignal query.
447b9acb8163 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16269
diff changeset
   929
"/    (ns isNil or:[ns == Smalltalk]) ifTrue:[
447b9acb8163 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16269
diff changeset
   930
"/        poolName := poolDictionaryNameArg asSymbol
447b9acb8163 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16269
diff changeset
   931
"/    ] ifFalse:[
447b9acb8163 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16269
diff changeset
   932
"/        poolName := (ns name,'::',poolDictionaryNameArg) asSymbol
447b9acb8163 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16269
diff changeset
   933
"/    ].
447b9acb8163 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16269
diff changeset
   934
    ^ SharedPool subclass:(poolName asSymbol)
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   935
	instanceVariableNames:''
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   936
	classVariableNames:''
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   937
	poolDictionaries:''
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   938
	category:'* VAST Pools'
13998
890d42903662 added: #declareVariable:poolName:
Claus Gittinger <cg@exept.de>
parents: 13958
diff changeset
   939
890d42903662 added: #declareVariable:poolName:
Claus Gittinger <cg@exept.de>
parents: 13958
diff changeset
   940
    "Modified: / 07-02-2012 / 15:56:16 / cg"
890d42903662 added: #declareVariable:poolName:
Claus Gittinger <cg@exept.de>
parents: 13958
diff changeset
   941
!
890d42903662 added: #declareVariable:poolName:
Claus Gittinger <cg@exept.de>
parents: 13958
diff changeset
   942
16459
447b9acb8163 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16269
diff changeset
   943
declareVariable:varName poolName:poolNameArg
447b9acb8163 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16269
diff changeset
   944
    "visualAge compatible pool declaration.
16562
Claus Gittinger <cg@exept.de>
parents: 16504
diff changeset
   945
     called when a V'age application is filed in
16459
447b9acb8163 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16269
diff changeset
   946
     (or one of its changes is accepted via the change browser)"
447b9acb8163 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16269
diff changeset
   947
447b9acb8163 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16269
diff changeset
   948
    |ns poolName pool|
447b9acb8163 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16269
diff changeset
   949
447b9acb8163 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16269
diff changeset
   950
    "/ when coming from the change-browser,
447b9acb8163 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16269
diff changeset
   951
    "/ a namespace override may be given...
447b9acb8163 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16269
diff changeset
   952
    ns := Class nameSpaceQuerySignal query.
447b9acb8163 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16269
diff changeset
   953
    (ns isNil or:[ns == Smalltalk]) ifTrue:[
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   954
	poolName := poolNameArg asSymbol
16459
447b9acb8163 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16269
diff changeset
   955
    ] ifFalse:[
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   956
	poolName := (ns name,'::',poolNameArg) asSymbol
16459
447b9acb8163 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16269
diff changeset
   957
    ].
13998
890d42903662 added: #declareVariable:poolName:
Claus Gittinger <cg@exept.de>
parents: 13958
diff changeset
   958
    pool := self classNamed:poolName.
890d42903662 added: #declareVariable:poolName:
Claus Gittinger <cg@exept.de>
parents: 13958
diff changeset
   959
    pool declareVariable:varName
890d42903662 added: #declareVariable:poolName:
Claus Gittinger <cg@exept.de>
parents: 13958
diff changeset
   960
890d42903662 added: #declareVariable:poolName:
Claus Gittinger <cg@exept.de>
parents: 13958
diff changeset
   961
    "Created: / 07-02-2012 / 15:57:05 / cg"
6722
8388292bc41d allClassesImplementing & allMethodCategories
Claus Gittinger <cg@exept.de>
parents: 6715
diff changeset
   962
! !
8388292bc41d allClassesImplementing & allMethodCategories
Claus Gittinger <cg@exept.de>
parents: 6715
diff changeset
   963
20755
8266a42d28e3 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20746
diff changeset
   964
!Smalltalk class methodsFor:'Compatibility-VW'!
6094
79ebf84b51bd first attempt in supporting vw5.4 definitions
Claus Gittinger <cg@exept.de>
parents: 6080
diff changeset
   965
13323
68e5bb82f5f7 changed: #loadPackage:fromClassLibrary:
Stefan Vogel <sv@exept.de>
parents: 13303
diff changeset
   966
defineClass:nameSymbol superclass:superclass indexedType:indexed private:private instanceVariableNames:instVars classInstanceVariableNames:classInstVars imports:imports category:category
68e5bb82f5f7 changed: #loadPackage:fromClassLibrary:
Stefan Vogel <sv@exept.de>
parents: 13303
diff changeset
   967
    ^ self
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   968
	defineClass:nameSymbol
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   969
	superclass:superclass
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   970
	indexedType:indexed
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   971
	private:private
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   972
	instanceVariableNames:instVars
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   973
	classInstanceVariableNames:classInstVars
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   974
	imports:imports
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   975
	category:category
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
   976
	attributes:nil
12033
Claus Gittinger <cg@exept.de>
parents: 12023
diff changeset
   977
!
Claus Gittinger <cg@exept.de>
parents: 12023
diff changeset
   978
7563
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
   979
defineClass:nameSymbol superclass:superclass indexedType:indexed private:private instanceVariableNames:instVars classInstanceVariableNames:classInstVars imports:imports category:category attributes:annotations
6094
79ebf84b51bd first attempt in supporting vw5.4 definitions
Claus Gittinger <cg@exept.de>
parents: 6080
diff changeset
   980
    |newClass|
79ebf84b51bd first attempt in supporting vw5.4 definitions
Claus Gittinger <cg@exept.de>
parents: 6080
diff changeset
   981
79ebf84b51bd first attempt in supporting vw5.4 definitions
Claus Gittinger <cg@exept.de>
parents: 6080
diff changeset
   982
    indexed == #none ifTrue:[
23789
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
   983
        newClass := superclass
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
   984
            subclass:nameSymbol
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
   985
            instanceVariableNames:instVars
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
   986
            classVariableNames:''
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
   987
            poolDictionaries:''
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
   988
            category:category
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
   989
            inEnvironment:self.
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
   990
        classInstVars size ~~ 0 ifTrue:[
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
   991
            newClass class instanceVariableNames:classInstVars.
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
   992
        ].
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
   993
        ^ newClass
6851
91662dfb3e80 Remove debug print.
Stefan Vogel <sv@exept.de>
parents: 6849
diff changeset
   994
    ].
91662dfb3e80 Remove debug print.
Stefan Vogel <sv@exept.de>
parents: 6849
diff changeset
   995
    self shouldImplement.
23789
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
   996
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
   997
    "Modified: / 01-03-2019 / 16:11:54 / Claus Gittinger"
12033
Claus Gittinger <cg@exept.de>
parents: 12023
diff changeset
   998
!
Claus Gittinger <cg@exept.de>
parents: 12023
diff changeset
   999
Claus Gittinger <cg@exept.de>
parents: 12023
diff changeset
  1000
defineNameSpace:nameSymbol private:private imports:imports category:category
Claus Gittinger <cg@exept.de>
parents: 12023
diff changeset
  1001
    |newNameSpace|
Claus Gittinger <cg@exept.de>
parents: 12023
diff changeset
  1002
Claus Gittinger <cg@exept.de>
parents: 12023
diff changeset
  1003
    private ifTrue:[self halt].     "/ what to do ?
Claus Gittinger <cg@exept.de>
parents: 12023
diff changeset
  1004
    imports withoutSeparators notEmpty ifTrue:[self halt].     "/ what to do ?
Claus Gittinger <cg@exept.de>
parents: 12023
diff changeset
  1005
    newNameSpace := NameSpace name:nameSymbol.
13323
68e5bb82f5f7 changed: #loadPackage:fromClassLibrary:
Stefan Vogel <sv@exept.de>
parents: 13303
diff changeset
  1006
    newNameSpace setCategory:category.
12033
Claus Gittinger <cg@exept.de>
parents: 12023
diff changeset
  1007
    ^ newNameSpace
20755
8266a42d28e3 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20746
diff changeset
  1008
!
8266a42d28e3 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20746
diff changeset
  1009
8266a42d28e3 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20746
diff changeset
  1010
dialectName
8266a42d28e3 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20746
diff changeset
  1011
    ^ #SmalltalkX
8266a42d28e3 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20746
diff changeset
  1012
8266a42d28e3 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20746
diff changeset
  1013
    "
8266a42d28e3 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20746
diff changeset
  1014
     Smalltalk dialectName
8266a42d28e3 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20746
diff changeset
  1015
    "
8266a42d28e3 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20746
diff changeset
  1016
!
8266a42d28e3 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20746
diff changeset
  1017
8266a42d28e3 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20746
diff changeset
  1018
dialectReleaseVersion
8266a42d28e3 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20746
diff changeset
  1019
    ^ self versionString
8266a42d28e3 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20746
diff changeset
  1020
8266a42d28e3 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20746
diff changeset
  1021
    "
8266a42d28e3 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20746
diff changeset
  1022
     Smalltalk dialectReleaseVersion
8266a42d28e3 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20746
diff changeset
  1023
    "
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1024
! !
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1025
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1026
!Smalltalk class methodsFor:'accessing'!
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1027
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1028
associationAt:aKey
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1029
    "return a key-value association for aKey.
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1030
     Since ST/X's Smalltalk as no real dictionary, this is
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1031
     simulated here."
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1032
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1033
    |val|
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1034
20161
64cc230c5a10 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 20122
diff changeset
  1035
    val := self at:aKey ifAbsent:[^ nil].
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1036
    ^ Association key:aKey value:val
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1037
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1038
    "Created: / 1.11.1997 / 13:27:20 / cg"
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1039
!
3083
451912c492ae checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3062
diff changeset
  1040
7563
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  1041
associationAt:aKey ifAbsent:exceptionBlock
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  1042
    "return a key-value association for aKey, or the value
3610
12f32c1fe72b added #associationAt:ifAbsent: for ST80 compatibility.
Claus Gittinger <cg@exept.de>
parents: 3565
diff changeset
  1043
     from exceptionBlock, if no such key is present.
14973
086ef2bb2007 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 14933
diff changeset
  1044
     Since ST/X's Smalltalk as no real dictionary, this is simulated here.
20161
64cc230c5a10 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 20122
diff changeset
  1045
     Warning: this is a compatibility interface only, with a different semantic as
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1046
	      the original ST80 implementation. The returned assoc is created on the fly,
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1047
	      and not the one stored in the receiver (there are not assocs there)"
3610
12f32c1fe72b added #associationAt:ifAbsent: for ST80 compatibility.
Claus Gittinger <cg@exept.de>
parents: 3565
diff changeset
  1048
12f32c1fe72b added #associationAt:ifAbsent: for ST80 compatibility.
Claus Gittinger <cg@exept.de>
parents: 3565
diff changeset
  1049
    |val|
12f32c1fe72b added #associationAt:ifAbsent: for ST80 compatibility.
Claus Gittinger <cg@exept.de>
parents: 3565
diff changeset
  1050
20161
64cc230c5a10 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 20122
diff changeset
  1051
    val := self at:aKey ifAbsent:[^ exceptionBlock value].
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1052
    ^ Association key:aKey value:val
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1053
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1054
    "Created: / 18.6.1998 / 17:05:24 / cg"
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1055
!
3610
12f32c1fe72b added #associationAt:ifAbsent: for ST80 compatibility.
Claus Gittinger <cg@exept.de>
parents: 3565
diff changeset
  1056
7563
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  1057
at:aKey
10071
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
  1058
    "retrieve the value stored under aKey, a symbol.
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
  1059
     Return nil if not present
1956
4eed0b627d52 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1955
diff changeset
  1060
     (this will be changed to trigger an error - better use #at:ifAbsent:)"
453
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1061
16831
596e07380f6f class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16803
diff changeset
  1062
    aKey class == Symbol ifFalse:[self error:'expected symbol'].
6080
15ea3cbf6003 renamed: #allSelectorsAndMethodsDo: into: #instAndClassSelectorsAndMethodsDo:
Claus Gittinger <cg@exept.de>
parents: 6074
diff changeset
  1063
453
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1064
%{  /* NOCONTEXT */
18287
ec8170701a7e steam code
Claus Gittinger <cg@exept.de>
parents: 18283
diff changeset
  1065
#ifdef __SCHTEAM__
ec8170701a7e steam code
Claus Gittinger <cg@exept.de>
parents: 18283
diff changeset
  1066
    {
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  1067
	STSymbol keySymbol = aKey.asSTSymbol();
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  1068
	STObject val = STSmalltalkEnvironment.GetResolvedBindingOrNull(keySymbol);
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  1069
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  1070
	return context._RETURN( val == null ? Nil : val );
18287
ec8170701a7e steam code
Claus Gittinger <cg@exept.de>
parents: 18283
diff changeset
  1071
    }
ec8170701a7e steam code
Claus Gittinger <cg@exept.de>
parents: 18283
diff changeset
  1072
    /* NOT REACHED */
ec8170701a7e steam code
Claus Gittinger <cg@exept.de>
parents: 18283
diff changeset
  1073
#else
453
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1074
    RETURN ( __GLOBAL_GET(aKey) );
18287
ec8170701a7e steam code
Claus Gittinger <cg@exept.de>
parents: 18283
diff changeset
  1075
#endif
5406
4a6995b61c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5400
diff changeset
  1076
%}.
5410
859c010edb47 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5406
diff changeset
  1077
    ^ self primitiveFailed
453
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1078
!
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1079
7563
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  1080
at:aKey ifAbsent:aBlock
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  1081
    "retrieve the value stored at aKey.
7565
cd76db5ee5cd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7564
diff changeset
  1082
     If there is nothing stored under this key, return the value of
cd76db5ee5cd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7564
diff changeset
  1083
     the evaluation of aBlock."
453
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1084
20161
64cc230c5a10 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 20122
diff changeset
  1085
    |val|
64cc230c5a10 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 20122
diff changeset
  1086
64cc230c5a10 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 20122
diff changeset
  1087
    val := self at:aKey.
64cc230c5a10 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 20122
diff changeset
  1088
    (val notNil or:[self includesKey:aKey]) ifTrue:[
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1089
	^ val
453
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1090
    ].
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1091
    ^ aBlock value
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1092
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1093
    "
20161
64cc230c5a10 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 20122
diff changeset
  1094
     Smalltalk removeKey:#fooBar.
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1095
     Smalltalk at:#fooBar                       <- returns nil
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1096
     Smalltalk at:#fooBar ifAbsent:['sorry']    <- no error
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1097
    "
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1098
!
453
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1099
15068
e9075c481268 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15009
diff changeset
  1100
at:aKey ifAbsentPut:aBlock
e9075c481268 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15009
diff changeset
  1101
    "return the element indexed by aKey if present,
e9075c481268 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15009
diff changeset
  1102
     if not present, store the result of evaluating valueBlock
e9075c481268 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15009
diff changeset
  1103
     under aKey and return it."
e9075c481268 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15009
diff changeset
  1104
e9075c481268 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15009
diff changeset
  1105
    ^ self at:aKey ifAbsent:[ self at:aKey put:aBlock value ].
e9075c481268 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15009
diff changeset
  1106
e9075c481268 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15009
diff changeset
  1107
    "Created: / 29-05-2007 / 12:41:12 / cg"
e9075c481268 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15009
diff changeset
  1108
!
e9075c481268 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15009
diff changeset
  1109
7563
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  1110
at:aKey ifPresent:aBlock
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  1111
    "try to retrieve the value stored at aKey.
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  1112
     If there is nothing stored under this key, do nothing.
4870
3f6a8c368925 added #at:ifPresent:
Claus Gittinger <cg@exept.de>
parents: 4846
diff changeset
  1113
     Otherwise, evaluate aBlock, passing the retrieved value as argument."
3f6a8c368925 added #at:ifPresent:
Claus Gittinger <cg@exept.de>
parents: 4846
diff changeset
  1114
13883
73d2c22a5438 changed: #at:ifPresent:
Claus Gittinger <cg@exept.de>
parents: 13851
diff changeset
  1115
    |val|
73d2c22a5438 changed: #at:ifPresent:
Claus Gittinger <cg@exept.de>
parents: 13851
diff changeset
  1116
20161
64cc230c5a10 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 20122
diff changeset
  1117
    val := self at:aKey.
64cc230c5a10 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 20122
diff changeset
  1118
    (val notNil or:[self includesKey:aKey]) ifTrue:[
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1119
	^ aBlock value:val.
4870
3f6a8c368925 added #at:ifPresent:
Claus Gittinger <cg@exept.de>
parents: 4846
diff changeset
  1120
    ].
3f6a8c368925 added #at:ifPresent:
Claus Gittinger <cg@exept.de>
parents: 4846
diff changeset
  1121
    ^ nil
3f6a8c368925 added #at:ifPresent:
Claus Gittinger <cg@exept.de>
parents: 4846
diff changeset
  1122
3f6a8c368925 added #at:ifPresent:
Claus Gittinger <cg@exept.de>
parents: 4846
diff changeset
  1123
    "
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1124
     Smalltalk at:#fooBar ifPresent:[:what | Transcript showCR:what].
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1125
     Smalltalk at:#Object ifPresent:[:what | Transcript showCR:what].
20161
64cc230c5a10 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 20122
diff changeset
  1126
64cc230c5a10 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 20122
diff changeset
  1127
     Smalltalk at:#fooBar put:nil.
64cc230c5a10 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 20122
diff changeset
  1128
     Smalltalk at:#fooBar ifPresent:[:what | Transcript showCR:what].
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1129
    "
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1130
13883
73d2c22a5438 changed: #at:ifPresent:
Claus Gittinger <cg@exept.de>
parents: 13851
diff changeset
  1131
    "Modified: / 27-12-2011 / 10:14:30 / cg"
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1132
!
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1133
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1134
at:aKey put:aValue
7563
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  1135
    "store the argument aValue under aKey, a symbol.
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  1136
     Return aValue (sigh)."
453
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1137
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1138
    |oldValue|
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
%{
18287
ec8170701a7e steam code
Claus Gittinger <cg@exept.de>
parents: 18283
diff changeset
  1141
#ifdef __SCHTEAM__
ec8170701a7e steam code
Claus Gittinger <cg@exept.de>
parents: 18283
diff changeset
  1142
    {
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  1143
	STSymbol keySymbol = aKey.asSTSymbol();
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  1144
	oldValue = STSmalltalkEnvironment.SetBinding(keySymbol, aValue);
18287
ec8170701a7e steam code
Claus Gittinger <cg@exept.de>
parents: 18283
diff changeset
  1145
    }
ec8170701a7e steam code
Claus Gittinger <cg@exept.de>
parents: 18283
diff changeset
  1146
#else
453
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1147
    oldValue = __GLOBAL_SET(aKey, aValue, (OBJ *)0);
18287
ec8170701a7e steam code
Claus Gittinger <cg@exept.de>
parents: 18283
diff changeset
  1148
#endif
453
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
    CachedClasses notNil ifTrue:[
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  1151
	oldValue isBehavior ifTrue:[
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  1152
	    oldValue name == aKey ifTrue:[
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  1153
		CachedClasses remove:oldValue ifAbsent:[]
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  1154
	    ]
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  1155
	].
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  1156
	aValue isBehavior ifTrue:[
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  1157
	    aValue name == aKey ifTrue:[
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  1158
		CachedClasses add:aValue
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  1159
	    ] ifFalse:[
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  1160
		CachedClasses := nil
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  1161
	    ]
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  1162
	].
453
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1163
    ].
745
d16f199a1551 added imageStart & restart timestamps
Claus Gittinger <cg@exept.de>
parents: 736
diff changeset
  1164
    ^ aValue.
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1165
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1166
    "Modified: 19.4.1996 / 11:31:49 / cg"
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1167
!
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1168
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1169
includesKey:aKey
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1170
    "return true, if the key is known"
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1171
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1172
    "/ for debugging - this is a common mistake,
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1173
    "/ to try to access a class by nameString, instead
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1174
    "/ of by symbol.
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1175
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1176
    "/ aKey class == String ifTrue:[self halt].
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1177
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1178
%{  /* NOCONTEXT */
18287
ec8170701a7e steam code
Claus Gittinger <cg@exept.de>
parents: 18283
diff changeset
  1179
#ifdef __SCHTEAM__
ec8170701a7e steam code
Claus Gittinger <cg@exept.de>
parents: 18283
diff changeset
  1180
    STSymbol keySymbol = aKey.asSTSymbol();
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  1181
    return __c__._RETURN( STSmalltalkEnvironment.HasBinding(keySymbol) ? STObject.True : STObject.False);
18287
ec8170701a7e steam code
Claus Gittinger <cg@exept.de>
parents: 18283
diff changeset
  1182
    /* NOT REACHED */
ec8170701a7e steam code
Claus Gittinger <cg@exept.de>
parents: 18283
diff changeset
  1183
#else
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1184
    RETURN ( __GLOBAL_KEYKNOWN(aKey) );
18287
ec8170701a7e steam code
Claus Gittinger <cg@exept.de>
parents: 18283
diff changeset
  1185
#endif
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1186
%}.
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1187
    ^ self primitiveFailed
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1188
!
453
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1189
7563
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  1190
keyAtValue:anObject
21365
730217a3920c #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 21363
diff changeset
  1191
    "return the symbol under which anObject is stored - or nil.
730217a3920c #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 21363
diff changeset
  1192
     This is a slow access, since the receiver is searched sequentially.
730217a3920c #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 21363
diff changeset
  1193
     NOTICE:
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1194
	The value is searched using identity compare"
453
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1195
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1196
    self keysDo:[:aKey |
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1197
	(self at:aKey) == anObject ifTrue:[^ aKey]
453
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1198
    ].
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1199
    ^ nil
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1200
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1201
    "Smalltalk keyAtValue:Object"
21365
730217a3920c #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 21363
diff changeset
  1202
730217a3920c #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 21363
diff changeset
  1203
    "Modified (comment): / 07-02-2017 / 11:06:21 / cg"
453
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1204
!
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1205
21363
dbd8602f07b1 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21338
diff changeset
  1206
keyAtValue:anObject ifAbsent:exceptionValue
21365
730217a3920c #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 21363
diff changeset
  1207
    "return the symbol under which anObject is stored - or the value from exceptionValue.
730217a3920c #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 21363
diff changeset
  1208
     This is a slow access, since the receiver is searched sequentially.
730217a3920c #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 21363
diff changeset
  1209
     NOTICE:
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1210
	The value is searched using identity compare"
21363
dbd8602f07b1 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21338
diff changeset
  1211
dbd8602f07b1 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21338
diff changeset
  1212
    self keysDo:[:aKey |
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1213
	(self at:aKey) == anObject ifTrue:[^ aKey]
21363
dbd8602f07b1 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21338
diff changeset
  1214
    ].
dbd8602f07b1 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21338
diff changeset
  1215
    ^ exceptionValue value
dbd8602f07b1 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21338
diff changeset
  1216
dbd8602f07b1 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21338
diff changeset
  1217
    "
dbd8602f07b1 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21338
diff changeset
  1218
     Smalltalk keyAtValue:Object ifAbsent:#foo
dbd8602f07b1 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21338
diff changeset
  1219
     Smalltalk keyAtValue:1234 ifAbsent:#foo
dbd8602f07b1 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21338
diff changeset
  1220
    "
dbd8602f07b1 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21338
diff changeset
  1221
dbd8602f07b1 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21338
diff changeset
  1222
    "Created: / 07-02-2017 / 10:58:51 / cg"
dbd8602f07b1 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21338
diff changeset
  1223
!
dbd8602f07b1 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21338
diff changeset
  1224
7563
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  1225
keys
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  1226
    "return a collection with all keys in the Smalltalk dictionary"
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  1227
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  1228
    |keys|
453
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1229
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1230
    keys := IdentitySet new.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1231
    self keysDo:[:k | keys add:k].
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1232
    ^ keys
617
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  1233
!
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  1234
7563
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  1235
removeKey:aKey
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  1236
    "remove the association stored under the key-argument from the globals dictionary.
10071
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
  1237
     WARNING:
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  1238
	this is somewhat dangerous: conceptionally, the association is removed,
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  1239
	to which machine & byte compiled code refers if it accesses a global.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  1240
	If there are still global accesses in some literalArray or from machine-compiled code,
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  1241
	it continues to reference the globals value via that obsolete association and gets a nil
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  1242
	value.  (which is correct)
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  1243
	However, if that global is later reintroduced, a new association will be created and
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  1244
	the new global now referenced via the new association.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  1245
	The old accesses will still see nil, although the globals value is actually non-nil
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  1246
	(this is questionable).
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  1247
	To avoid this problem, the #removeClass: method never removed the key."
617
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  1248
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  1249
    CachedClasses := nil.
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  1250
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1251
%{  /* NOCONTEXT */
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1252
    RETURN ( __GLOBAL_REMOVE(aKey) );
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1253
%}.
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1254
    ^ self primitiveFailed
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1255
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1256
!
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1257
10538
7db2e140567f #startBlocks
Stefan Vogel <sv@exept.de>
parents: 10471
diff changeset
  1258
startBlocks
7db2e140567f #startBlocks
Stefan Vogel <sv@exept.de>
parents: 10471
diff changeset
  1259
    ^ StartBlocks
7db2e140567f #startBlocks
Stefan Vogel <sv@exept.de>
parents: 10471
diff changeset
  1260
!
7db2e140567f #startBlocks
Stefan Vogel <sv@exept.de>
parents: 10471
diff changeset
  1261
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1262
values
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1263
    "return a collection with all values in the Smalltalk dictionary"
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1264
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1265
    |values|
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1266
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1267
    values := OrderedCollection new.
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1268
    self do:[:v | values add:v].
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1269
    ^ values
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1270
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1271
    "Created: 20.6.1997 / 16:58:28 / cg"
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1272
! !
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1273
13540
37ff6f12f224 changed: #start
Claus Gittinger <cg@exept.de>
parents: 13539
diff changeset
  1274
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1275
!Smalltalk class methodsFor:'browsing'!
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1276
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1277
browseAllCallsOn:aSelectorSymbol
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1278
    "{ Pragma: +optSpace }"
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1279
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1280
    "startup a browser for all methods sending a particular message"
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1281
22241
65d1ed21a2a3 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 22147
diff changeset
  1282
    SystemBrowser default browseAllCallsOn:aSelectorSymbol
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1283
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1284
    "
10071
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
  1285
     Smalltalk browseAllCallsOn:#at:put:
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1286
    "
22241
65d1ed21a2a3 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 22147
diff changeset
  1287
65d1ed21a2a3 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 22147
diff changeset
  1288
    "Modified: / 01-09-2017 / 14:21:31 / cg"
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1289
!
617
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  1290
7563
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  1291
browseAllSelect:aBlock
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  1292
    "{ Pragma: +optSpace }"
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  1293
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  1294
    "startup a browser for all methods for which aBlock returns true"
617
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  1295
22241
65d1ed21a2a3 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 22147
diff changeset
  1296
    SystemBrowser default browseAllSelect:aBlock
617
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  1297
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  1298
    "
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  1299
     Smalltalk browseAllSelect:[:m | m literals isNil]
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  1300
    "
22241
65d1ed21a2a3 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 22147
diff changeset
  1301
65d1ed21a2a3 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 22147
diff changeset
  1302
    "Modified: / 01-09-2017 / 14:21:34 / cg"
617
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  1303
!
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  1304
7563
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  1305
browseChanges
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1306
    "{ Pragma: +optSpace }"
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1307
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1308
    "startup a changes browser"
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1309
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1310
    ChangesBrowser notNil ifTrue:[
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  1311
	ChangesBrowser open
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1312
    ] ifFalse:[
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  1313
	self warn:'no ChangesBrowser built in'
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1314
    ]
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1315
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1316
    "
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1317
     Smalltalk browseChanges
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1318
    "
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1319
!
453
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1320
7563
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  1321
browseClass:aClass
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  1322
    "{ Pragma: +optSpace }"
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  1323
11375
bcdaeec8353c splash support
Claus Gittinger <cg@exept.de>
parents: 11367
diff changeset
  1324
    "startup a browser on aClass.
11150
be60e4505904 comments
Claus Gittinger <cg@exept.de>
parents: 11108
diff changeset
  1325
     The broser will only show that class (i.e. be a singleClass-browser).
be60e4505904 comments
Claus Gittinger <cg@exept.de>
parents: 11108
diff changeset
  1326
     See browseInClass: for a full browser, which has aClass selected initially."
6970
ac358e651731 more browsing
Claus Gittinger <cg@exept.de>
parents: 6929
diff changeset
  1327
22241
65d1ed21a2a3 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 22147
diff changeset
  1328
    SystemBrowser default browseClass:aClass
6970
ac358e651731 more browsing
Claus Gittinger <cg@exept.de>
parents: 6929
diff changeset
  1329
ac358e651731 more browsing
Claus Gittinger <cg@exept.de>
parents: 6929
diff changeset
  1330
    "
10071
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
  1331
     Smalltalk browseClass:Array
6970
ac358e651731 more browsing
Claus Gittinger <cg@exept.de>
parents: 6929
diff changeset
  1332
    "
22241
65d1ed21a2a3 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 22147
diff changeset
  1333
65d1ed21a2a3 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 22147
diff changeset
  1334
    "Modified: / 01-09-2017 / 14:21:37 / cg"
6970
ac358e651731 more browsing
Claus Gittinger <cg@exept.de>
parents: 6929
diff changeset
  1335
!
ac358e651731 more browsing
Claus Gittinger <cg@exept.de>
parents: 6929
diff changeset
  1336
7563
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  1337
browseImplementorsMatching:aSelectorSymbolOrMatchPattern
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  1338
    "{ Pragma: +optSpace }"
6819
6b7885c187d5 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6806
diff changeset
  1339
6b7885c187d5 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6806
diff changeset
  1340
    "startup a browser for all methods implementing a message matching"
6b7885c187d5 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6806
diff changeset
  1341
22241
65d1ed21a2a3 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 22147
diff changeset
  1342
    SystemBrowser default browseImplementorsMatching:aSelectorSymbolOrMatchPattern
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1343
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1344
    "
10071
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
  1345
     Smalltalk browseImplementorsOf:#'at:put:'
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
  1346
     Smalltalk browseImplementorsMatching:#'at:*'
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1347
    "
22241
65d1ed21a2a3 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 22147
diff changeset
  1348
65d1ed21a2a3 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 22147
diff changeset
  1349
    "Modified: / 01-09-2017 / 14:21:39 / cg"
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1350
!
6819
6b7885c187d5 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6806
diff changeset
  1351
7563
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  1352
browseImplementorsOf:aSelectorSymbol
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  1353
    "{ Pragma: +optSpace }"
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  1354
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  1355
    "startup a browser for all methods implementing a particular message"
453
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1356
22241
65d1ed21a2a3 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 22147
diff changeset
  1357
    SystemBrowser default browseImplementorsOf:aSelectorSymbol
453
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1358
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1359
    "
10071
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
  1360
     Smalltalk browseImplementorsOf:#at:put:
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1361
    "
22241
65d1ed21a2a3 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 22147
diff changeset
  1362
65d1ed21a2a3 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 22147
diff changeset
  1363
    "Modified: / 01-09-2017 / 14:21:42 / cg"
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1364
!
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1365
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1366
browseInClass:aClass
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1367
    "{ Pragma: +optSpace }"
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1368
11150
be60e4505904 comments
Claus Gittinger <cg@exept.de>
parents: 11108
diff changeset
  1369
    "startup a full browser showing aClass.
20207
17e32d469ac6 #OTHER by mawalch
mawalch
parents: 20161
diff changeset
  1370
     The browser will be a full browser with aClass initially selected.
11150
be60e4505904 comments
Claus Gittinger <cg@exept.de>
parents: 11108
diff changeset
  1371
     See browseClass: for a singleClass browser, which shows only a single class."
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1372
22241
65d1ed21a2a3 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 22147
diff changeset
  1373
    SystemBrowser default openInClass:aClass
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1374
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1375
    "
10071
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
  1376
     Smalltalk browseInClass:Array
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1377
    "
22241
65d1ed21a2a3 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 22147
diff changeset
  1378
65d1ed21a2a3 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 22147
diff changeset
  1379
    "Modified: / 01-09-2017 / 14:21:46 / cg"
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1380
!
6970
ac358e651731 more browsing
Claus Gittinger <cg@exept.de>
parents: 6929
diff changeset
  1381
7563
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  1382
browseInClass:aClass selector:selector
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  1383
    "{ Pragma: +optSpace }"
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  1384
11150
be60e4505904 comments
Claus Gittinger <cg@exept.de>
parents: 11108
diff changeset
  1385
    "startup a full browser showing aClass>>selector.
20207
17e32d469ac6 #OTHER by mawalch
mawalch
parents: 20161
diff changeset
  1386
     The browser will be a full browser with aClass initially selected.
11150
be60e4505904 comments
Claus Gittinger <cg@exept.de>
parents: 11108
diff changeset
  1387
     See browseClass: for a singleClass browser, which shows only a single class."
6970
ac358e651731 more browsing
Claus Gittinger <cg@exept.de>
parents: 6929
diff changeset
  1388
22241
65d1ed21a2a3 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 22147
diff changeset
  1389
    SystemBrowser default openInClass:aClass selector:selector
6970
ac358e651731 more browsing
Claus Gittinger <cg@exept.de>
parents: 6929
diff changeset
  1390
ac358e651731 more browsing
Claus Gittinger <cg@exept.de>
parents: 6929
diff changeset
  1391
    "
ac358e651731 more browsing
Claus Gittinger <cg@exept.de>
parents: 6929
diff changeset
  1392
     Smalltalk browseInClass:Array selector:#at:
ac358e651731 more browsing
Claus Gittinger <cg@exept.de>
parents: 6929
diff changeset
  1393
    "
22241
65d1ed21a2a3 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 22147
diff changeset
  1394
65d1ed21a2a3 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 22147
diff changeset
  1395
    "Modified: / 01-09-2017 / 14:21:49 / cg"
453
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1396
! !
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1397
1750
36ff7e62388a care for privateClasses in remove
Claus Gittinger <cg@exept.de>
parents: 1713
diff changeset
  1398
!Smalltalk class methodsFor:'class management'!
453
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1399
18732
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1400
basicRemoveClass:aClass
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1401
    "remove the argument, aClass from the smalltalk dictionary;
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1402
     we have to flush the caches since these methods are now void.
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1403
     Also, class variables of aClass are removed."
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1404
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1405
    |sym cSym names oldName oldNameSym actualName wrongName|
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1406
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1407
    aClass isNil ifTrue:[^ self].
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1408
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1409
    oldName := aClass name.
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1410
    sym := oldNameSym := oldName asSymbol.
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1411
    ((self at:oldNameSym) == aClass) ifFalse:[
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1412
	"check other name ..."
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1413
	(self includes:aClass) ifFalse:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1414
	    'Smalltalk [warning]: no such class: ' errorPrint. oldName errorPrintCR.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1415
	    ^ self
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1416
	].
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1417
	"
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1418
	 the class has changed its name - without telling me ...
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1419
	 what should be done in this case ?
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1420
	"
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1421
	'Smalltalk [warning]: class ' errorPrint. oldName errorPrint.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1422
	' has changed its name' errorPrintCR.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1423
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1424
	"/
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1425
	"/ might be an alias (i.e. removing a compatibility name)
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1426
	"/
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1427
	actualName := self keyAtValue:aClass.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1428
	('Smalltalk [info]: ' , oldName , ' is actually stored as ' , actualName , '.') infoPrintCR.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1429
	sym := actualName asSymbol.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1430
	oldName := actualName asString.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1431
	wrongName := true.
18732
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1432
    ].
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1433
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1434
    self at:sym put:nil.    "nil it out for compiled accesses"
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1435
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1436
    "/
20811
f372f9dccfb2 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20772
diff changeset
  1437
    "/ see comment in removeKey: on why we don't remove it here
18732
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1438
    "/
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1439
    "/ self removeKey:sym.     "/ remove key - this actually fails, if there are
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1440
			       "/ still compiled code references."
18732
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1441
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1442
    "remove private classes"
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1443
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1444
    aClass privateClassesSorted do:[:somePrivateClass |
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1445
	aClass privateClassesAt:(somePrivateClass nameWithoutPrefix) asSymbol put:nil.
18732
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1446
    ].
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1447
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1448
    "remove class variables"
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1449
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1450
    names := aClass classVariableString asCollectionOfWords.
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1451
    names do:[:name |
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1452
	cSym := aClass globalKeyForClassVar:name.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1453
	self at:cSym asSymbol put:nil.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1454
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1455
	"/
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1456
	"/ see comment in removeKey: on why we dont remove it here
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1457
	"/
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1458
	"/ self removeKey:cSym
18732
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1459
    ].
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1460
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1461
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1462
"/    actually could get along with less flushing
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1463
"/    (entries for aClass and subclasses only)
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1464
"/    but we have to delay this, until we have the set of subclasses
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1465
"/    at hand - for now, searching for all subclasses is way more
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1466
"/    expensive then cache flushing.
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1467
"/
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1468
"/    aClass allSubclassesDo:[:aSubclass |
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1469
"/        ObjectMemory flushInlineCachesForClass:aSubclass.
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1470
"/        ObjectMemory flushMethodCacheFor:aSubclass
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1471
"/    ].
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1472
"/    ObjectMemory flushInlineCachesForClass:aClass.
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1473
"/    ObjectMemory flushMethodCacheFor:aClass
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1474
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1475
    ObjectMemory flushInlineCaches.
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1476
    ObjectMemory flushMethodCache.
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1477
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1478
    aClass addChangeRecordForClassRemove.
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1479
    self changed:#classRemove with:aClass.
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1480
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1481
    aClass setCategory:#'* removed *'.
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1482
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1483
"/    self flushCachedClasses.
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1484
"/    Class flushSubclassInfo.
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1485
    self flushCachedClass:aClass.
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1486
    Class flushSubclassInfoFor:aClass superclass.
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1487
    Class flushSubclassInfoFor:aClass.
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1488
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1489
    wrongName == true ifTrue:[
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1490
	"/
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1491
	"/ an alias (i.e. removing a compatibility name)
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1492
	"/
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1493
	"/ check if there are more refs to it ...
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1494
	[self includes:aClass] whileTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1495
	    actualName := self keyAtValue:aClass.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1496
	    ('Smalltalk [info]: ' , aClass name , ' is also registered under the name ' , actualName
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1497
			  , ' - remove that binding too.') infoPrintCR.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1498
	    self at:actualName put:nil.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1499
	].
18732
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1500
    ].
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1501
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1502
    "Modified: / 18-11-2006 / 17:16:31 / cg"
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1503
!
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1504
7563
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  1505
changeCategoryOf:aClass to:newCategory
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  1506
    "change a classes category, add a change record,
5253
c6b2933882fe rename with namespace involved;
Claus Gittinger <cg@exept.de>
parents: 5247
diff changeset
  1507
     send change notifications"
c6b2933882fe rename with namespace involved;
Claus Gittinger <cg@exept.de>
parents: 5247
diff changeset
  1508
8405
079fd61dc699 *** empty log message ***
ca
parents: 8383
diff changeset
  1509
    |ns oldCategory|
079fd61dc699 *** empty log message ***
ca
parents: 8383
diff changeset
  1510
079fd61dc699 *** empty log message ***
ca
parents: 8383
diff changeset
  1511
    oldCategory := aClass category.
079fd61dc699 *** empty log message ***
ca
parents: 8383
diff changeset
  1512
    oldCategory ~= newCategory ifTrue:[
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  1513
	aClass category:(newCategory withoutSeparators asSymbol).
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  1514
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  1515
	"notify change of category"
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  1516
	ns := aClass environment ? self.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  1517
	ns changed:#organization with:(aClass -> oldCategory).
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  1518
	ns ~~ self ifTrue:[
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  1519
	    self changed:#organization with:(aClass -> oldCategory).
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  1520
	]
5253
c6b2933882fe rename with namespace involved;
Claus Gittinger <cg@exept.de>
parents: 5247
diff changeset
  1521
    ].
c6b2933882fe rename with namespace involved;
Claus Gittinger <cg@exept.de>
parents: 5247
diff changeset
  1522
c6b2933882fe rename with namespace involved;
Claus Gittinger <cg@exept.de>
parents: 5247
diff changeset
  1523
    "
c6b2933882fe rename with namespace involved;
Claus Gittinger <cg@exept.de>
parents: 5247
diff changeset
  1524
     Smalltalk changeCategoryOf:NewApplication to:#myApplications
c6b2933882fe rename with namespace involved;
Claus Gittinger <cg@exept.de>
parents: 5247
diff changeset
  1525
    "
c6b2933882fe rename with namespace involved;
Claus Gittinger <cg@exept.de>
parents: 5247
diff changeset
  1526
c6b2933882fe rename with namespace involved;
Claus Gittinger <cg@exept.de>
parents: 5247
diff changeset
  1527
    "Modified: / 11.2.2000 / 11:36:27 / cg"
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1528
!
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1529
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1530
defineNameSpace: name private: private imports: imports category: category attributes: annotations
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1531
    NameSpace name:name
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1532
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1533
!
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1534
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1535
flushCachedClass:aClass
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1536
    CachedClasses notNil ifTrue:[
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  1537
	CachedClasses remove:aClass ifAbsent:[].
12700
5af24c64fbed changed:
Claus Gittinger <cg@exept.de>
parents: 12645
diff changeset
  1538
    ].
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1539
!
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1540
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1541
flushCachedClasses
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1542
    CachedClasses := nil.
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1543
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1544
    "
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1545
     Smalltalk flushCachedClasses
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1546
    "
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1547
!
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1548
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1549
removeClass:aClass
7563
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  1550
    "remove the argument, aClass from the smalltalk dictionary;
453
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1551
     we have to flush the caches since these methods are now void.
18732
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1552
     Also, class variables of aClass are removed.
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1553
     Recompile accessors to aClass."
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1554
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1555
    |oldNameSym ns ons|
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1556
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1557
    oldNameSym := aClass name asSymbol.
4781
631eb425ea4e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4770
diff changeset
  1558
    ns := aClass nameSpace.
631eb425ea4e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4770
diff changeset
  1559
    aClass topOwningClass notNil ifTrue:[
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1560
	ons := aClass topOwningClass nameSpace
18732
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1561
    ].
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1562
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1563
    self basicRemoveClass:aClass.
4724
44793fe70787 recompile ns classes after a class remove
Claus Gittinger <cg@exept.de>
parents: 4723
diff changeset
  1564
4781
631eb425ea4e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4770
diff changeset
  1565
    ns ~~ Smalltalk ifTrue:[
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1566
	ons notNil ifTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1567
	    ClassBuilder
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1568
		recompileGlobalAccessorsTo:oldNameSym
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1569
		in:ons
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1570
		except:nil
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1571
	].
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1572
	(ns notNil and:[ns ~~ ons]) ifTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1573
	    ClassBuilder
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1574
		recompileGlobalAccessorsTo:oldNameSym
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1575
		in:ns
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1576
		except:nil
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1577
	].
18732
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1578
    ].
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1579
!
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1580
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1581
removeClasses:aCollectionOfClasses
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1582
    "remove aCollectionOfClasses from the smalltalk dictionary;
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1583
     we have to flush the caches since these methods are now void.
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1584
     Also, class variables of aClass are removed.
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1585
     Recompile accessors to the classes - after all classes in the collection have been removed."
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1586
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1587
    |tuples|
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1588
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1589
    tuples := aCollectionOfClasses collect:[:eachClass|
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1590
		Array
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1591
		    with:eachClass name asSymbol
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1592
		    with:eachClass nameSpace
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1593
		    with:(
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1594
			    eachClass topOwningClass notNil ifTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1595
				eachClass topOwningClass nameSpace
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1596
			    ] ifFalse:[nil])
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1597
	    ].
18732
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1598
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1599
    aCollectionOfClasses do:[:eachClass|
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1600
	self basicRemoveClass:eachClass.
18732
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1601
    ].
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1602
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1603
    tuples do:[:eachClssymNsOnsTuple|
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1604
	|oldNameSym ns ons|
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1605
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1606
	oldNameSym := eachClssymNsOnsTuple at:1.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1607
	ns := eachClssymNsOnsTuple at:2.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1608
	ons := eachClssymNsOnsTuple at:3.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1609
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1610
	ns ~~ Smalltalk ifTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1611
	    ons notNil ifTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1612
		ClassBuilder
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1613
		    recompileGlobalAccessorsTo:oldNameSym
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1614
		    in:ons
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1615
		    except:nil
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1616
	    ].
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1617
	    (ns notNil and:[ns ~~ ons]) ifTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1618
		ClassBuilder
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1619
		    recompileGlobalAccessorsTo:oldNameSym
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1620
		    in:ns
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1621
		    except:nil
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1622
	    ].
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  1623
	]
18732
34212221028c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18707
diff changeset
  1624
    ].
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1625
!
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1626
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1627
renameClass:aClass to:newName
7563
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  1628
    "rename aClass to newName. Most of the work is in
1525
935b12ecf8ff in renameClass: patch literals of all methods to access the renamed
Claus Gittinger <cg@exept.de>
parents: 1481
diff changeset
  1629
     renaming the classVariables (create & copy over values)
935b12ecf8ff in renameClass: patch literals of all methods to access the renamed
Claus Gittinger <cg@exept.de>
parents: 1481
diff changeset
  1630
     and patching the classes methods to access the new variables."
935b12ecf8ff in renameClass: patch literals of all methods to access the renamed
Claus Gittinger <cg@exept.de>
parents: 1481
diff changeset
  1631
2270
76c239686353 when renaming a class, also rename any private classes.
Claus Gittinger <cg@exept.de>
parents: 2249
diff changeset
  1632
    |oldName oldSym newSym names oldCVSym newCVSym value oldNameToNewName
3698
8bce45214d24 fixed renaming of a private class (must recompile owner)
Claus Gittinger <cg@exept.de>
parents: 3678
diff changeset
  1633
     oldNameSpace newNameSpace oldBaseName newBaseName privateClasses
5610
af0d91fe32fc rename fixed (if it implies a nameSpace or ownership change)
Claus Gittinger <cg@exept.de>
parents: 5601
diff changeset
  1634
     oldBaseNameWithoutPrefix newBaseNameWithoutPrefix i1 i2 nm ns subns
7999
475bba3ead9a moved all input completion methods from Smalltalk to DoWhatIMeanSupport.
Claus Gittinger <cg@exept.de>
parents: 7996
diff changeset
  1635
     oldMetaclass newMetaclass newCategory|
5610
af0d91fe32fc rename fixed (if it implies a nameSpace or ownership change)
Claus Gittinger <cg@exept.de>
parents: 5601
diff changeset
  1636
af0d91fe32fc rename fixed (if it implies a nameSpace or ownership change)
Claus Gittinger <cg@exept.de>
parents: 5601
diff changeset
  1637
    "/ check for all intermediate namespaces / owning classes
5253
c6b2933882fe rename with namespace involved;
Claus Gittinger <cg@exept.de>
parents: 5247
diff changeset
  1638
    i1 := 1.
c6b2933882fe rename with namespace involved;
Claus Gittinger <cg@exept.de>
parents: 5247
diff changeset
  1639
    i2 := 1.
c6b2933882fe rename with namespace involved;
Claus Gittinger <cg@exept.de>
parents: 5247
diff changeset
  1640
    ns := self.
c6b2933882fe rename with namespace involved;
Claus Gittinger <cg@exept.de>
parents: 5247
diff changeset
  1641
    [i2 ~~ 0] whileTrue:[
23789
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1642
        i2 := newName indexOfSubCollection:'::' startingAt:i1.
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1643
        i2 ~~ 0 ifTrue:[
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1644
            nm := newName copyFrom:i1 to:i2-1.
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1645
            ns isNameSpace ifTrue:[
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1646
                subns := ns at:nm asSymbol ifAbsent:nil.
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1647
                subns isNil ifTrue:[
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1648
                    self error:'Nonexisting namespace: ',nm.
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1649
                    ^ nil.
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1650
                ].
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1651
            ] ifFalse:[
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1652
                subns := ns privateClassesAt:nm asSymbol.
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1653
                subns isNil ifTrue:[
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1654
                    self error:'Cannot create a namespace below a class'
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1655
                ]
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1656
            ].
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1657
            ns := subns.
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1658
            i1 := i2 + 2.
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1659
        ].
5253
c6b2933882fe rename with namespace involved;
Claus Gittinger <cg@exept.de>
parents: 5247
diff changeset
  1660
    ].
617
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  1661
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  1662
    oldName := aClass name.
6734
dd9fa2d81cb9 use #topNameSpace
Claus Gittinger <cg@exept.de>
parents: 6722
diff changeset
  1663
    oldNameSpace := aClass topNameSpace.
2319
640bb389f90a recompile when moving classes across namespaces
Claus Gittinger <cg@exept.de>
parents: 2317
diff changeset
  1664
    oldBaseName := aClass nameWithoutNameSpacePrefix.
3698
8bce45214d24 fixed renaming of a private class (must recompile owner)
Claus Gittinger <cg@exept.de>
parents: 3678
diff changeset
  1665
    oldBaseNameWithoutPrefix := aClass nameWithoutPrefix.
617
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  1666
    oldSym := oldName asSymbol.
2485
9f4a11a4521f new #privateClasses semantic
Claus Gittinger <cg@exept.de>
parents: 2476
diff changeset
  1667
    privateClasses := aClass privateClassesSorted.
2270
76c239686353 when renaming a class, also rename any private classes.
Claus Gittinger <cg@exept.de>
parents: 2249
diff changeset
  1668
76c239686353 when renaming a class, also rename any private classes.
Claus Gittinger <cg@exept.de>
parents: 2249
diff changeset
  1669
    ((self at:oldSym) ~~ aClass) ifTrue:[
23789
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1670
        'Smalltalk [warning]: rename failed - name is different from key' errorPrintCR.
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1671
        ^ self
2270
76c239686353 when renaming a class, also rename any private classes.
Claus Gittinger <cg@exept.de>
parents: 2249
diff changeset
  1672
    ].
617
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  1673
1525
935b12ecf8ff in renameClass: patch literals of all methods to access the renamed
Claus Gittinger <cg@exept.de>
parents: 1481
diff changeset
  1674
    "/ rename the class
617
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  1675
1847
6e567214b167 care for className being a symbol, when renaming classes
Claus Gittinger <cg@exept.de>
parents: 1758
diff changeset
  1676
    newSym := newName asSymbol.
1525
935b12ecf8ff in renameClass: patch literals of all methods to access the renamed
Claus Gittinger <cg@exept.de>
parents: 1481
diff changeset
  1677
5610
af0d91fe32fc rename fixed (if it implies a nameSpace or ownership change)
Claus Gittinger <cg@exept.de>
parents: 5601
diff changeset
  1678
    "/ change the owning class
af0d91fe32fc rename fixed (if it implies a nameSpace or ownership change)
Claus Gittinger <cg@exept.de>
parents: 5601
diff changeset
  1679
    ns isNameSpace ifFalse:[
23789
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1680
        aClass isPrivate ifTrue:[
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1681
            aClass class setOwningClass:ns.
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1682
        ] ifFalse:[
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1683
            "/ sigh - must make a PrivateMetaclass from Metaclass
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1684
            oldMetaclass := aClass class.
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1685
            newMetaclass := PrivateMetaclass new.
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1686
            newMetaclass flags:(oldMetaclass flags).
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1687
            newMetaclass setSuperclass:(oldMetaclass superclass).
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1688
            newMetaclass instSize:(oldMetaclass instSize).
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1689
            newMetaclass setInstanceVariableString:(oldMetaclass instanceVariableString).
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1690
            newMetaclass setMethodDictionary:(oldMetaclass methodDictionary).
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1691
            newMetaclass setSoleInstance:aClass.
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1692
            newMetaclass setOwningClass:ns.
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1693
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1694
            aClass changeClassTo:newMetaclass.
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1695
            ObjectMemory flushCaches.
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1696
        ]
5610
af0d91fe32fc rename fixed (if it implies a nameSpace or ownership change)
Claus Gittinger <cg@exept.de>
parents: 5601
diff changeset
  1697
    ] ifTrue:[
23789
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1698
        aClass isPrivate ifTrue:[
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1699
            newCategory := aClass topOwningClass category.
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1700
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1701
            "/ sigh - must make a Metaclass from PrivateMetaclass
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1702
            oldMetaclass := aClass class.
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1703
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1704
            newMetaclass := Metaclass new.
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1705
            newMetaclass flags:(oldMetaclass flags).
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1706
            newMetaclass setSuperclass:(oldMetaclass superclass).
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1707
            newMetaclass instSize:(oldMetaclass instSize).
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1708
            newMetaclass setInstanceVariableString:(oldMetaclass instanceVariableString).
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1709
            newMetaclass setMethodDictionary:(oldMetaclass methodDictionary).
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1710
            newMetaclass setSoleInstance:aClass.
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1711
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1712
            aClass category:newCategory.
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1713
            aClass changeClassTo:newMetaclass.
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1714
            ObjectMemory flushCaches.
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1715
        ]
5610
af0d91fe32fc rename fixed (if it implies a nameSpace or ownership change)
Claus Gittinger <cg@exept.de>
parents: 5601
diff changeset
  1716
    ].
af0d91fe32fc rename fixed (if it implies a nameSpace or ownership change)
Claus Gittinger <cg@exept.de>
parents: 5601
diff changeset
  1717
7999
475bba3ead9a moved all input completion methods from Smalltalk to DoWhatIMeanSupport.
Claus Gittinger <cg@exept.de>
parents: 7996
diff changeset
  1718
    aClass setName:newSym.
475bba3ead9a moved all input completion methods from Smalltalk to DoWhatIMeanSupport.
Claus Gittinger <cg@exept.de>
parents: 7996
diff changeset
  1719
475bba3ead9a moved all input completion methods from Smalltalk to DoWhatIMeanSupport.
Claus Gittinger <cg@exept.de>
parents: 7996
diff changeset
  1720
    "/ store it in Smalltalk
475bba3ead9a moved all input completion methods from Smalltalk to DoWhatIMeanSupport.
Claus Gittinger <cg@exept.de>
parents: 7996
diff changeset
  1721
    self at:oldSym put:nil.
475bba3ead9a moved all input completion methods from Smalltalk to DoWhatIMeanSupport.
Claus Gittinger <cg@exept.de>
parents: 7996
diff changeset
  1722
878
c09b016c6674 do not remove a global-assoc when classes are removed (see comment there)
Claus Gittinger <cg@exept.de>
parents: 857
diff changeset
  1723
    "/
20811
f372f9dccfb2 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20772
diff changeset
  1724
    "/ see comment in #removeKey: on why we don't remove it it here
878
c09b016c6674 do not remove a global-assoc when classes are removed (see comment there)
Claus Gittinger <cg@exept.de>
parents: 857
diff changeset
  1725
    "/
c09b016c6674 do not remove a global-assoc when classes are removed (see comment there)
Claus Gittinger <cg@exept.de>
parents: 857
diff changeset
  1726
    "/ self removeKey:oldSym.
617
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  1727
    self at:newSym put:aClass.
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  1728
1525
935b12ecf8ff in renameClass: patch literals of all methods to access the renamed
Claus Gittinger <cg@exept.de>
parents: 1481
diff changeset
  1729
    "/ create new class variables and copy over values
935b12ecf8ff in renameClass: patch literals of all methods to access the renamed
Claus Gittinger <cg@exept.de>
parents: 1481
diff changeset
  1730
935b12ecf8ff in renameClass: patch literals of all methods to access the renamed
Claus Gittinger <cg@exept.de>
parents: 1481
diff changeset
  1731
    oldNameToNewName := IdentityDictionary new.
617
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  1732
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  1733
    names := aClass classVariableString asCollectionOfWords.
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  1734
    names do:[:name |
23789
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1735
        oldCVSym := (oldSym , ':' , name) asSymbol.
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1736
        value := self at:oldCVSym.
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1737
        self at:oldCVSym put:nil.
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1738
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1739
        "/
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1740
        "/ see comment in #removeKey: on why we dont remove it it here
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1741
        "/
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1742
        "/ self removeKey:cSym.
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1743
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1744
        newCVSym := (newSym , ':' , name) asSymbol.
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1745
        self at:newCVSym put:value.
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1746
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1747
        oldNameToNewName at:oldCVSym put:newCVSym.
1525
935b12ecf8ff in renameClass: patch literals of all methods to access the renamed
Claus Gittinger <cg@exept.de>
parents: 1481
diff changeset
  1748
    ].
935b12ecf8ff in renameClass: patch literals of all methods to access the renamed
Claus Gittinger <cg@exept.de>
parents: 1481
diff changeset
  1749
935b12ecf8ff in renameClass: patch literals of all methods to access the renamed
Claus Gittinger <cg@exept.de>
parents: 1481
diff changeset
  1750
    "/ patch methods literal arrays from oldCVname to newCVname
935b12ecf8ff in renameClass: patch literals of all methods to access the renamed
Claus Gittinger <cg@exept.de>
parents: 1481
diff changeset
  1751
935b12ecf8ff in renameClass: patch literals of all methods to access the renamed
Claus Gittinger <cg@exept.de>
parents: 1481
diff changeset
  1752
    oldNameToNewName keysAndValuesDo:[:oldNameSym :newNameSym |
23789
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1753
        aClass withAllSubclasses do:[:aSubClass |
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1754
            Transcript showCR:'changing global accesses from ''' , oldNameSym , ''' into ''' , newNameSym , ''' in class: ''' , aSubClass name , ''' ...'.
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1755
            aSubClass instAndClassSelectorsAndMethodsDo:[:sel :aMethod |
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1756
                aMethod changeLiteral:oldNameSym to:newNameSym
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1757
            ].
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1758
        ].
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1759
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1760
        "/ and also in privateClasses ? ...
2270
76c239686353 when renaming a class, also rename any private classes.
Claus Gittinger <cg@exept.de>
parents: 2249
diff changeset
  1761
2485
9f4a11a4521f new #privateClasses semantic
Claus Gittinger <cg@exept.de>
parents: 2476
diff changeset
  1762
"/        privateClasses size > 0 ifTrue:[
2270
76c239686353 when renaming a class, also rename any private classes.
Claus Gittinger <cg@exept.de>
parents: 2249
diff changeset
  1763
"/            privateClasses do:[:aPrivateClass |
76c239686353 when renaming a class, also rename any private classes.
Claus Gittinger <cg@exept.de>
parents: 2249
diff changeset
  1764
"/                aPrivateClass withAllSubclasses do:[:aSubClass |
76c239686353 when renaming a class, also rename any private classes.
Claus Gittinger <cg@exept.de>
parents: 2249
diff changeset
  1765
"/                    aSubClass class methodDictionary do:[:aMethod |
76c239686353 when renaming a class, also rename any private classes.
Claus Gittinger <cg@exept.de>
parents: 2249
diff changeset
  1766
"/                        aMethod changeLiteral:oldNameSym to:newNameSym
76c239686353 when renaming a class, also rename any private classes.
Claus Gittinger <cg@exept.de>
parents: 2249
diff changeset
  1767
"/                    ].
76c239686353 when renaming a class, also rename any private classes.
Claus Gittinger <cg@exept.de>
parents: 2249
diff changeset
  1768
"/                    aSubClass methodDictionary do:[:aMethod |
76c239686353 when renaming a class, also rename any private classes.
Claus Gittinger <cg@exept.de>
parents: 2249
diff changeset
  1769
"/                        aMethod changeLiteral:oldNameSym to:newNameSym
76c239686353 when renaming a class, also rename any private classes.
Claus Gittinger <cg@exept.de>
parents: 2249
diff changeset
  1770
"/                    ]
76c239686353 when renaming a class, also rename any private classes.
Claus Gittinger <cg@exept.de>
parents: 2249
diff changeset
  1771
"/                ].
76c239686353 when renaming a class, also rename any private classes.
Claus Gittinger <cg@exept.de>
parents: 2249
diff changeset
  1772
"/            ]
76c239686353 when renaming a class, also rename any private classes.
Claus Gittinger <cg@exept.de>
parents: 2249
diff changeset
  1773
"/        ]
617
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  1774
    ].
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  1775
2270
76c239686353 when renaming a class, also rename any private classes.
Claus Gittinger <cg@exept.de>
parents: 2249
diff changeset
  1776
    aClass addChangeRecordForClassRename:oldSym to:newSym.
76c239686353 when renaming a class, also rename any private classes.
Claus Gittinger <cg@exept.de>
parents: 2249
diff changeset
  1777
5333
d80386e06d21 rename into other namespace did not work
Claus Gittinger <cg@exept.de>
parents: 5328
diff changeset
  1778
    "/ clear the namespace (for namespace query to work)
d80386e06d21 rename into other namespace did not work
Claus Gittinger <cg@exept.de>
parents: 5328
diff changeset
  1779
    aClass setEnvironment:nil.
6734
dd9fa2d81cb9 use #topNameSpace
Claus Gittinger <cg@exept.de>
parents: 6722
diff changeset
  1780
    newNameSpace := aClass topNameSpace.
2405
939f4e751ef3 dont forget to rename private classes as well.
Claus Gittinger <cg@exept.de>
parents: 2379
diff changeset
  1781
23789
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1782
    privateClasses size ~~ 0 ifTrue:[
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1783
        "/ must rename privateClasses as well
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1784
        Class withoutUpdatingChangesDo:[
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1785
            privateClasses do:[:aPrivateClass |
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1786
                self renameClass:aPrivateClass
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1787
                     to:(newSym , '::' , aPrivateClass nameWithoutPrefix).
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1788
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1789
                Transcript showCR:'recompiling methods in ''' , newNameSpace name , ''' accessing ''' , oldName , '::' , aPrivateClass nameWithoutPrefix , ''' ...'.
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1790
                aClass theNonMetaclass recompileMethodsAccessingGlobal:(oldName , '::' , aPrivateClass nameWithoutPrefix) asSymbol.
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1791
                aClass theMetaclass recompileMethodsAccessingGlobal:(oldName , '::' , aPrivateClass nameWithoutPrefix) asSymbol.
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1792
                aClass theNonMetaclass recompileMethodsAccessingGlobal:(aPrivateClass nameWithoutPrefix) asSymbol.
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1793
                aClass theMetaclass recompileMethodsAccessingGlobal:(aPrivateClass nameWithoutPrefix) asSymbol.
9822
38acd1c5eeab recompile methods which access private classes when renaming a class.
Claus Gittinger <cg@exept.de>
parents: 9819
diff changeset
  1794
"/                ClassBuilder
10071
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
  1795
"/                    recompileGlobalAccessorsTo:(oldName , '::' , aPrivateClass nameWithoutPrefix) asSymbol
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
  1796
"/                    in:newNameSpace
9822
38acd1c5eeab recompile methods which access private classes when renaming a class.
Claus Gittinger <cg@exept.de>
parents: 9819
diff changeset
  1797
"/                    except:nil.
23789
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1798
            ]
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1799
        ]
2405
939f4e751ef3 dont forget to rename private classes as well.
Claus Gittinger <cg@exept.de>
parents: 2379
diff changeset
  1800
    ].
939f4e751ef3 dont forget to rename private classes as well.
Claus Gittinger <cg@exept.de>
parents: 2379
diff changeset
  1801
2319
640bb389f90a recompile when moving classes across namespaces
Claus Gittinger <cg@exept.de>
parents: 2317
diff changeset
  1802
    oldNameSpace ~~ newNameSpace ifTrue:[
5246
2ca7b20c4108 create namespaces as requried, when renaming a class
Claus Gittinger <cg@exept.de>
parents: 5214
diff changeset
  1803
23789
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1804
        "/ all those referencing the class from the old nameSpace
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1805
        "/ must be recompiled ...
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1806
        "/ (to now access the global from smalltalk)
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1807
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1808
        oldNameSpace ~~ Smalltalk ifTrue:[
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1809
            Transcript showCR:'recompiling methods in ''' , oldNameSpace name , ''' accessing ''' , oldName , ''' ...'.
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1810
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1811
            ClassBuilder
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1812
                recompileGlobalAccessorsTo:oldName asSymbol
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1813
                in:oldNameSpace
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1814
                except:nil.
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1815
        ].
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1816
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1817
        "/ all referencing the class in the new namespace
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1818
        "/ as well; to now access the new class.
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1819
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1820
        (newNameSpace notNil and:[newNameSpace ~~ Smalltalk]) ifTrue:[
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1821
            Transcript showCR:'recompiling methods in ''' , newNameSpace name , ''' accessing ''' , oldBaseName , ''' ...'.
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1822
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1823
            ClassBuilder
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1824
                recompileGlobalAccessorsTo:oldBaseName asSymbol
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1825
                in:newNameSpace
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1826
                except:nil.
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1827
        ].
3698
8bce45214d24 fixed renaming of a private class (must recompile owner)
Claus Gittinger <cg@exept.de>
parents: 3678
diff changeset
  1828
    ] ifFalse:[
23789
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1829
        "/ all references to a global with my new name in my owning class
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1830
        "/ must now be redirected to myself.
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1831
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1832
        aClass isPrivate ifTrue:[
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1833
            newBaseName := aClass nameWithoutNameSpacePrefix.
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1834
            newBaseNameWithoutPrefix := aClass nameWithoutPrefix.
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1835
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1836
            Transcript showCR:'recompiling methods accessing ''' , oldBaseNameWithoutPrefix , ''' in: ''' , aClass owningClass name , ''' ...'.
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1837
            aClass owningClass recompileMethodsAccessingGlobal:oldBaseNameWithoutPrefix.
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1838
            aClass owningClass class recompileMethodsAccessingGlobal:oldBaseNameWithoutPrefix.
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1839
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1840
            Transcript showCR:'recompiling methods accessing ''' , oldBaseName , ''' in: ''' , aClass owningClass name , ''' ...'.
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1841
            aClass owningClass recompileMethodsAccessingGlobal:oldBaseName.
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1842
            aClass owningClass class recompileMethodsAccessingGlobal:oldBaseName.
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1843
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1844
            Transcript showCR:'recompiling methods accessing ''' , newBaseNameWithoutPrefix , ''' in: ''' , aClass owningClass name , ''' ...'.
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1845
            aClass owningClass recompileMethodsAccessingGlobal:newBaseNameWithoutPrefix.
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1846
            aClass owningClass class recompileMethodsAccessingGlobal:newBaseNameWithoutPrefix.
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1847
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1848
            Transcript showCR:'recompiling methods accessing ''' , newBaseName , ''' in: ''' , aClass owningClass name , ''' ...'.
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1849
            aClass owningClass recompileMethodsAccessingGlobal:newBaseName.
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1850
            aClass owningClass class recompileMethodsAccessingGlobal:newBaseName.
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1851
        ]
4040
b27f87d9772d must send a change-notifiction, when renaming a class.
Claus Gittinger <cg@exept.de>
parents: 4028
diff changeset
  1852
    ].
b27f87d9772d must send a change-notifiction, when renaming a class.
Claus Gittinger <cg@exept.de>
parents: 4028
diff changeset
  1853
b27f87d9772d must send a change-notifiction, when renaming a class.
Claus Gittinger <cg@exept.de>
parents: 4028
diff changeset
  1854
    aClass changed:#definition.
b27f87d9772d must send a change-notifiction, when renaming a class.
Claus Gittinger <cg@exept.de>
parents: 4028
diff changeset
  1855
    "/ because of the change of my superclasses name ...
b27f87d9772d must send a change-notifiction, when renaming a class.
Claus Gittinger <cg@exept.de>
parents: 4028
diff changeset
  1856
    aClass allSubclassesDo:[:subClass |
23789
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1857
        subClass changed:#definition.
7996
facae0a118da when a class is renamed, add change records for all subclasses
Claus Gittinger <cg@exept.de>
parents: 7992
diff changeset
  1858
    ].
facae0a118da when a class is renamed, add change records for all subclasses
Claus Gittinger <cg@exept.de>
parents: 7992
diff changeset
  1859
    "/ because of the change of my superclasses name ...
facae0a118da when a class is renamed, add change records for all subclasses
Claus Gittinger <cg@exept.de>
parents: 7992
diff changeset
  1860
    aClass subclassesDo:[:subClass |
23789
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1861
        subClass addChangeRecordForClass:subClass.
4040
b27f87d9772d must send a change-notifiction, when renaming a class.
Claus Gittinger <cg@exept.de>
parents: 4028
diff changeset
  1862
    ].
5613
b534e427f028 change message when renaming a class
Claus Gittinger <cg@exept.de>
parents: 5611
diff changeset
  1863
    self changed:#definition.
14611
5c3a6b7ed01d class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 14589
diff changeset
  1864
    self changed:#classRename with:(Array with:aClass with:oldName).
3698
8bce45214d24 fixed renaming of a private class (must recompile owner)
Claus Gittinger <cg@exept.de>
parents: 3678
diff changeset
  1865
9822
38acd1c5eeab recompile methods which access private classes when renaming a class.
Claus Gittinger <cg@exept.de>
parents: 9819
diff changeset
  1866
    "Created: / 29-10-1995 / 19:58:32 / cg"
38acd1c5eeab recompile methods which access private classes when renaming a class.
Claus Gittinger <cg@exept.de>
parents: 9819
diff changeset
  1867
    "Modified: / 18-06-1996 / 14:20:50 / stefan"
38acd1c5eeab recompile methods which access private classes when renaming a class.
Claus Gittinger <cg@exept.de>
parents: 9819
diff changeset
  1868
    "Modified: / 05-09-2006 / 12:52:25 / cg"
23789
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  1869
    "Modified: / 01-03-2019 / 16:12:03 / Claus Gittinger"
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1870
! !
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1871
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1872
!Smalltalk class methodsFor:'copying'!
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1873
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1874
deepCopy
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1875
    "redefined to return self - there is only one Smalltalk dictionary"
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1876
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1877
    ^ self
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1878
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1879
    "Modified: 18.5.1996 / 12:13:33 / cg"
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1880
!
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1881
10952
16d46611f7ae deepCopy change
ab
parents: 10904
diff changeset
  1882
deepCopyUsing:aDictionary postCopySelector:postCopySelector
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1883
    "return a deep copy of the receiver.
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1884
     Redefined to return the receiver - there is only one Smalltalk dictionary"
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1885
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1886
    ^ self
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1887
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1888
    "Modified: 18.5.1996 / 12:13:36 / cg"
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1889
!
453
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1890
7563
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  1891
shallowCopy
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  1892
    "redefined to return self - there is only one Smalltalk dictionary"
617
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  1893
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  1894
    ^ self
1410
518bf8454809 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1307
diff changeset
  1895
518bf8454809 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1307
diff changeset
  1896
    "Modified: 18.5.1996 / 12:13:39 / cg"
617
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  1897
!
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  1898
7563
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  1899
simpleDeepCopy
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  1900
    "redefined to return self - there is only one Smalltalk dictionary"
453
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1901
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1902
    ^ self
1410
518bf8454809 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1307
diff changeset
  1903
518bf8454809 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1307
diff changeset
  1904
    "Modified: 18.5.1996 / 12:13:42 / cg"
453
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1905
! !
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1906
1750
36ff7e62388a care for privateClasses in remove
Claus Gittinger <cg@exept.de>
parents: 1713
diff changeset
  1907
!Smalltalk class methodsFor:'debugging ST/X'!
453
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1908
7563
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  1909
compileTrace:aBoolean
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  1910
    "dump generated inline code (NOOP if VM was compiled without the trace-debug option)"
7325
f424d3e7978f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 7295
diff changeset
  1911
%{
f424d3e7978f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 7295
diff changeset
  1912
    extern char __compileTrace__;
f424d3e7978f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 7295
diff changeset
  1913
f424d3e7978f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 7295
diff changeset
  1914
    __compileTrace__ = (aBoolean == true) ? 1 : 0;
f424d3e7978f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 7295
diff changeset
  1915
%}
f424d3e7978f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 7295
diff changeset
  1916
    "
f424d3e7978f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 7295
diff changeset
  1917
     Smalltalk compileTrace:true
f424d3e7978f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 7295
diff changeset
  1918
     Smalltalk compileTrace:false
f424d3e7978f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 7295
diff changeset
  1919
    "
f424d3e7978f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 7295
diff changeset
  1920
!
f424d3e7978f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 7295
diff changeset
  1921
7563
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  1922
debugBreakPoint
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1923
    "{ Pragma: +optSpace }"
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1924
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1925
    "call the dummy debug function, on which a breakpoint
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1926
     can be put in adb, sdb, dbx or gdb.
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1927
     WARNING: this method is for debugging only
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  1928
	      it will be removed without notice."
453
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1929
%{
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1930
    __PATCHUPCONTEXTS(__context);
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1931
    __debugBreakPoint__();
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1932
%}.
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1933
    ^ self
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1934
!
453
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  1935
7563
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  1936
exitWithCoreDump
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  1937
    "{ Pragma: +optSpace }"
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  1938
20755
8266a42d28e3 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20746
diff changeset
  1939
    "abort the program and dump core"
7563
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  1940
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  1941
    OperatingSystem exitWithCoreDump
4096
d292495070db exitWithCoreDump was duplicate
Claus Gittinger <cg@exept.de>
parents: 4067
diff changeset
  1942
    "/ never returns
d292495070db exitWithCoreDump was duplicate
Claus Gittinger <cg@exept.de>
parents: 4067
diff changeset
  1943
20755
8266a42d28e3 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20746
diff changeset
  1944
    "Be careful evaluating this:
4096
d292495070db exitWithCoreDump was duplicate
Claus Gittinger <cg@exept.de>
parents: 4067
diff changeset
  1945
     Smalltalk exitWithCoreDump
d292495070db exitWithCoreDump was duplicate
Claus Gittinger <cg@exept.de>
parents: 4067
diff changeset
  1946
    "
617
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  1947
!
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  1948
7563
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  1949
fatalAbort
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  1950
    "{ Pragma: +optSpace }"
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  1951
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  1952
    "report a fatal-error, print a stack backtrace and exit with core dump.
617
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  1953
     (You may turn off the stack print with debugPrinting:false)"
18287
ec8170701a7e steam code
Claus Gittinger <cg@exept.de>
parents: 18283
diff changeset
  1954
ec8170701a7e steam code
Claus Gittinger <cg@exept.de>
parents: 18283
diff changeset
  1955
    self fatalAbort:'fatalAbort'
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  1956
!
617
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  1957
7563
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  1958
fatalAbort:aMessage
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  1959
    "{ Pragma: +optSpace }"
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  1960
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  1961
    "report a fatal-error; print a stack backtrace and exit with core dump
617
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  1962
     (You may turn off the stack print with debugPrinting:false)"
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  1963
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  1964
%{
18287
ec8170701a7e steam code
Claus Gittinger <cg@exept.de>
parents: 18283
diff changeset
  1965
#ifdef __SCHTEAM__
ec8170701a7e steam code
Claus Gittinger <cg@exept.de>
parents: 18283
diff changeset
  1966
    STMain.fatalAbort( aMessage );
ec8170701a7e steam code
Claus Gittinger <cg@exept.de>
parents: 18283
diff changeset
  1967
    /* NOT REACHED */
ec8170701a7e steam code
Claus Gittinger <cg@exept.de>
parents: 18283
diff changeset
  1968
#else
617
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  1969
    char *msg;
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  1970
12481
805176d238d2 change __isString() to __isStringLike() in primitive code
Stefan Vogel <sv@exept.de>
parents: 12413
diff changeset
  1971
    if (__isStringLike(aMessage))
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  1972
	msg = (char *) __stringVal(aMessage);
617
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  1973
    else
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  1974
	msg = "fatalAbort";
617
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  1975
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  1976
    __fatal0(__context, msg);
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  1977
    /* NEVER RETURNS */
18287
ec8170701a7e steam code
Claus Gittinger <cg@exept.de>
parents: 18283
diff changeset
  1978
#endif
5410
859c010edb47 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5406
diff changeset
  1979
%}.
859c010edb47 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5406
diff changeset
  1980
    ^ self primitiveFailed
5441
e88302747bbd rel5 migration
Claus Gittinger <cg@exept.de>
parents: 5427
diff changeset
  1981
!
e88302747bbd rel5 migration
Claus Gittinger <cg@exept.de>
parents: 5427
diff changeset
  1982
13135
1031ffdd98fd ignoreHalt is now a classVar
Claus Gittinger <cg@exept.de>
parents: 13129
diff changeset
  1983
ignoreHalt
1031ffdd98fd ignoreHalt is now a classVar
Claus Gittinger <cg@exept.de>
parents: 13129
diff changeset
  1984
    "return true, if halts are ignored.
1031ffdd98fd ignoreHalt is now a classVar
Claus Gittinger <cg@exept.de>
parents: 13129
diff changeset
  1985
     Usually, this is done in standAlone applications"
1031ffdd98fd ignoreHalt is now a classVar
Claus Gittinger <cg@exept.de>
parents: 13129
diff changeset
  1986
1031ffdd98fd ignoreHalt is now a classVar
Claus Gittinger <cg@exept.de>
parents: 13129
diff changeset
  1987
    IgnoreHalt isNil ifTrue:[
23678
acb36818ea6b #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23677
diff changeset
  1988
        ^ self isStandAloneApp
13135
1031ffdd98fd ignoreHalt is now a classVar
Claus Gittinger <cg@exept.de>
parents: 13129
diff changeset
  1989
    ].
1031ffdd98fd ignoreHalt is now a classVar
Claus Gittinger <cg@exept.de>
parents: 13129
diff changeset
  1990
    ^ IgnoreHalt
1031ffdd98fd ignoreHalt is now a classVar
Claus Gittinger <cg@exept.de>
parents: 13129
diff changeset
  1991
1031ffdd98fd ignoreHalt is now a classVar
Claus Gittinger <cg@exept.de>
parents: 13129
diff changeset
  1992
    "Created: / 18-11-2010 / 11:20:16 / cg"
23678
acb36818ea6b #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23677
diff changeset
  1993
    "Modified: / 06-02-2019 / 20:39:16 / Claus Gittinger"
13135
1031ffdd98fd ignoreHalt is now a classVar
Claus Gittinger <cg@exept.de>
parents: 13129
diff changeset
  1994
!
1031ffdd98fd ignoreHalt is now a classVar
Claus Gittinger <cg@exept.de>
parents: 13129
diff changeset
  1995
1031ffdd98fd ignoreHalt is now a classVar
Claus Gittinger <cg@exept.de>
parents: 13129
diff changeset
  1996
ignoreHalt:aBoolean
13323
68e5bb82f5f7 changed: #loadPackage:fromClassLibrary:
Stefan Vogel <sv@exept.de>
parents: 13303
diff changeset
  1997
    "control if halts are to be ignored;
13135
1031ffdd98fd ignoreHalt is now a classVar
Claus Gittinger <cg@exept.de>
parents: 13129
diff changeset
  1998
     usually, this is done in standAlone applications"
1031ffdd98fd ignoreHalt is now a classVar
Claus Gittinger <cg@exept.de>
parents: 13129
diff changeset
  1999
1031ffdd98fd ignoreHalt is now a classVar
Claus Gittinger <cg@exept.de>
parents: 13129
diff changeset
  2000
    IgnoreHalt := aBoolean
1031ffdd98fd ignoreHalt is now a classVar
Claus Gittinger <cg@exept.de>
parents: 13129
diff changeset
  2001
1031ffdd98fd ignoreHalt is now a classVar
Claus Gittinger <cg@exept.de>
parents: 13129
diff changeset
  2002
    "
1031ffdd98fd ignoreHalt is now a classVar
Claus Gittinger <cg@exept.de>
parents: 13129
diff changeset
  2003
     Smalltalk ignoreHalt:true.
1031ffdd98fd ignoreHalt is now a classVar
Claus Gittinger <cg@exept.de>
parents: 13129
diff changeset
  2004
     self halt.
1031ffdd98fd ignoreHalt is now a classVar
Claus Gittinger <cg@exept.de>
parents: 13129
diff changeset
  2005
     Smalltalk ignoreHalt:false.
1031ffdd98fd ignoreHalt is now a classVar
Claus Gittinger <cg@exept.de>
parents: 13129
diff changeset
  2006
     self halt.
1031ffdd98fd ignoreHalt is now a classVar
Claus Gittinger <cg@exept.de>
parents: 13129
diff changeset
  2007
    "
1031ffdd98fd ignoreHalt is now a classVar
Claus Gittinger <cg@exept.de>
parents: 13129
diff changeset
  2008
1031ffdd98fd ignoreHalt is now a classVar
Claus Gittinger <cg@exept.de>
parents: 13129
diff changeset
  2009
    "Created: / 18-11-2010 / 11:20:27 / cg"
1031ffdd98fd ignoreHalt is now a classVar
Claus Gittinger <cg@exept.de>
parents: 13129
diff changeset
  2010
!
1031ffdd98fd ignoreHalt is now a classVar
Claus Gittinger <cg@exept.de>
parents: 13129
diff changeset
  2011
23678
acb36818ea6b #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23677
diff changeset
  2012
silent
acb36818ea6b #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23677
diff changeset
  2013
    "returns the Silent class variable."
acb36818ea6b #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23677
diff changeset
  2014
acb36818ea6b #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23677
diff changeset
  2015
     ^ Silent ? false
acb36818ea6b #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23677
diff changeset
  2016
acb36818ea6b #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23677
diff changeset
  2017
    "Created: / 06-02-2019 / 20:36:51 / Claus Gittinger"
acb36818ea6b #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23677
diff changeset
  2018
!
acb36818ea6b #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23677
diff changeset
  2019
18329
c7764438ff70 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 18326
diff changeset
  2020
verbose
23678
acb36818ea6b #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23677
diff changeset
  2021
    ^ Verbose ? false
acb36818ea6b #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23677
diff changeset
  2022
acb36818ea6b #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23677
diff changeset
  2023
    "Modified: / 06-02-2019 / 20:38:44 / Claus Gittinger"
18329
c7764438ff70 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 18326
diff changeset
  2024
!
c7764438ff70 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 18326
diff changeset
  2025
c7764438ff70 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 18326
diff changeset
  2026
verbose:aBoolean
c7764438ff70 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 18326
diff changeset
  2027
    Verbose := aBoolean
c7764438ff70 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 18326
diff changeset
  2028
!
c7764438ff70 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 18326
diff changeset
  2029
7563
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  2030
vmInstructionTrace:aBoolean
13947
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  2031
    self halt:'not yet implemented'
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  2032
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  2033
    "Modified: / 19-01-2012 / 10:15:35 / cg"
7563
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  2034
! !
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  2035
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  2036
!Smalltalk class methodsFor:'enumerating'!
7563
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  2037
453
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2038
allBehaviorsDo:aBlock
5580
374e843aa424 allBehaviorsDo now enumerates both classes and metaclasses
Claus Gittinger <cg@exept.de>
parents: 5579
diff changeset
  2039
    "evaluate the argument, aBlock for all classes and metaclasses in the system"
374e843aa424 allBehaviorsDo now enumerates both classes and metaclasses
Claus Gittinger <cg@exept.de>
parents: 5579
diff changeset
  2040
374e843aa424 allBehaviorsDo now enumerates both classes and metaclasses
Claus Gittinger <cg@exept.de>
parents: 5579
diff changeset
  2041
    self allClassesAndMetaclassesDo:aBlock
453
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2042
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2043
    "
2588
090cf1da8036 handle abort signal in readEvalPrint loop
Claus Gittinger <cg@exept.de>
parents: 2572
diff changeset
  2044
     Smalltalk allBehaviorsDo:[:aClass | aClass name printCR]
453
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2045
    "
7563
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  2046
!
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  2047
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  2048
allClassCategories
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  2049
    "return a set of all class categories in the system"
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  2050
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  2051
    |allCategories|
6217
e0f4f3959c49 reuse allClassesInCategory-stuff
Claus Gittinger <cg@exept.de>
parents: 6188
diff changeset
  2052
e0f4f3959c49 reuse allClassesInCategory-stuff
Claus Gittinger <cg@exept.de>
parents: 6188
diff changeset
  2053
    allCategories := Set new.
13323
68e5bb82f5f7 changed: #loadPackage:fromClassLibrary:
Stefan Vogel <sv@exept.de>
parents: 13303
diff changeset
  2054
    Smalltalk allClassesDo:[:cls |
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  2055
	|category|
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  2056
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  2057
	category := cls category.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  2058
	category notNil ifTrue:[
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  2059
	    allCategories add:category.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  2060
	].
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  2061
    ].
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  2062
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  2063
    ^ allCategories.
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  2064
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  2065
    "
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  2066
     Smalltalk allClassCategories
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  2067
    "
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  2068
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  2069
    "Created: / 17.11.2001 / 12:13:09 / cg"
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  2070
!
6217
e0f4f3959c49 reuse allClassesInCategory-stuff
Claus Gittinger <cg@exept.de>
parents: 6188
diff changeset
  2071
7563
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  2072
allClassesAndMetaclassesDo:aBlock
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  2073
    "evaluate the argument, aBlock for all classes and metaclasses in the system."
5579
26af506d271e added #allClassesAndMetaclasses
Claus Gittinger <cg@exept.de>
parents: 5550
diff changeset
  2074
21108
e179d871a1cb #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 21022
diff changeset
  2075
    |already numClassesHintTimes2|
e179d871a1cb #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 21022
diff changeset
  2076
e179d871a1cb #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 21022
diff changeset
  2077
    numClassesHintTimes2 := NumberOfClassesHint*2.
e179d871a1cb #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 21022
diff changeset
  2078
    already := IdentitySet new:numClassesHintTimes2.
13323
68e5bb82f5f7 changed: #loadPackage:fromClassLibrary:
Stefan Vogel <sv@exept.de>
parents: 13303
diff changeset
  2079
    self allClassesDo:[:eachClass |
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2080
	|theNonMeta theMeta|
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2081
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2082
	theNonMeta := eachClass theNonMetaclass.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2083
	(already includes:theNonMeta) ifFalse:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2084
	    aBlock value:theNonMeta.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2085
	    already add:theNonMeta.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2086
	].
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2087
	theMeta := theNonMeta class.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2088
	(already includes:theMeta) ifFalse:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2089
	    aBlock value:theMeta.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2090
	    already add:theMeta.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2091
	].
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2092
	already size > numClassesHintTimes2 ifTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2093
	    NumberOfClassesHint := (already size // 2) + 10
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2094
	].
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  2095
    ].
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  2096
!
5579
26af506d271e added #allClassesAndMetaclasses
Claus Gittinger <cg@exept.de>
parents: 5550
diff changeset
  2097
7563
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  2098
allClassesDo:aBlock
21489
2c4c8ccda384 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 21458
diff changeset
  2099
    "evaluate the argument, aBlock for all classes in the system.
2c4c8ccda384 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 21458
diff changeset
  2100
     Enumerates non-meta classes only - not metaclasses"
5580
374e843aa424 allBehaviorsDo now enumerates both classes and metaclasses
Claus Gittinger <cg@exept.de>
parents: 5579
diff changeset
  2101
5765
152a485288d9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5760
diff changeset
  2102
    self allClasses do:aBlock
453
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2103
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2104
    "
2588
090cf1da8036 handle abort signal in readEvalPrint loop
Claus Gittinger <cg@exept.de>
parents: 2572
diff changeset
  2105
     Smalltalk allClassesDo:[:aClass | aClass name printCR]
453
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2106
    "
21489
2c4c8ccda384 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 21458
diff changeset
  2107
2c4c8ccda384 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 21458
diff changeset
  2108
    "Modified (comment): / 19-02-2017 / 12:38:17 / cg"
453
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2109
!
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2110
9506
93a214ce5997 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9496
diff changeset
  2111
allClassesForWhich:filter
10071
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
  2112
    "return a collection with all classes in the system,
21489
2c4c8ccda384 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 21458
diff changeset
  2113
     for which filter evaluates to true.
2c4c8ccda384 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 21458
diff changeset
  2114
     Enumerates non-meta classes only - not metaclasses"
9506
93a214ce5997 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9496
diff changeset
  2115
93a214ce5997 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9496
diff changeset
  2116
    |collectedClasses|
93a214ce5997 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9496
diff changeset
  2117
93a214ce5997 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9496
diff changeset
  2118
    collectedClasses := OrderedCollection new.
93a214ce5997 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9496
diff changeset
  2119
    self allClassesForWhich:filter do:[:cls |
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2120
	collectedClasses add:cls
9506
93a214ce5997 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9496
diff changeset
  2121
    ].
93a214ce5997 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9496
diff changeset
  2122
    ^ collectedClasses
93a214ce5997 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9496
diff changeset
  2123
93a214ce5997 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9496
diff changeset
  2124
    "
10071
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
  2125
     Smalltalk
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2126
	allClassesForWhich:[:cls | cls name startsWith:'Po']
9506
93a214ce5997 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9496
diff changeset
  2127
    "
93a214ce5997 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9496
diff changeset
  2128
93a214ce5997 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9496
diff changeset
  2129
    "Created: / 10-08-2006 / 12:11:31 / cg"
21489
2c4c8ccda384 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 21458
diff changeset
  2130
    "Modified (comment): / 19-02-2017 / 12:37:49 / cg"
9506
93a214ce5997 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9496
diff changeset
  2131
!
93a214ce5997 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9496
diff changeset
  2132
9292
55e130e5f24b +allClassesForWhich:do:
Claus Gittinger <cg@exept.de>
parents: 9290
diff changeset
  2133
allClassesForWhich:filter do:aBlock
21489
2c4c8ccda384 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 21458
diff changeset
  2134
    "evaluate the argument, aBlock for all classes in the system, for which filter evaluates to true.
2c4c8ccda384 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 21458
diff changeset
  2135
     Enumerates non-meta classes only - not metaclasses"
9292
55e130e5f24b +allClassesForWhich:do:
Claus Gittinger <cg@exept.de>
parents: 9290
diff changeset
  2136
55e130e5f24b +allClassesForWhich:do:
Claus Gittinger <cg@exept.de>
parents: 9290
diff changeset
  2137
    self allClassesDo:[:cls |
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2138
	(filter value:cls) ifTrue:[ aBlock value:cls ].
10071
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
  2139
    ].
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
  2140
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
  2141
    "
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
  2142
     Smalltalk
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2143
	allClassesForWhich:[:cls | cls name startsWith:'Po']
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2144
	do:[:aClass | Transcript showCR:aClass name]
21489
2c4c8ccda384 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 21458
diff changeset
  2145
    "
2c4c8ccda384 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 21458
diff changeset
  2146
2c4c8ccda384 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 21458
diff changeset
  2147
    "Modified (comment): / 19-02-2017 / 12:37:59 / cg"
9292
55e130e5f24b +allClassesForWhich:do:
Claus Gittinger <cg@exept.de>
parents: 9290
diff changeset
  2148
!
55e130e5f24b +allClassesForWhich:do:
Claus Gittinger <cg@exept.de>
parents: 9290
diff changeset
  2149
7563
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  2150
allClassesInCategory:aCategory
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  2151
    "return a collection of for all classes in aCategory;
1299
8f49ec04c9f8 documentation
Claus Gittinger <cg@exept.de>
parents: 1286
diff changeset
  2152
     The order of the classes is not defined."
8f49ec04c9f8 documentation
Claus Gittinger <cg@exept.de>
parents: 1286
diff changeset
  2153
9506
93a214ce5997 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9496
diff changeset
  2154
    ^ self allClassesForWhich:[:cls | cls category = aCategory]
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  2155
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  2156
    "
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  2157
     Smalltalk allClassesInCategory:'Views-Basic'
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  2158
    "
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  2159
9506
93a214ce5997 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9496
diff changeset
  2160
    "Modified: / 10-08-2006 / 12:13:32 / cg"
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  2161
!
1299
8f49ec04c9f8 documentation
Claus Gittinger <cg@exept.de>
parents: 1286
diff changeset
  2162
7563
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  2163
allClassesInCategory:aCategory do:aBlock
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  2164
    "evaluate the argument, aBlock for all classes in the aCategory;
453
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2165
     The order of the classes is not defined."
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2166
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2167
    aCategory notNil ifTrue:[
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  2168
	self allClassesForWhich:[:cls | cls category = aCategory] do:aBlock
453
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2169
    ]
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2170
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2171
    "
9490
b49c5629be33 *** empty log message ***
fm
parents: 9468
diff changeset
  2172
     Smalltalk allClassesInCategory:'Views-Basic' do:[:aClass | Transcript showCR:aClass]
b49c5629be33 *** empty log message ***
fm
parents: 9468
diff changeset
  2173
    "
b49c5629be33 *** empty log message ***
fm
parents: 9468
diff changeset
  2174
b49c5629be33 *** empty log message ***
fm
parents: 9468
diff changeset
  2175
    "Modified: / 09-08-2006 / 17:18:50 / fm"
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  2176
!
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  2177
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  2178
allClassesInCategory:aCategory inOrderDo:aBlock
7563
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  2179
    "evaluate the argument, aBlock for all classes in aCategory;
453
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2180
     superclasses come first - then subclasses"
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2181
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2182
    |classes|
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2183
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2184
    aCategory notNil ifTrue:[
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  2185
	classes := OrderedCollection new.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  2186
	self allClassesInCategory:aCategory do:[:aClass |
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  2187
	    classes add:aClass
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  2188
	].
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  2189
	classes topologicalSort:[:a :b | b isSubclassOf:a].
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  2190
	classes do:aBlock
453
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2191
    ]
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2192
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2193
    "
2588
090cf1da8036 handle abort signal in readEvalPrint loop
Claus Gittinger <cg@exept.de>
parents: 2572
diff changeset
  2194
     Smalltalk allClassesInCategory:'Views-Basic' inOrderDo:[:aClass | aClass name printCR]
453
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2195
    "
6217
e0f4f3959c49 reuse allClassesInCategory-stuff
Claus Gittinger <cg@exept.de>
parents: 6188
diff changeset
  2196
e0f4f3959c49 reuse allClassesInCategory-stuff
Claus Gittinger <cg@exept.de>
parents: 6188
diff changeset
  2197
    "Modified: / 17.11.2001 / 12:18:15 / cg"
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  2198
!
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  2199
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  2200
allClassesInOrderDo:aBlock
7563
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  2201
    "evaluate the argument, aBlock for all classes in the system;
5406
4a6995b61c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5400
diff changeset
  2202
     Evaluation order is by inheritance: superclasses come first."
4a6995b61c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5400
diff changeset
  2203
4a6995b61c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5400
diff changeset
  2204
    |already|
4a6995b61c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5400
diff changeset
  2205
8964
91b012315d91 Avoid rehashing of sets in #allClasses..
Stefan Vogel <sv@exept.de>
parents: 8960
diff changeset
  2206
    already := IdentitySet new:NumberOfClassesHint.
91b012315d91 Avoid rehashing of sets in #allClasses..
Stefan Vogel <sv@exept.de>
parents: 8960
diff changeset
  2207
    self allClassesDo:[:eachClass |
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  2208
	(already includes:eachClass) ifFalse:[
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  2209
	    eachClass allSuperclasses reverseDo:[:eachSuperClass |
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  2210
		(already includes:eachSuperClass) ifFalse:[
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  2211
		    already add:eachSuperClass.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  2212
		    aBlock value:eachSuperClass.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  2213
		].
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  2214
	    ].
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  2215
	    already add:eachClass.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  2216
	    aBlock value:eachClass.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  2217
	]
8964
91b012315d91 Avoid rehashing of sets in #allClasses..
Stefan Vogel <sv@exept.de>
parents: 8960
diff changeset
  2218
    ].
91b012315d91 Avoid rehashing of sets in #allClasses..
Stefan Vogel <sv@exept.de>
parents: 8960
diff changeset
  2219
91b012315d91 Avoid rehashing of sets in #allClasses..
Stefan Vogel <sv@exept.de>
parents: 8960
diff changeset
  2220
    "
91b012315d91 Avoid rehashing of sets in #allClasses..
Stefan Vogel <sv@exept.de>
parents: 8960
diff changeset
  2221
     Smalltalk allClassesInOrderDo:[:aClass | Transcript showCR:aClass name]
5406
4a6995b61c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5400
diff changeset
  2222
    "
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  2223
!
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  2224
9506
93a214ce5997 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9496
diff changeset
  2225
allClassesInPackage:aPackageID
24112
4f6e91819fad #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24094
diff changeset
  2226
    "evaluate the argument, aBlock for all classes in a package;
10087
eb69f28fda88 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10072
diff changeset
  2227
     The order of the classes is not defined.
eb69f28fda88 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10072
diff changeset
  2228
     The returned collection may include private classes"
9506
93a214ce5997 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9496
diff changeset
  2229
93a214ce5997 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9496
diff changeset
  2230
    ^ self allClassesForWhich:[:cls | cls package = aPackageID]
93a214ce5997 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9496
diff changeset
  2231
93a214ce5997 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9496
diff changeset
  2232
    "
10071
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
  2233
     Smalltalk allClassesInPackage:'bosch:dapasx'
9506
93a214ce5997 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9496
diff changeset
  2234
    "
93a214ce5997 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9496
diff changeset
  2235
93a214ce5997 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9496
diff changeset
  2236
    "Created: / 10-08-2006 / 12:14:10 / cg"
10087
eb69f28fda88 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10072
diff changeset
  2237
    "Modified: / 12-10-2006 / 23:48:43 / cg"
24112
4f6e91819fad #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24094
diff changeset
  2238
    "Modified (comment): / 08-05-2019 / 10:56:53 / Claus Gittinger"
9506
93a214ce5997 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9496
diff changeset
  2239
!
93a214ce5997 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9496
diff changeset
  2240
9490
b49c5629be33 *** empty log message ***
fm
parents: 9468
diff changeset
  2241
allClassesInPackage:aPackageID do:aBlock
24112
4f6e91819fad #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24094
diff changeset
  2242
    "evaluate the argument, aBlock for all classes in a package;
9490
b49c5629be33 *** empty log message ***
fm
parents: 9468
diff changeset
  2243
     The order of the classes is not defined."
b49c5629be33 *** empty log message ***
fm
parents: 9468
diff changeset
  2244
b49c5629be33 *** empty log message ***
fm
parents: 9468
diff changeset
  2245
    ^ self allClassesForWhich:[:cls | cls package = aPackageID] do:aBlock
b49c5629be33 *** empty log message ***
fm
parents: 9468
diff changeset
  2246
b49c5629be33 *** empty log message ***
fm
parents: 9468
diff changeset
  2247
    "
10071
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
  2248
     Smalltalk allClassesInPackage:'bosch:dapasx' do:[:aClass | Transcript showCR:aClass]
9490
b49c5629be33 *** empty log message ***
fm
parents: 9468
diff changeset
  2249
    "
b49c5629be33 *** empty log message ***
fm
parents: 9468
diff changeset
  2250
b49c5629be33 *** empty log message ***
fm
parents: 9468
diff changeset
  2251
    "Created: / 09-08-2006 / 17:14:17 / fm"
24112
4f6e91819fad #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24094
diff changeset
  2252
    "Modified (comment): / 08-05-2019 / 10:56:50 / Claus Gittinger"
4f6e91819fad #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24094
diff changeset
  2253
!
4f6e91819fad #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24094
diff changeset
  2254
4f6e91819fad #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24094
diff changeset
  2255
allClassesMatchingCategory:aCategoryPattern
4f6e91819fad #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24094
diff changeset
  2256
    "return a collection of for all classes matching aCategoryPattern;
4f6e91819fad #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24094
diff changeset
  2257
     The order of the classes is not defined."
4f6e91819fad #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24094
diff changeset
  2258
4f6e91819fad #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24094
diff changeset
  2259
    ^ self allClassesForWhich:[:cls | aCategoryPattern match:cls category]
4f6e91819fad #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24094
diff changeset
  2260
4f6e91819fad #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24094
diff changeset
  2261
    "
4f6e91819fad #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24094
diff changeset
  2262
     Smalltalk allClassesInCategory:'Collections-Arrayed'
4f6e91819fad #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24094
diff changeset
  2263
     Smalltalk allClassesMatchingCategory:'Collections-*'
4f6e91819fad #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24094
diff changeset
  2264
    "
4f6e91819fad #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24094
diff changeset
  2265
4f6e91819fad #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24094
diff changeset
  2266
    "Created: / 08-05-2019 / 10:54:47 / Claus Gittinger"
4f6e91819fad #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24094
diff changeset
  2267
!
4f6e91819fad #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24094
diff changeset
  2268
4f6e91819fad #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24094
diff changeset
  2269
allClassesMatchingPackage:aPackageIDPattern
4f6e91819fad #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24094
diff changeset
  2270
    "evaluate the argument, aBlock for all classes matching packagePattern;
4f6e91819fad #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24094
diff changeset
  2271
     The order of the classes is not defined.
4f6e91819fad #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24094
diff changeset
  2272
     The returned collection may include private classes"
4f6e91819fad #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24094
diff changeset
  2273
4f6e91819fad #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24094
diff changeset
  2274
    ^ self allClassesForWhich:[:cls | aPackageIDPattern match:cls package]
4f6e91819fad #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24094
diff changeset
  2275
4f6e91819fad #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24094
diff changeset
  2276
    "
4f6e91819fad #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24094
diff changeset
  2277
     Smalltalk allClassesInPackage:'exept:bridgeFramework'
4f6e91819fad #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24094
diff changeset
  2278
     Smalltalk allClassesMatchingPackage:'exept:bridgeFramework*'
4f6e91819fad #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24094
diff changeset
  2279
    "
4f6e91819fad #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24094
diff changeset
  2280
4f6e91819fad #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24094
diff changeset
  2281
    "Created: / 08-05-2019 / 10:56:10 / Claus Gittinger"
9490
b49c5629be33 *** empty log message ***
fm
parents: 9468
diff changeset
  2282
!
b49c5629be33 *** empty log message ***
fm
parents: 9468
diff changeset
  2283
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  2284
allKeysDo:aBlock
20988
9d8802a18388 #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 20899
diff changeset
  2285
    <resource: #obsolete>
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  2286
    "evaluate the argument, aBlock for all keys in the Smalltalk dictionary"
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  2287
21265
e44b6104a678 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 21188
diff changeset
  2288
    self obsoleteMethodWarning:'please use #keysDo:'.
17385
0d98fa1e74ff class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17369
diff changeset
  2289
    self keysDo:aBlock
21265
e44b6104a678 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 21188
diff changeset
  2290
e44b6104a678 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 21188
diff changeset
  2291
    "Modified: / 20-01-2017 / 17:52:40 / stefan"
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  2292
!
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  2293
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  2294
allMethodCategories
12298
c7d9adb49803 code cleanup
Claus Gittinger <cg@exept.de>
parents: 12287
diff changeset
  2295
    "return a set of all method-categories (protocols) in the system"
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  2296
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  2297
    |allCategories|
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  2298
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  2299
    allCategories := Set new.
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  2300
    Smalltalk allClassesDo:[:cls |
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2301
	allCategories addAll:cls methodCategories.
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  2302
    ].
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  2303
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  2304
    ^ allCategories.
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  2305
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  2306
    "
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  2307
     Smalltalk allMethodCategories
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  2308
    "
21980
85b7b4da26f0 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21928
diff changeset
  2309
85b7b4da26f0 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21928
diff changeset
  2310
    "Modified: / 05-07-2017 / 10:51:50 / cg"
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  2311
!
6722
8388292bc41d allClassesImplementing & allMethodCategories
Claus Gittinger <cg@exept.de>
parents: 6715
diff changeset
  2312
9259
7480ca3bdca9 allMethodsDo: utility
Claus Gittinger <cg@exept.de>
parents: 9254
diff changeset
  2313
allMethodsDo:aBlock
12298
c7d9adb49803 code cleanup
Claus Gittinger <cg@exept.de>
parents: 12287
diff changeset
  2314
    "enumerate all methods in all classes"
12000
21c4d24bdd34 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11977
diff changeset
  2315
9259
7480ca3bdca9 allMethodsDo: utility
Claus Gittinger <cg@exept.de>
parents: 9254
diff changeset
  2316
    Smalltalk allClassesDo:[:eachClass |
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  2317
	eachClass instAndClassSelectorsAndMethodsDo:[:sel :mthd |
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  2318
	    aBlock value:mthd
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  2319
	]
12298
c7d9adb49803 code cleanup
Claus Gittinger <cg@exept.de>
parents: 12287
diff changeset
  2320
    ].
c7d9adb49803 code cleanup
Claus Gittinger <cg@exept.de>
parents: 12287
diff changeset
  2321
!
c7d9adb49803 code cleanup
Claus Gittinger <cg@exept.de>
parents: 12287
diff changeset
  2322
14933
d8b62f31acf5 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 14914
diff changeset
  2323
allMethodsForWhich:aBlock
d8b62f31acf5 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 14914
diff changeset
  2324
    "return a collection of methods for which aBlock returns true"
d8b62f31acf5 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 14914
diff changeset
  2325
d8b62f31acf5 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 14914
diff changeset
  2326
    |coll|
d8b62f31acf5 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 14914
diff changeset
  2327
d8b62f31acf5 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 14914
diff changeset
  2328
    coll := OrderedCollection new.
22015
ebbcacdfac77 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21980
diff changeset
  2329
    self allMethodsForWhich:aBlock do:[:mthd | coll add:mthd].
ebbcacdfac77 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21980
diff changeset
  2330
    ^ coll
ebbcacdfac77 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21980
diff changeset
  2331
ebbcacdfac77 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21980
diff changeset
  2332
    "
ebbcacdfac77 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21980
diff changeset
  2333
     Smalltalk allMethodsForWhich:[:m | m isObsolete].
ebbcacdfac77 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21980
diff changeset
  2334
ebbcacdfac77 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21980
diff changeset
  2335
     Smalltalk allMethodsForWhich:#isObsolete.
ebbcacdfac77 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21980
diff changeset
  2336
    "
ebbcacdfac77 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21980
diff changeset
  2337
ebbcacdfac77 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21980
diff changeset
  2338
    "Modified (comment): / 14-07-2017 / 10:52:54 / cg"
ebbcacdfac77 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21980
diff changeset
  2339
!
ebbcacdfac77 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21980
diff changeset
  2340
ebbcacdfac77 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21980
diff changeset
  2341
allMethodsForWhich:aCheckBlock do:actionBlock
ebbcacdfac77 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21980
diff changeset
  2342
    "enumerate methods for which aCheckBlock returns true"
ebbcacdfac77 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21980
diff changeset
  2343
14933
d8b62f31acf5 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 14914
diff changeset
  2344
    Smalltalk allClassesDo:[:eachClass |
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2345
	eachClass instAndClassSelectorsAndMethodsDo:[:sel :mthd |
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2346
	    (aCheckBlock value:mthd) ifTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2347
		actionBlock value:mthd
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2348
	    ].
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2349
	]
22015
ebbcacdfac77 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21980
diff changeset
  2350
    ].
ebbcacdfac77 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21980
diff changeset
  2351
ebbcacdfac77 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21980
diff changeset
  2352
    "
ebbcacdfac77 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21980
diff changeset
  2353
     Smalltalk allMethodsForWhich:[:m | m isObsolete] do:[:m | Transcript showCR:m].
ebbcacdfac77 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21980
diff changeset
  2354
ebbcacdfac77 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21980
diff changeset
  2355
     Smalltalk allMethodsForWhich:#isObsolete do:[:m | Transcript showCR:m].
ebbcacdfac77 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21980
diff changeset
  2356
    "
ebbcacdfac77 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21980
diff changeset
  2357
ebbcacdfac77 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21980
diff changeset
  2358
    "Created: / 14-07-2017 / 10:51:53 / cg"
14933
d8b62f31acf5 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 14914
diff changeset
  2359
!
d8b62f31acf5 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 14914
diff changeset
  2360
12300
e72e90ea410f changed: #allMethodsWithSelectorDo:
Claus Gittinger <cg@exept.de>
parents: 12299
diff changeset
  2361
allMethodsWithSelectorDo:aTwoArgBlock
13323
68e5bb82f5f7 changed: #loadPackage:fromClassLibrary:
Stefan Vogel <sv@exept.de>
parents: 13303
diff changeset
  2362
    "enumerate all methods in all classes and evaluate aBlock
12300
e72e90ea410f changed: #allMethodsWithSelectorDo:
Claus Gittinger <cg@exept.de>
parents: 12299
diff changeset
  2363
     with method and selector as arguments."
12299
3ed13f5685b9 added: #allMethodsForWhich:do:
Claus Gittinger <cg@exept.de>
parents: 12298
diff changeset
  2364
3ed13f5685b9 added: #allMethodsForWhich:do:
Claus Gittinger <cg@exept.de>
parents: 12298
diff changeset
  2365
    Smalltalk allClassesDo:[:eachClass |
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  2366
	eachClass instAndClassSelectorsAndMethodsDo:[:sel :mthd |
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  2367
	    aTwoArgBlock value:mthd value:sel
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  2368
	]
12299
3ed13f5685b9 added: #allMethodsForWhich:do:
Claus Gittinger <cg@exept.de>
parents: 12298
diff changeset
  2369
    ].
3ed13f5685b9 added: #allMethodsForWhich:do:
Claus Gittinger <cg@exept.de>
parents: 12298
diff changeset
  2370
!
3ed13f5685b9 added: #allMethodsForWhich:do:
Claus Gittinger <cg@exept.de>
parents: 12298
diff changeset
  2371
7563
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  2372
associationsDo:aBlock
10071
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
  2373
    "evaluate the argument, aBlock for all key/value pairs
617
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  2374
     in the Smalltalk dictionary"
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  2375
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  2376
    self keysDo:[:aKey |
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  2377
	aBlock value:(aKey -> (self at:aKey))
617
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  2378
    ]
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  2379
2588
090cf1da8036 handle abort signal in readEvalPrint loop
Claus Gittinger <cg@exept.de>
parents: 2572
diff changeset
  2380
    "Smalltalk associationsDo:[:assoc | assoc printCR]"
617
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  2381
!
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  2382
7563
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  2383
basicKeys
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  2384
    "for rel > 5 only"
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  2385
18349
b5180d38c630 comments only
Claus Gittinger <cg@exept.de>
parents: 18329
diff changeset
  2386
%{
b5180d38c630 comments only
Claus Gittinger <cg@exept.de>
parents: 18329
diff changeset
  2387
#ifdef __SCHTEAM__
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  2388
    STObject[] keys = STSmalltalkEnvironment.GetKeyVector();
18349
b5180d38c630 comments only
Claus Gittinger <cg@exept.de>
parents: 18329
diff changeset
  2389
    return __c__._RETURN( new STVector(keys) );
b5180d38c630 comments only
Claus Gittinger <cg@exept.de>
parents: 18329
diff changeset
  2390
#endif
b5180d38c630 comments only
Claus Gittinger <cg@exept.de>
parents: 18329
diff changeset
  2391
%}.
7563
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  2392
    self primitiveFailed
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  2393
!
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  2394
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  2395
do:aBlock
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  2396
    "evaluate the argument, aBlock for all values in the Smalltalk dictionary"
617
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  2397
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  2398
    |work|
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  2399
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  2400
%{  /* NOREGISTER - work may not be placed into a register here */
1688
8a42db1eea60 removed all COMMA_CON / CON_COMMA uses
Claus Gittinger <cg@exept.de>
parents: 1682
diff changeset
  2401
    __GLOBALS_DO(&aBlock, &work);
5406
4a6995b61c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5400
diff changeset
  2402
    RETURN (self);
4a6995b61c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5400
diff changeset
  2403
%}.
4a6995b61c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5400
diff changeset
  2404
    self keysDo:[:aKey |
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  2405
	aBlock value:(self at:aKey)
5406
4a6995b61c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5400
diff changeset
  2406
    ]
617
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  2407
!
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  2408
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  2409
keysAndValuesDo:aBlock
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  2410
    "evaluate the two-arg block, aBlock for all keys and values"
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  2411
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  2412
    self keysDo:[:aKey |
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  2413
	aBlock value:aKey value:(self at:aKey)
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  2414
    ]
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  2415
!
617
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  2416
9077
327b64542a83 +keysAndValuesSelect:thenCollect:
Claus Gittinger <cg@exept.de>
parents: 9054
diff changeset
  2417
keysAndValuesSelect:selectBlockWith2Args thenCollect:collectBlockWith2Args
327b64542a83 +keysAndValuesSelect:thenCollect:
Claus Gittinger <cg@exept.de>
parents: 9054
diff changeset
  2418
    |collected|
327b64542a83 +keysAndValuesSelect:thenCollect:
Claus Gittinger <cg@exept.de>
parents: 9054
diff changeset
  2419
327b64542a83 +keysAndValuesSelect:thenCollect:
Claus Gittinger <cg@exept.de>
parents: 9054
diff changeset
  2420
    collected := OrderedCollection new.
327b64542a83 +keysAndValuesSelect:thenCollect:
Claus Gittinger <cg@exept.de>
parents: 9054
diff changeset
  2421
    self keysAndValuesDo:[:eachKey :eachValue |
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  2422
	(selectBlockWith2Args value:eachKey value:eachValue) ifTrue:[
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  2423
	    collected add:(collectBlockWith2Args value:eachKey value:eachValue)
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  2424
	].
9077
327b64542a83 +keysAndValuesSelect:thenCollect:
Claus Gittinger <cg@exept.de>
parents: 9054
diff changeset
  2425
    ].
327b64542a83 +keysAndValuesSelect:thenCollect:
Claus Gittinger <cg@exept.de>
parents: 9054
diff changeset
  2426
    ^ collected
327b64542a83 +keysAndValuesSelect:thenCollect:
Claus Gittinger <cg@exept.de>
parents: 9054
diff changeset
  2427
327b64542a83 +keysAndValuesSelect:thenCollect:
Claus Gittinger <cg@exept.de>
parents: 9054
diff changeset
  2428
    "
10071
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
  2429
     Smalltalk
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  2430
	keysAndValuesSelect:[:nm :val | (nm startsWith:'Ab') and:[val notNil]]
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  2431
	thenCollect:[:nm :val | nm]
9077
327b64542a83 +keysAndValuesSelect:thenCollect:
Claus Gittinger <cg@exept.de>
parents: 9054
diff changeset
  2432
    "
327b64542a83 +keysAndValuesSelect:thenCollect:
Claus Gittinger <cg@exept.de>
parents: 9054
diff changeset
  2433
!
327b64542a83 +keysAndValuesSelect:thenCollect:
Claus Gittinger <cg@exept.de>
parents: 9054
diff changeset
  2434
7563
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  2435
keysDo:aBlock
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  2436
    "evaluate the argument, aBlock for all keys in the Smalltalk dictionary"
617
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  2437
    |work|
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  2438
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  2439
%{  /* NOREGISTER - work may not be placed into a register here */
1688
8a42db1eea60 removed all COMMA_CON / CON_COMMA uses
Claus Gittinger <cg@exept.de>
parents: 1682
diff changeset
  2440
    __GLOBALKEYS_DO(&aBlock, &work);
5406
4a6995b61c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5400
diff changeset
  2441
    RETURN (self);
4a6995b61c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5400
diff changeset
  2442
%}.
4a6995b61c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5400
diff changeset
  2443
    self basicKeys do:[:aKey |
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  2444
	aBlock value:aKey
5406
4a6995b61c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5400
diff changeset
  2445
    ]
453
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2446
! !
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2447
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  2448
!Smalltalk class methodsFor:'message control'!
453
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2449
7563
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  2450
silentLoading
12408
6075522e358d changed:
Claus Gittinger <cg@exept.de>
parents: 12377
diff changeset
  2451
    "returns the Silentloading class variable, which globally controls if compilation
6075522e358d changed:
Claus Gittinger <cg@exept.de>
parents: 12377
diff changeset
  2452
     messages are shown on the transcript during a fileIn."
7563
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  2453
10355
b1cb807fd03c Make sure, that #silentLoading does not return nil
Stefan Vogel <sv@exept.de>
parents: 10329
diff changeset
  2454
     ^ SilentLoading ? false
7563
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  2455
!
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  2456
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  2457
silentLoading:aBoolean
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  2458
    "{ Pragma: +optSpace }"
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  2459
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  2460
    "allows access to the Silentloading class variable, which controls
12408
6075522e358d changed:
Claus Gittinger <cg@exept.de>
parents: 12377
diff changeset
  2461
     messages (especially during fileIn) onto the transcript.
453
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2462
     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
  2463
     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
  2464
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2465
    |prev|
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2466
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2467
    prev := SilentLoading.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2468
    SilentLoading := aBoolean.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2469
    ^ prev
12409
f414f3b7e6a0 added: #silentlyLoadingDo:
Claus Gittinger <cg@exept.de>
parents: 12408
diff changeset
  2470
!
f414f3b7e6a0 added: #silentlyLoadingDo:
Claus Gittinger <cg@exept.de>
parents: 12408
diff changeset
  2471
f414f3b7e6a0 added: #silentlyLoadingDo:
Claus Gittinger <cg@exept.de>
parents: 12408
diff changeset
  2472
silentlyLoadingDo:aBlock
f414f3b7e6a0 added: #silentlyLoadingDo:
Claus Gittinger <cg@exept.de>
parents: 12408
diff changeset
  2473
    "evaluates aBlock with silent loading on - no compilation messages (except errors)
f414f3b7e6a0 added: #silentlyLoadingDo:
Claus Gittinger <cg@exept.de>
parents: 12408
diff changeset
  2474
     are shown on the transcript"
f414f3b7e6a0 added: #silentlyLoadingDo:
Claus Gittinger <cg@exept.de>
parents: 12408
diff changeset
  2475
f414f3b7e6a0 added: #silentlyLoadingDo:
Claus Gittinger <cg@exept.de>
parents: 12408
diff changeset
  2476
    |sav|
f414f3b7e6a0 added: #silentlyLoadingDo:
Claus Gittinger <cg@exept.de>
parents: 12408
diff changeset
  2477
20719
1e5ad2bff672 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 20718
diff changeset
  2478
    Smalltalk verbose ifTrue:[
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2479
	^ aBlock value.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2480
    ].
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2481
12409
f414f3b7e6a0 added: #silentlyLoadingDo:
Claus Gittinger <cg@exept.de>
parents: 12408
diff changeset
  2482
    sav := SilentLoading.
f414f3b7e6a0 added: #silentlyLoadingDo:
Claus Gittinger <cg@exept.de>
parents: 12408
diff changeset
  2483
    SilentLoading := true.
22691
df53ad43691d #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 22679
diff changeset
  2484
    ^ aBlock ensure:[ SilentLoading := sav ].
df53ad43691d #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 22679
diff changeset
  2485
df53ad43691d #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 22679
diff changeset
  2486
    "Modified: / 23-04-2018 / 16:56:40 / stefan"
453
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2487
! !
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  2488
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  2489
!Smalltalk class methodsFor:'misc accessing'!
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  2490
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  2491
beHeadless:aBoolean
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  2492
    "set/clear the headlessOperation flag."
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  2493
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  2494
    HeadlessOperation := aBoolean
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  2495
!
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  2496
10231
905030724b3d +isSTScript query.
Claus Gittinger <cg@exept.de>
parents: 10229
diff changeset
  2497
beSTScript:aBoolean
905030724b3d +isSTScript query.
Claus Gittinger <cg@exept.de>
parents: 10229
diff changeset
  2498
    "set/clear the isSTScript flag."
905030724b3d +isSTScript query.
Claus Gittinger <cg@exept.de>
parents: 10229
diff changeset
  2499
905030724b3d +isSTScript query.
Claus Gittinger <cg@exept.de>
parents: 10229
diff changeset
  2500
    IsSTScript := aBoolean
905030724b3d +isSTScript query.
Claus Gittinger <cg@exept.de>
parents: 10229
diff changeset
  2501
905030724b3d +isSTScript query.
Claus Gittinger <cg@exept.de>
parents: 10229
diff changeset
  2502
    "Created: / 06-12-2006 / 16:43:36 / cg"
905030724b3d +isSTScript query.
Claus Gittinger <cg@exept.de>
parents: 10229
diff changeset
  2503
!
905030724b3d +isSTScript query.
Claus Gittinger <cg@exept.de>
parents: 10229
diff changeset
  2504
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  2505
standAloneApp:aBoolean
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  2506
    "set/clear the StandAlone flag."
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  2507
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  2508
    StandAlone := aBoolean
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  2509
! !
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  2510
18197
d3430ee24e46 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17588
diff changeset
  2511
24799
a6a33fc6a3c3 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 24741
diff changeset
  2512
!Smalltalk class methodsFor:'patch support'!
a6a33fc6a3c3 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 24741
diff changeset
  2513
a6a33fc6a3c3 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 24741
diff changeset
  2514
checkClass:classOrClassname forVersion:versionString 
a6a33fc6a3c3 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 24741
diff changeset
  2515
    "when installing patches, check that the class named by classOrClassname exists
a6a33fc6a3c3 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 24741
diff changeset
  2516
     and that the version is <= versionString.
a6a33fc6a3c3 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 24741
diff changeset
  2517
     Raise an exception, if one of the conditions is not met."
a6a33fc6a3c3 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 24741
diff changeset
  2518
    
a6a33fc6a3c3 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 24741
diff changeset
  2519
    |class|
a6a33fc6a3c3 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 24741
diff changeset
  2520
a6a33fc6a3c3 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 24741
diff changeset
  2521
    classOrClassname isBehavior ifTrue:[
a6a33fc6a3c3 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 24741
diff changeset
  2522
        class := classOrClassname.
a6a33fc6a3c3 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 24741
diff changeset
  2523
    ] ifFalse:[
a6a33fc6a3c3 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 24741
diff changeset
  2524
        class := Smalltalk classNamed:classOrClassname.
a6a33fc6a3c3 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 24741
diff changeset
  2525
        class isNil ifTrue:[
a6a33fc6a3c3 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 24741
diff changeset
  2526
            InvalidPatchError 
a6a33fc6a3c3 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 24741
diff changeset
  2527
                raiseErrorString:('patch is for non-existent class %1 (probably for a plugin that is not installed)' 
a6a33fc6a3c3 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 24741
diff changeset
  2528
                        bindWith:classOrClassname).
a6a33fc6a3c3 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 24741
diff changeset
  2529
        ].
a6a33fc6a3c3 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 24741
diff changeset
  2530
    ].
a6a33fc6a3c3 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 24741
diff changeset
  2531
    (versionString compareAsVersionNumberWith:class revision) < 0 ifTrue:[
a6a33fc6a3c3 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 24741
diff changeset
  2532
        InvalidPatchError 
a6a33fc6a3c3 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 24741
diff changeset
  2533
            raiseErrorString:('patch is for older version (%1) of class %2' 
a6a33fc6a3c3 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 24741
diff changeset
  2534
                    bindWith:versionString
a6a33fc6a3c3 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 24741
diff changeset
  2535
                    with:classOrClassname).
a6a33fc6a3c3 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 24741
diff changeset
  2536
    ].
a6a33fc6a3c3 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 24741
diff changeset
  2537
a6a33fc6a3c3 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 24741
diff changeset
  2538
    "
a6a33fc6a3c3 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 24741
diff changeset
  2539
       self checkClass:#Smalltalk forVersion:'200.1'.
a6a33fc6a3c3 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 24741
diff changeset
  2540
       self checkClass:#Smalltalk forVersion:'1.1'.
a6a33fc6a3c3 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 24741
diff changeset
  2541
       self checkClass:#Bla forVersion:'1.1'.
a6a33fc6a3c3 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 24741
diff changeset
  2542
    "
a6a33fc6a3c3 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 24741
diff changeset
  2543
a6a33fc6a3c3 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 24741
diff changeset
  2544
    "Created: / 18-09-2019 / 16:49:48 / Stefan Vogel"
a6a33fc6a3c3 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 24741
diff changeset
  2545
    "Modified (comment): / 20-09-2019 / 10:30:21 / Stefan Vogel"
a6a33fc6a3c3 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 24741
diff changeset
  2546
! !
a6a33fc6a3c3 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 24741
diff changeset
  2547
12250
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2548
!Smalltalk class methodsFor:'private-system management-packages'!
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2549
17324
d9f975e060fb class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17322
diff changeset
  2550
basicLoadPackage:aPackageString fromDirectory:packageDirOrStringOrNil asAutoloaded:doLoadAsAutoloaded
d9f975e060fb class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17322
diff changeset
  2551
    "load a package referenced by aPackageString - a string like 'stx:libbasic'.
d9f975e060fb class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17322
diff changeset
  2552
     The package is either located in packageDirOrStringOrNil, or in the current directory (if nil).
d9f975e060fb class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17322
diff changeset
  2553
     Answer true, if the load succeeded, false if it failed"
d9f975e060fb class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17322
diff changeset
  2554
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2555
    |packageDirOrNil binaryClassLibraryFilename projectDefinitionFilename
19589
3f183fdea754 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 19516
diff changeset
  2556
     projectDefinitionClass projectDefinitionClassName silent somethingHasBeenLoaded
3f183fdea754 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 19516
diff changeset
  2557
     loadOK errorInInitialize|
17324
d9f975e060fb class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17322
diff changeset
  2558
d9f975e060fb class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17322
diff changeset
  2559
    packageDirOrStringOrNil notNil ifTrue:[
23747
1564174fb846 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23714
diff changeset
  2560
        packageDirOrNil := packageDirOrStringOrNil asFilename.
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2561
    ].
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2562
    silent := VerboseLoading not
23747
1564174fb846 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23714
diff changeset
  2563
                and:[SilentLoading or:[StandAlone or:[InfoPrinting not]]].
17324
d9f975e060fb class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17322
diff changeset
  2564
d9f975e060fb class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17322
diff changeset
  2565
    "For now: have to read the project definition first!!
d9f975e060fb class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17322
diff changeset
  2566
     The class library may contain subclasses of classes in prerequisite packages -
19589
3f183fdea754 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 19516
diff changeset
  2567
     so the prerequisite packages have to be loaded first.
3f183fdea754 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 19516
diff changeset
  2568
     Normally there is a project definiton, use that one to pull in the rest"
17324
d9f975e060fb class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17322
diff changeset
  2569
d9f975e060fb class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17322
diff changeset
  2570
    "maybe, it is already in the image"
d9f975e060fb class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17322
diff changeset
  2571
    projectDefinitionClass := ProjectDefinition definitionClassForPackage:aPackageString.
19906
8da8da09ec14 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 19867
diff changeset
  2572
    projectDefinitionClass notNil ifTrue:[
23747
1564174fb846 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23714
diff changeset
  2573
        projectDefinitionClass checkForLoad.
17324
d9f975e060fb class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17322
diff changeset
  2574
    ].
d9f975e060fb class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17322
diff changeset
  2575
d9f975e060fb class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17322
diff changeset
  2576
    "Is there a shared library (.dll or .so) ?"
17439
1928276a394c added class variable IgnoreAssertions
Claus Gittinger <cg@exept.de>
parents: 17438
diff changeset
  2577
    binaryClassLibraryFilename := ObjectFileLoader
23747
1564174fb846 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23714
diff changeset
  2578
                                    binaryClassFilenameForPackage:aPackageString
1564174fb846 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23714
diff changeset
  2579
                                    inDirectory:packageDirOrNil.
17324
d9f975e060fb class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17322
diff changeset
  2580
24123
d3c4267aa343 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24112
diff changeset
  2581
    errorInInitialize := false.
17324
d9f975e060fb class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17322
diff changeset
  2582
    (binaryClassLibraryFilename notNil and:[binaryClassLibraryFilename exists]) ifTrue:[
23873
58b25e1974cc #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23789
diff changeset
  2583
        |loadErrorOccurred|
58b25e1974cc #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23789
diff changeset
  2584
58b25e1974cc #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23789
diff changeset
  2585
        loadErrorOccurred := loadOK := false.
58b25e1974cc #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23789
diff changeset
  2586
58b25e1974cc #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23789
diff changeset
  2587
        [
58b25e1974cc #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23789
diff changeset
  2588
            loadOK := (ObjectFileLoader loadObjectFile:binaryClassLibraryFilename) notNil.
58b25e1974cc #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23789
diff changeset
  2589
            "/ loadOK := self loadPackage:aPackageString fromClassLibrary:binaryClassLibraryFilename.
58b25e1974cc #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23789
diff changeset
  2590
        ] on:PackageNotCompatibleError do:[:ex|
58b25e1974cc #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23789
diff changeset
  2591
            ex reject.
58b25e1974cc #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23789
diff changeset
  2592
        ] on:ObjectFileLoader objectFileLoadErrorNotification do:[:ex|
58b25e1974cc #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23789
diff changeset
  2593
            loadErrorOccurred := true.
58b25e1974cc #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23789
diff changeset
  2594
            ex proceedWith:true.
23747
1564174fb846 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23714
diff changeset
  2595
        ].
23873
58b25e1974cc #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23789
diff changeset
  2596
23747
1564174fb846 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23714
diff changeset
  2597
        (loadOK and:[loadErrorOccurred not]) ifTrue:[
1564174fb846 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23714
diff changeset
  2598
            "now, all compiled classes have been loaded.
1564174fb846 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23714
diff changeset
  2599
             keep classes in the package which are autoloaded as autoloaded."
1564174fb846 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23714
diff changeset
  2600
            ^ true
1564174fb846 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23714
diff changeset
  2601
        ].
1564174fb846 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23714
diff changeset
  2602
1564174fb846 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23714
diff changeset
  2603
        loadErrorOccurred ifTrue:[
1564174fb846 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23714
diff changeset
  2604
            self breakPoint:#cg.
23873
58b25e1974cc #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23789
diff changeset
  2605
            projectDefinitionClass := ProjectDefinition definitionClassForPackage:aPackageString.
58b25e1974cc #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23789
diff changeset
  2606
            projectDefinitionClass notNil ifTrue:[
58b25e1974cc #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23789
diff changeset
  2607
                projectDefinitionClass
58b25e1974cc #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23789
diff changeset
  2608
                    checkForLoad;
58b25e1974cc #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23789
diff changeset
  2609
                    loadPreRequisitesAsAutoloaded:doLoadAsAutoloaded.
58b25e1974cc #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23789
diff changeset
  2610
            ].
23747
1564174fb846 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23714
diff changeset
  2611
        ].
17324
d9f975e060fb class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17322
diff changeset
  2612
    ].
d9f975e060fb class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17322
diff changeset
  2613
    packageDirOrNil isNil ifTrue:[
23747
1564174fb846 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23714
diff changeset
  2614
        ^ PackageNotFoundError raiseRequestWith:aPackageString.
17324
d9f975e060fb class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17322
diff changeset
  2615
    ].
d9f975e060fb class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17322
diff changeset
  2616
23748
d1263269ea99 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23747
diff changeset
  2617
    "fallback - go through the project definition,
d1263269ea99 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23747
diff changeset
  2618
     loading that from source, if available"
17324
d9f975e060fb class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17322
diff changeset
  2619
    projectDefinitionClass isNil ifTrue:[
23747
1564174fb846 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23714
diff changeset
  2620
        projectDefinitionClassName := ProjectDefinition projectDefinitionClassNameForDefinitionOf:aPackageString.
1564174fb846 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23714
diff changeset
  2621
        "/ try to load the project definition class
1564174fb846 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23714
diff changeset
  2622
        projectDefinitionFilename := (packageDirOrNil / projectDefinitionClassName) withSuffix:'st'.
1564174fb846 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23714
diff changeset
  2623
        projectDefinitionFilename exists ifFalse:[
1564174fb846 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23714
diff changeset
  2624
            projectDefinitionFilename := (packageDirOrNil / 'source' / projectDefinitionClassName) withSuffix:'st'.
1564174fb846 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23714
diff changeset
  2625
        ].
1564174fb846 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23714
diff changeset
  2626
        projectDefinitionFilename exists ifTrue:[
1564174fb846 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23714
diff changeset
  2627
            Class withoutUpdatingChangesDo:[
1564174fb846 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23714
diff changeset
  2628
                Smalltalk silentlyLoadingDo:[
1564174fb846 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23714
diff changeset
  2629
                    Error handle:[:ex |
1564174fb846 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23714
diff changeset
  2630
                        "/ catch error during initialization;
1564174fb846 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23714
diff changeset
  2631
                        ex suspendedContext withAllSendersDo:[:sender |
1564174fb846 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23714
diff changeset
  2632
                            (sender selector == #initialize
1564174fb846 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23714
diff changeset
  2633
                                and:[sender receiver isBehavior
1564174fb846 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23714
diff changeset
  2634
                                and:[sender receiver name = projectDefinitionClassName]]
1564174fb846 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23714
diff changeset
  2635
                            ) ifTrue:[
1564174fb846 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23714
diff changeset
  2636
                                errorInInitialize := true
1564174fb846 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23714
diff changeset
  2637
                            ].
1564174fb846 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23714
diff changeset
  2638
                        ].
1564174fb846 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23714
diff changeset
  2639
                        errorInInitialize ifFalse:[ ex reject ].
1564174fb846 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23714
diff changeset
  2640
                    ] do:[
1564174fb846 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23714
diff changeset
  2641
                        projectDefinitionFilename fileIn.
1564174fb846 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23714
diff changeset
  2642
                    ].
1564174fb846 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23714
diff changeset
  2643
                ].
1564174fb846 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23714
diff changeset
  2644
            ].
1564174fb846 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23714
diff changeset
  2645
            errorInInitialize ifTrue:[
1564174fb846 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23714
diff changeset
  2646
                Transcript showCR:'Smalltalk [warning]: an error happened in #initialize - retry after loading package.'.
1564174fb846 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23714
diff changeset
  2647
            ].
1564174fb846 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23714
diff changeset
  2648
            projectDefinitionClass := ProjectDefinition definitionClassForPackage:aPackageString.
1564174fb846 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23714
diff changeset
  2649
        ].
17324
d9f975e060fb class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17322
diff changeset
  2650
    ].
d9f975e060fb class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17322
diff changeset
  2651
    projectDefinitionClass notNil ifTrue:[
23747
1564174fb846 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23714
diff changeset
  2652
        projectDefinitionClass
1564174fb846 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23714
diff changeset
  2653
            autoload;
1564174fb846 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23714
diff changeset
  2654
            checkForLoad;
1564174fb846 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23714
diff changeset
  2655
            loadPreRequisitesAsAutoloaded:doLoadAsAutoloaded.
1564174fb846 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23714
diff changeset
  2656
1564174fb846 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23714
diff changeset
  2657
        somethingHasBeenLoaded := projectDefinitionClass loadAsAutoloaded:doLoadAsAutoloaded.
1564174fb846 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23714
diff changeset
  2658
        errorInInitialize ifTrue:[
1564174fb846 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23714
diff changeset
  2659
            Transcript showCR:('Smalltalk [info]: retrying #initialize').
1564174fb846 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23714
diff changeset
  2660
            projectDefinitionClass initialize.
1564174fb846 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23714
diff changeset
  2661
        ].
1564174fb846 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23714
diff changeset
  2662
        (silent not and:[somethingHasBeenLoaded]) ifTrue:[
1564174fb846 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23714
diff changeset
  2663
            Transcript showCR:('Smalltalk [info]: loaded package: ' , aPackageString , ' from project definition').
1564174fb846 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23714
diff changeset
  2664
        ].
1564174fb846 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23714
diff changeset
  2665
        ^ true.
17324
d9f975e060fb class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17322
diff changeset
  2666
    ].
d9f975e060fb class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17322
diff changeset
  2667
d9f975e060fb class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17322
diff changeset
  2668
    "/ source files-file loading no longer supported
d9f975e060fb class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17322
diff changeset
  2669
    "/ however, allow for autoload-stub loaded
d9f975e060fb class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17322
diff changeset
  2670
    doLoadAsAutoloaded ifTrue:[
23747
1564174fb846 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23714
diff changeset
  2671
        self
1564174fb846 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23714
diff changeset
  2672
            recursiveInstallAutoloadedClassesFrom:packageDirOrNil
1564174fb846 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23714
diff changeset
  2673
            rememberIn:Set new
1564174fb846 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23714
diff changeset
  2674
            maxLevels:2
1564174fb846 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23714
diff changeset
  2675
            noAutoload:false
1564174fb846 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23714
diff changeset
  2676
            packageTop:packageDirOrNil
1564174fb846 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23714
diff changeset
  2677
            showSplashInLevels:0.
1564174fb846 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23714
diff changeset
  2678
        ^ true
17324
d9f975e060fb class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17322
diff changeset
  2679
    ].
d9f975e060fb class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17322
diff changeset
  2680
d9f975e060fb class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17322
diff changeset
  2681
    ^ PackageNotFoundError raiseRequestWith:aPackageString errorString:' - no projectDef, dll or loadAll found'.
d9f975e060fb class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17322
diff changeset
  2682
d9f975e060fb class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17322
diff changeset
  2683
    "
d9f975e060fb class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17322
diff changeset
  2684
     Smalltalk loadPackageWithId:'stx:libbasic'
d9f975e060fb class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17322
diff changeset
  2685
     Smalltalk loadPackageWithId:'stx:goodies/persistency'
d9f975e060fb class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17322
diff changeset
  2686
     Smalltalk loadPackageWithId:'exept:ctypes'
d9f975e060fb class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17322
diff changeset
  2687
    "
d9f975e060fb class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17322
diff changeset
  2688
d9f975e060fb class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17322
diff changeset
  2689
    "Modified: / 29-07-2011 / 19:55:35 / cg"
23873
58b25e1974cc #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23789
diff changeset
  2690
    "Modified: / 12-03-2019 / 18:44:50 / Stefan Vogel"
24123
d3c4267aa343 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24112
diff changeset
  2691
    "Modified: / 15-05-2019 / 17:03:09 / Claus Gittinger"
17324
d9f975e060fb class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17322
diff changeset
  2692
!
d9f975e060fb class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17322
diff changeset
  2693
12250
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2694
loadExtensionsForPackage:aPackageId
13415
ba3e5e6dd910 Jan's changes
vrany
parents: 13385
diff changeset
  2695
    | extensionsLoaded |
13621
85297bc6cfa8 comment/format in: #loadExtensionsForPackage:
Claus Gittinger <cg@exept.de>
parents: 13602
diff changeset
  2696
13415
ba3e5e6dd910 Jan's changes
vrany
parents: 13385
diff changeset
  2697
    extensionsLoaded := false.
18924
f5063aa4e434 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 18868
diff changeset
  2698
    ProgrammingLanguage allDo:[:programmingLanguage|
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2699
	"/ evaluating or here - want all extensions to be loaded
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2700
	extensionsLoaded := extensionsLoaded | (self loadExtensionsForPackage:aPackageId language: programmingLanguage)
13621
85297bc6cfa8 comment/format in: #loadExtensionsForPackage:
Claus Gittinger <cg@exept.de>
parents: 13602
diff changeset
  2701
    ].
85297bc6cfa8 comment/format in: #loadExtensionsForPackage:
Claus Gittinger <cg@exept.de>
parents: 13602
diff changeset
  2702
    ^ extensionsLoaded
13415
ba3e5e6dd910 Jan's changes
vrany
parents: 13385
diff changeset
  2703
ba3e5e6dd910 Jan's changes
vrany
parents: 13385
diff changeset
  2704
    "Modified: / 18-02-2007 / 11:03:26 / cg"
ba3e5e6dd910 Jan's changes
vrany
parents: 13385
diff changeset
  2705
    "Modified: / 02-01-2010 / 10:43:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
13621
85297bc6cfa8 comment/format in: #loadExtensionsForPackage:
Claus Gittinger <cg@exept.de>
parents: 13602
diff changeset
  2706
    "Modified (format): / 04-09-2011 / 09:19:24 / cg"
13415
ba3e5e6dd910 Jan's changes
vrany
parents: 13385
diff changeset
  2707
!
ba3e5e6dd910 Jan's changes
vrany
parents: 13385
diff changeset
  2708
18924
f5063aa4e434 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 18868
diff changeset
  2709
loadExtensionsForPackage:aPackageId language: programmingLanguage
13771
42c23bea6aaf *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 13675
diff changeset
  2710
    |mgr packageDirName inStream projectDefinition extensionsFilename mod dir
13621
85297bc6cfa8 comment/format in: #loadExtensionsForPackage:
Claus Gittinger <cg@exept.de>
parents: 13602
diff changeset
  2711
     extensionsRevisionString extensionsRevisionInfo|
12250
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2712
18924
f5063aa4e434 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 18868
diff changeset
  2713
    programmingLanguage supportsExtensionMethods ifFalse:[^false].
13415
ba3e5e6dd910 Jan's changes
vrany
parents: 13385
diff changeset
  2714
12250
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2715
    packageDirName := aPackageId copyReplaceAll:$: with:$/.
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2716
    packageDirName := self getPackageFileName:packageDirName.
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2717
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2718
    (packageDirName notNil and:[Class tryLocalSourceFirst]) ifTrue:[
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2719
	(self loadExtensionsFromDirectory:packageDirName language: programmingLanguage) ifTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2720
	    ^ true.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2721
	].
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2722
	packageDirName := nil.  "do not try again"
12250
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2723
    ].
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2724
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2725
    "
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2726
     if there is a sourceCodeManager, ask it first for the extensions
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2727
    "
15958
fd69e4694d91 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15872
diff changeset
  2728
    (Smalltalk at:#AbstractSourceCodeManager) notNil ifTrue:[
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2729
	mgr := AbstractSourceCodeManager managerForPackage: aPackageId
15958
fd69e4694d91 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15872
diff changeset
  2730
    ].
12250
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2731
    mgr notNil ifTrue:[
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2732
	extensionsFilename := 'extensions.' , programmingLanguage sourceFileSuffix.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2733
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2734
	projectDefinition := ProjectDefinition definitionClassForPackage:aPackageId.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2735
	projectDefinition notNil ifTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2736
	    mod := aPackageId asPackageId module.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2737
	    dir := aPackageId asPackageId directory.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2738
	    extensionsRevisionString := projectDefinition perform:(mgr nameOfVersionMethodForExtensions) ifNotUnderstood:nil.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2739
	    extensionsRevisionString notNil ifTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2740
		extensionsRevisionInfo := mgr revisionInfoFromString:extensionsRevisionString inClass:nil.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2741
		extensionsRevisionInfo notNil ifTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2742
		    extensionsRevisionInfo fileName = extensionsFilename ifFalse:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2743
			"JV@2011-10-23: following condition is never satisfied for
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2744
			 filed-in packages. The whole scheme of extensionVersion_XXX
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2745
			 works ONLY for compiled packages as it depends on fact, that
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2746
			 extension Init() routine is called AFTER all classes are inited,
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2747
			 therefore the extensionVersion_XXX methods from extensions.st
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2748
			 overwrites methods coming from package definition class. All this
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2749
			 is so tricky and error prone, that we have to come up with better
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2750
			 solution!!"
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2751
			packageDirName notNil ifTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2752
			    ^ self loadExtensionsFromDirectory:packageDirName language: programmingLanguage
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2753
			] ifFalse:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2754
			    ^ false
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2755
			]
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2756
		    ]
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2757
		]
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2758
	    ].
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2759
	    SourceCodeManagerError handle:[:ex |
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2760
	    ] do:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2761
		inStream := mgr streamForExtensionFile:extensionsFilename package:aPackageId directory:dir module:mod cache:true.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2762
	    ].
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2763
	].
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2764
	inStream isNil ifTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2765
	    SourceCodeManagerError handle:[:ex |
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2766
	    ] do:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2767
		inStream := mgr getMostRecentSourceStreamForFile:extensionsFilename inPackage:aPackageId.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2768
	    ].
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2769
	].
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2770
	inStream notNil ifTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2771
	    Class withoutUpdatingChangeSetDo:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2772
		inStream fileIn.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2773
	    ].
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2774
	    inStream close.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2775
	    VerboseLoading ifTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2776
		Transcript showCR:('loaded extensions for ',aPackageId,' from repository').
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2777
	    ].
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2778
	    ^ true
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2779
	]
12250
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2780
    ].
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2781
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2782
    packageDirName notNil ifTrue:[
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2783
	^ self loadExtensionsFromDirectory:packageDirName language: programmingLanguage
12250
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2784
    ].
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2785
    ^ false
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2786
13415
ba3e5e6dd910 Jan's changes
vrany
parents: 13385
diff changeset
  2787
    "Created: / 02-01-2010 / 10:41:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
ba3e5e6dd910 Jan's changes
vrany
parents: 13385
diff changeset
  2788
    "Modified: / 19-03-2011 / 10:03:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
13814
3d547c0d4634 changed:5 methods
Claus Gittinger <cg@exept.de>
parents: 13787
diff changeset
  2789
    "Modified: / 04-11-2011 / 13:41:29 / cg"
15958
fd69e4694d91 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15872
diff changeset
  2790
    "Modified: / 23-10-2011 / 19:35:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
12250
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2791
!
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2792
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2793
loadExtensionsFromDirectory:packageDirOrString
13415
ba3e5e6dd910 Jan's changes
vrany
parents: 13385
diff changeset
  2794
    | extensionsLoaded |
18924
f5063aa4e434 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 18868
diff changeset
  2795
13415
ba3e5e6dd910 Jan's changes
vrany
parents: 13385
diff changeset
  2796
    extensionsLoaded := false.
18924
f5063aa4e434 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 18868
diff changeset
  2797
    ProgrammingLanguage allDo:[:programmingLanguage|
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2798
	"/ evaluating or here - want all extensions to be loaded
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2799
	extensionsLoaded := extensionsLoaded | (self loadExtensionsFromDirectory: packageDirOrString language: programmingLanguage)
18924
f5063aa4e434 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 18868
diff changeset
  2800
    ].
f5063aa4e434 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 18868
diff changeset
  2801
    ^ extensionsLoaded
13415
ba3e5e6dd910 Jan's changes
vrany
parents: 13385
diff changeset
  2802
ba3e5e6dd910 Jan's changes
vrany
parents: 13385
diff changeset
  2803
    "Modified: / 02-01-2010 / 10:40:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
ba3e5e6dd910 Jan's changes
vrany
parents: 13385
diff changeset
  2804
!
ba3e5e6dd910 Jan's changes
vrany
parents: 13385
diff changeset
  2805
ba3e5e6dd910 Jan's changes
vrany
parents: 13385
diff changeset
  2806
loadExtensionsFromDirectory:packageDirOrString language: language
12250
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2807
    |packageDir f|
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2808
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2809
    packageDir := packageDirOrString asFilename.
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2810
13415
ba3e5e6dd910 Jan's changes
vrany
parents: 13385
diff changeset
  2811
    f := packageDir / ('extensions.' , language sourceFileSuffix).
12250
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2812
    f exists ifTrue:[
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  2813
	Class withoutUpdatingChangeSetDo:[
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  2814
	    f fileIn.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  2815
	].
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  2816
	VerboseLoading ifTrue:[
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  2817
	    Transcript showCR:('loaded extensions: ' , f pathName).
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  2818
	].
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  2819
	^ true
15958
fd69e4694d91 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15872
diff changeset
  2820
    ].
fd69e4694d91 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15872
diff changeset
  2821
    ^ true"/false
13415
ba3e5e6dd910 Jan's changes
vrany
parents: 13385
diff changeset
  2822
ba3e5e6dd910 Jan's changes
vrany
parents: 13385
diff changeset
  2823
    "Created: / 02-01-2010 / 10:38:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
13814
3d547c0d4634 changed:5 methods
Claus Gittinger <cg@exept.de>
parents: 13787
diff changeset
  2824
    "Modified: / 04-11-2011 / 13:41:19 / cg"
15958
fd69e4694d91 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15872
diff changeset
  2825
    "Modified: / 31-01-2013 / 11:33:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
12250
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2826
!
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2827
14589
058231c234cb class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 14546
diff changeset
  2828
loadPackage:aPackageStringArg asAutoloaded:doLoadAsAutoloaded
12782
226df0172288 changed: #restart
Stefan Vogel <sv@exept.de>
parents: 12780
diff changeset
  2829
    "make certain, that some particular package is loaded into the system.
13323
68e5bb82f5f7 changed: #loadPackage:fromClassLibrary:
Stefan Vogel <sv@exept.de>
parents: 13303
diff changeset
  2830
     Return true on success, false otherwise."
12782
226df0172288 changed: #restart
Stefan Vogel <sv@exept.de>
parents: 12780
diff changeset
  2831
14589
058231c234cb class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 14546
diff changeset
  2832
    |packageId packageString packageDir def sourceCodeManager|
058231c234cb class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 14546
diff changeset
  2833
17588
05b944f08b13 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17582
diff changeset
  2834
    packageString := aPackageStringArg.
05b944f08b13 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17582
diff changeset
  2835
05b944f08b13 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17582
diff changeset
  2836
    "/ a little convenience: so you can stx packages with loadPackage:'goodies/soap'
05b944f08b13 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17582
diff changeset
  2837
    (packageString includes:$:) ifFalse:[
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2838
	packageString := 'stx:',packageString.
17588
05b944f08b13 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17582
diff changeset
  2839
    ].
12782
226df0172288 changed: #restart
Stefan Vogel <sv@exept.de>
parents: 12780
diff changeset
  2840
13323
68e5bb82f5f7 changed: #loadPackage:fromClassLibrary:
Stefan Vogel <sv@exept.de>
parents: 13303
diff changeset
  2841
    "if I am here, so must my package"
14892
77c2f020de5d class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 14890
diff changeset
  2842
    packageString = self package ifTrue:[^ true].
13129
0ac3f6a28aaf changed: #loadPackage:asAutoloaded:
Claus Gittinger <cg@exept.de>
parents: 13120
diff changeset
  2843
17588
05b944f08b13 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17582
diff changeset
  2844
    packageId := aPackageStringArg asPackageId.
05b944f08b13 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17582
diff changeset
  2845
12782
226df0172288 changed: #restart
Stefan Vogel <sv@exept.de>
parents: 12780
diff changeset
  2846
    "/ if there is a projectDefinition, let it load itself...
14589
058231c234cb class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 14546
diff changeset
  2847
    def := packageId projectDefinitionClass.
14833
c718848b1051 class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 14810
diff changeset
  2848
    (def notNil and:[def isLoaded]) ifTrue:[
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2849
	def loadAsAutoloaded:doLoadAsAutoloaded.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2850
	^ true.
14589
058231c234cb class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 14546
diff changeset
  2851
    ].
058231c234cb class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 14546
diff changeset
  2852
058231c234cb class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 14546
diff changeset
  2853
    packageDir := self packageDirectoryForPackageId:packageId.
16144
3bde1ed36852 class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 16132
diff changeset
  2854
3bde1ed36852 class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 16132
diff changeset
  2855
    [
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2856
	self
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2857
	    loadPackage:packageString
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2858
	    fromDirectory:packageDir
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2859
	    asAutoloaded:doLoadAsAutoloaded.
16144
3bde1ed36852 class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 16132
diff changeset
  2860
    ] on:PackageLoadError do:[:ex|
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2861
	ex creator ~~ PackageNotCompatibleError ifTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2862
	    AbstractSourceCodeManager notNil ifTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2863
		sourceCodeManager := AbstractSourceCodeManager sourceCodeManagerForPackage:packageString.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2864
		sourceCodeManager notNil ifTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2865
		    PackageLoadError handle:[:ex2 |
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2866
			ex reject
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2867
		    ] do:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2868
			^ sourceCodeManager loadPackageWithId:packageString fromRepositoryAsAutoloaded:doLoadAsAutoloaded
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2869
		    ].
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2870
		].
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2871
	    ].
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2872
	].
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  2873
	ex reject.
16144
3bde1ed36852 class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 16132
diff changeset
  2874
    ].
3bde1ed36852 class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 16132
diff changeset
  2875
3bde1ed36852 class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 16132
diff changeset
  2876
    ^ true
12782
226df0172288 changed: #restart
Stefan Vogel <sv@exept.de>
parents: 12780
diff changeset
  2877
226df0172288 changed: #restart
Stefan Vogel <sv@exept.de>
parents: 12780
diff changeset
  2878
    "
226df0172288 changed: #restart
Stefan Vogel <sv@exept.de>
parents: 12780
diff changeset
  2879
     Smalltalk loadPackageWithId:'stx:libbasic'
226df0172288 changed: #restart
Stefan Vogel <sv@exept.de>
parents: 12780
diff changeset
  2880
     Smalltalk loadPackageWithId:'stx:goodies/persistency'
226df0172288 changed: #restart
Stefan Vogel <sv@exept.de>
parents: 12780
diff changeset
  2881
     Smalltalk loadPackageWithId:'exept:ctypes'
226df0172288 changed: #restart
Stefan Vogel <sv@exept.de>
parents: 12780
diff changeset
  2882
    "
226df0172288 changed: #restart
Stefan Vogel <sv@exept.de>
parents: 12780
diff changeset
  2883
13129
0ac3f6a28aaf changed: #loadPackage:asAutoloaded:
Claus Gittinger <cg@exept.de>
parents: 13120
diff changeset
  2884
    "Modified: / 16-11-2010 / 17:42:49 / cg"
12782
226df0172288 changed: #restart
Stefan Vogel <sv@exept.de>
parents: 12780
diff changeset
  2885
!
226df0172288 changed: #restart
Stefan Vogel <sv@exept.de>
parents: 12780
diff changeset
  2886
12250
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2887
loadPackage:packageId fromAllSourceFilesInDirectory:aDirectory
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2888
    "load all source files found in aDirectory and treat them like
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2889
     a package. Allows for initial import of alien ST-code as a new package.
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2890
     Experimental."
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2891
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2892
    |p t new anyFail repeatCount|
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2893
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2894
    "/ problem: dependencies.
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2895
    "/ solution: repeat twice, so that superclasses are present the second time
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2896
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2897
    Class packageQuerySignal answer:packageId asSymbol do:[
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  2898
	|any|
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  2899
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  2900
	repeatCount := 0.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  2901
	[
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  2902
	    repeatCount := repeatCount + 1.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  2903
	    anyFail := false.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  2904
	    aDirectory directoryContents do:[:file |
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  2905
		|fn|
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  2906
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  2907
		fn := aDirectory / file.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  2908
		(fn hasSuffix:'st') ifTrue:[
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  2909
		    Metaclass confirmationQuerySignal answer:false
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  2910
		    do:[
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  2911
			Error
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  2912
			    handle:[:ex |
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  2913
				anyFail := true
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  2914
			    ]
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  2915
			    do:[
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  2916
				(self fileIn:fn) ifFalse:[
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  2917
				    anyFail := true
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  2918
				] ifTrue:[
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  2919
				    any := true.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  2920
				]
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  2921
			    ]
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  2922
		    ]
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  2923
		]
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  2924
	    ].
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  2925
	    any ifFalse:[
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  2926
		^ false "/ no file found
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  2927
	    ]
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  2928
	] doWhile:[anyFail and:[repeatCount<2]].
12250
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2929
    ].
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2930
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2931
    new := (p := Project projectWithId:packageId) isNil.
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2932
    new ifTrue:[ p := Project new].
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2933
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2934
    p name:packageId.
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2935
    p directory:aDirectory.
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2936
    p package:packageId.
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2937
    t := packageId asCollectionOfSubstringsSeparatedByAny:'/\:'.
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2938
    p repositoryModule:(t first).
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2939
    p repositoryDirectory:(packageId copyFrom:t first size + 2).
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2940
    p isLoaded:true.
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2941
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2942
    new ifTrue:[Project addLoadedProject:p].
16144
3bde1ed36852 class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 16132
diff changeset
  2943
    anyFail ifTrue:[
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  2944
	^ PackageLoadError raiseRequestWith:packageId.
16144
3bde1ed36852 class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 16132
diff changeset
  2945
    ].
3bde1ed36852 class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 16132
diff changeset
  2946
    ^ true
12250
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2947
!
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2948
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2949
loadPackage:packageId fromClassLibrary:aFilename
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2950
    "load a package from a compiled classLib.
24405
1cd295707fd7 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24376
diff changeset
  2951
     Raise an error if not ok (only returns false if the error is proceeded)
12250
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2952
     Experimental."
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2953
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2954
    |p t new|
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2955
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2956
    (self fileIn:aFilename) ifFalse:[
24405
1cd295707fd7 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24376
diff changeset
  2957
        (self fileInClassLibrary:aFilename) ifFalse:[
1cd295707fd7 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24376
diff changeset
  2958
            ^ false.
1cd295707fd7 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24376
diff changeset
  2959
        ]
12250
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2960
    ].
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2961
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2962
    new := (p := Project projectWithId:packageId) isNil.
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2963
    new ifTrue:[ p := Project new].
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2964
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2965
    p name:packageId.
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2966
    p directory:aFilename directory.
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2967
    p package:packageId.
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2968
    t := packageId asCollectionOfSubstringsSeparatedByAny:'/\:'.
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2969
    p repositoryModule:(t first).
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2970
    p repositoryDirectory:(packageId copyFrom:t first size + 2).
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2971
    p isLoaded:true.
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2972
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2973
    new ifTrue:[Project addLoadedProject:p].
13323
68e5bb82f5f7 changed: #loadPackage:fromClassLibrary:
Stefan Vogel <sv@exept.de>
parents: 13303
diff changeset
  2974
12250
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2975
    ^ true
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2976
!
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2977
12782
226df0172288 changed: #restart
Stefan Vogel <sv@exept.de>
parents: 12780
diff changeset
  2978
loadPackage:aPackageString fromDirectory:packageDirOrStringOrNil asAutoloaded:doLoadAsAutoloaded
226df0172288 changed: #restart
Stefan Vogel <sv@exept.de>
parents: 12780
diff changeset
  2979
    "load a package referenced by aPackageString - a string like 'stx:libbasic'.
13323
68e5bb82f5f7 changed: #loadPackage:fromClassLibrary:
Stefan Vogel <sv@exept.de>
parents: 13303
diff changeset
  2980
     The package is either located in packageDirOrStringOrNil, or in the current directory (if nil).
68e5bb82f5f7 changed: #loadPackage:fromClassLibrary:
Stefan Vogel <sv@exept.de>
parents: 13303
diff changeset
  2981
     Answer true, if the load succeeded, false if it failed"
68e5bb82f5f7 changed: #loadPackage:fromClassLibrary:
Stefan Vogel <sv@exept.de>
parents: 13303
diff changeset
  2982
23873
58b25e1974cc #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23789
diff changeset
  2983
    ^ PackageLoadInProgressQuery
58b25e1974cc #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23789
diff changeset
  2984
        answerNotifyLoading:aPackageString asSymbol
58b25e1974cc #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23789
diff changeset
  2985
        do:[
58b25e1974cc #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23789
diff changeset
  2986
            self basicLoadPackage:aPackageString fromDirectory:packageDirOrStringOrNil asAutoloaded:doLoadAsAutoloaded
58b25e1974cc #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23789
diff changeset
  2987
        ].
17350
bec30c95e2a4 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17345
diff changeset
  2988
bec30c95e2a4 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17345
diff changeset
  2989
    "
bec30c95e2a4 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17345
diff changeset
  2990
     Smalltalk loadPackage:'stx:goodies/communication'
bec30c95e2a4 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17345
diff changeset
  2991
    "
23873
58b25e1974cc #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23789
diff changeset
  2992
58b25e1974cc #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23789
diff changeset
  2993
    "Modified: / 12-03-2019 / 17:51:58 / Stefan Vogel"
12782
226df0172288 changed: #restart
Stefan Vogel <sv@exept.de>
parents: 12780
diff changeset
  2994
!
226df0172288 changed: #restart
Stefan Vogel <sv@exept.de>
parents: 12780
diff changeset
  2995
12250
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2996
loadPackage:packageId fromLoadAllFile:aFilename
12782
226df0172288 changed: #restart
Stefan Vogel <sv@exept.de>
parents: 12780
diff changeset
  2997
    <resource: #obsolete>
12250
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2998
    "load a package from a loadAll - loader script.
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  2999
     Experimental."
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  3000
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  3001
    |p t new|
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  3002
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  3003
    Metaclass confirmationQuerySignal answer:false
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  3004
    do:[
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  3005
	(self fileIn:aFilename) ifFalse:[
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  3006
	    self warn:'Failed to load the package ', packageId printString.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  3007
	    ^ false.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  3008
	]
12250
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  3009
    ].
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  3010
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  3011
    new := (p := Project projectWithId:packageId) isNil.
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  3012
    new ifTrue:[ p := Project new].
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  3013
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  3014
    p name:packageId.
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  3015
    p directory:aFilename directory.
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  3016
    p package:packageId.
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  3017
    t := packageId asCollectionOfSubstringsSeparatedByAny:'/\:'.
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  3018
    p repositoryModule:(t first).
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  3019
    p repositoryDirectory:(packageId copyFrom:t first size + 2).
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  3020
    p isLoaded:true.
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  3021
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  3022
    new ifTrue:[Project addLoadedProject:p].
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  3023
    ^ true
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  3024
!
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  3025
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  3026
loadPackage:aPackageId fromZIPArchive:f asAutoloaded:doLoadAsAutoloaded
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  3027
    "load a package from a .zip delivery file.
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  3028
     Experimental."
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  3029
19906
8da8da09ec14 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 19867
diff changeset
  3030
    PackageLoadError
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  3031
	raiseWith:aPackageId
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  3032
	errorString:' - package loading from zip is not yet implemented'.
12250
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  3033
!
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  3034
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  3035
loadPackageFromAbbrevFile:aPackageId asAutoloaded:doLoadAsAutoloaded
12782
226df0172288 changed: #restart
Stefan Vogel <sv@exept.de>
parents: 12780
diff changeset
  3036
    <resource: #obsolete>
12250
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  3037
    |abbrevFile packageDir|
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  3038
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  3039
    packageDir := self packageDirectoryForPackageId:aPackageId.
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  3040
    packageDir isNil ifTrue:[^ false].
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  3041
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  3042
    "/ abbrev.stc ?
12377
f9a9aea7ba0f changed:13 methods
Claus Gittinger <cg@exept.de>
parents: 12376
diff changeset
  3043
    abbrevFile := packageDir / 'abbrev.stc'.
12250
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  3044
    abbrevFile exists ifFalse:[^ false].
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  3045
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  3046
    Smalltalk installAutoloadedClassesFrom:abbrevFile pathName.
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  3047
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  3048
    doLoadAsAutoloaded ifFalse:[
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  3049
	"/ force autoloading...
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  3050
	Smalltalk allClassesInPackage:aPackageId do:[:eachClass | eachClass autoload].
12250
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  3051
    ].
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  3052
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  3053
    self loadExtensionsFromDirectory:packageDir.
13814
3d547c0d4634 changed:5 methods
Claus Gittinger <cg@exept.de>
parents: 13787
diff changeset
  3054
    VerboseLoading ifTrue:[
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  3055
	Transcript showCR:('Smalltalk [info]: loaded package: ' , aPackageId , ' from abbrev file: ' , abbrevFile pathName).
12250
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  3056
    ].
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  3057
    ^ true
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  3058
13814
3d547c0d4634 changed:5 methods
Claus Gittinger <cg@exept.de>
parents: 13787
diff changeset
  3059
    "Modified: / 04-11-2011 / 13:43:29 / cg"
12250
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  3060
! !
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  3061
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3062
!Smalltalk class methodsFor:'queries'!
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3063
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3064
allClasses
7563
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  3065
    "return an unordered collection of all classes in the system.
10071
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
  3066
     Only globally anchored classes are returned
21489
2c4c8ccda384 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 21458
diff changeset
  3067
     (i.e. anonymous ones have to be acquired by Behavior allSubInstances).
2c4c8ccda384 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 21458
diff changeset
  3068
     Enumerates non-meta classes only - not metaclasses"
453
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  3069
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  3070
    |classes|
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  3071
745
d16f199a1551 added imageStart & restart timestamps
Claus Gittinger <cg@exept.de>
parents: 736
diff changeset
  3072
    "/ you may wonder, what this while is for, here ...
453
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  3073
    "/ the reason is that if we modify the class hierarchy in
4067
732848627915 comment
Claus Gittinger <cg@exept.de>
parents: 4048
diff changeset
  3074
    "/ another view (background fileIn), while building up the
453
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  3075
    "/ cachedClasses set, this may be flushed (invalidated) by the
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  3076
    "/ other process in the meanwhile.
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  3077
    "/ If that happens, we restart the set-building here
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  3078
    "/
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  3079
    [(classes := CachedClasses) isNil] whileTrue:[
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  3080
	CachedClasses := classes := IdentitySet new:NumberOfClassesHint.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  3081
	self keysAndValuesDo:[:eachName :eachGlobal |
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  3082
	    (eachGlobal notNil and:[eachGlobal isBehavior]) ifTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  3083
		"/ sigh - would like to skip over aliases
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  3084
		"/ but this cannot be done simply by comparing
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  3085
		"/ the classes name against the store-key
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  3086
		"/ i.e. cannot do:
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  3087
		"/      anObject name == sym ifTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  3088
		"/          classes add:anObject
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  3089
		"/      ]
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  3090
		"/ because that would lead to ignore all java
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  3091
		"/ classes, which are stored under a different
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  3092
		"/ key.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  3093
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  3094
		(eachGlobal name == eachName
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  3095
		 or:[eachGlobal isJavaClass]) ifTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  3096
		    classes add:eachGlobal
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  3097
		].
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  3098
	    ]
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  3099
	].
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  3100
	NumberOfClassesHint := classes size.
453
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  3101
    ].
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  3102
    ^ classes
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  3103
8964
91b012315d91 Avoid rehashing of sets in #allClasses..
Stefan Vogel <sv@exept.de>
parents: 8960
diff changeset
  3104
    "
91b012315d91 Avoid rehashing of sets in #allClasses..
Stefan Vogel <sv@exept.de>
parents: 8960
diff changeset
  3105
     CachedClasses := nil.
453
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  3106
     Smalltalk allClasses
745
d16f199a1551 added imageStart & restart timestamps
Claus Gittinger <cg@exept.de>
parents: 736
diff changeset
  3107
d16f199a1551 added imageStart & restart timestamps
Claus Gittinger <cg@exept.de>
parents: 736
diff changeset
  3108
    to get the list sorted by name:
d16f199a1551 added imageStart & restart timestamps
Claus Gittinger <cg@exept.de>
parents: 736
diff changeset
  3109
d16f199a1551 added imageStart & restart timestamps
Claus Gittinger <cg@exept.de>
parents: 736
diff changeset
  3110
     Smalltalk allClasses asSortedCollection:[:a :b | a name < b name]
453
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  3111
    "
745
d16f199a1551 added imageStart & restart timestamps
Claus Gittinger <cg@exept.de>
parents: 736
diff changeset
  3112
13851
5ab434e0a636 changed: #mainStartup: for scripting stand alone apps
Claus Gittinger <cg@exept.de>
parents: 13850
diff changeset
  3113
    "Modified: / 06-12-2011 / 12:41:42 / cg"
21489
2c4c8ccda384 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 21458
diff changeset
  3114
    "Modified (comment): / 19-02-2017 / 12:38:42 / cg"
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3115
!
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3116
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3117
allClassesAndMetaclasses
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3118
    "return an unordered collection of all classes with their metaclasses in the system."
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3119
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3120
    |classes|
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3121
8964
91b012315d91 Avoid rehashing of sets in #allClasses..
Stefan Vogel <sv@exept.de>
parents: 8960
diff changeset
  3122
    classes := IdentitySet new:NumberOfClassesHint*2.
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3123
    self allClassesDo:[:eachClass |
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  3124
	classes add:(eachClass theNonMetaclass).
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  3125
	classes add:(eachClass theMetaclass).
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3126
    ].
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3127
    ^ classes
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3128
!
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3129
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3130
allClassesWithAllPrivateClasses
7563
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  3131
    "return an unordered collection of all classes in the Smalltalk namespace.
10173
765b385fd1b8 changed #listAtCategoryNamed:
Claus Gittinger <cg@exept.de>
parents: 10169
diff changeset
  3132
     Only globally anchored classes are returned; Namespaces are not included.
20122
fa7bde6ba891 #OTHER by mawalch
mawalch
parents: 19992
diff changeset
  3133
     (i.e. anonymous ones have to be acquired by Behavior allSubInstances)"
4642
fa212209890c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4630
diff changeset
  3134
10071
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
  3135
    ^ self allClasses select:[:aClass |
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  3136
	    |owner|
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  3137
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  3138
	    (aClass isRealNameSpace not)
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  3139
	    and:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  3140
		owner := aClass topOwningClass.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  3141
		(owner ? aClass) nameSpace == Smalltalk
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  3142
	    ]
4642
fa212209890c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4630
diff changeset
  3143
      ]
fa212209890c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4630
diff changeset
  3144
fa212209890c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4630
diff changeset
  3145
    "
fa212209890c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4630
diff changeset
  3146
     Smalltalk allClassesWithAllPrivateClasses
fa212209890c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4630
diff changeset
  3147
    "
10173
765b385fd1b8 changed #listAtCategoryNamed:
Claus Gittinger <cg@exept.de>
parents: 10169
diff changeset
  3148
765b385fd1b8 changed #listAtCategoryNamed:
Claus Gittinger <cg@exept.de>
parents: 10169
diff changeset
  3149
    "Modified: / 10-11-2006 / 17:24:00 / cg"
4642
fa212209890c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4630
diff changeset
  3150
!
fa212209890c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4630
diff changeset
  3151
15068
e9075c481268 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15009
diff changeset
  3152
allExtensions
e9075c481268 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15009
diff changeset
  3153
    "return a collection of all extension methods (methods added from another package)"
e9075c481268 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15009
diff changeset
  3154
e9075c481268 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15009
diff changeset
  3155
    |methods|
e9075c481268 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15009
diff changeset
  3156
e9075c481268 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15009
diff changeset
  3157
    methods := OrderedCollection new.
e9075c481268 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15009
diff changeset
  3158
    self allClassesDo:[:eachClass |
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  3159
	|classPackage|
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  3160
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  3161
	classPackage := eachClass package.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  3162
	eachClass instAndClassMethodsDo:[:mthd |
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  3163
	    mthd package ~= classPackage ifTrue:[ methods add:mthd ].
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  3164
	].
15068
e9075c481268 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15009
diff changeset
  3165
    ].
e9075c481268 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15009
diff changeset
  3166
    ^ methods
e9075c481268 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15009
diff changeset
  3167
e9075c481268 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15009
diff changeset
  3168
    "
e9075c481268 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15009
diff changeset
  3169
     Smalltalk allExtensions
e9075c481268 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15009
diff changeset
  3170
    "
e9075c481268 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15009
diff changeset
  3171
!
e9075c481268 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15009
diff changeset
  3172
11153
ec11603c6e7e code reuse
Claus Gittinger <cg@exept.de>
parents: 11150
diff changeset
  3173
allExtensionsForPackage:aProjectID
14890
37618c9121f2 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 14833
diff changeset
  3174
    "return a collection of all extension methods for a given projectID"
37618c9121f2 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 14833
diff changeset
  3175
11153
ec11603c6e7e code reuse
Claus Gittinger <cg@exept.de>
parents: 11150
diff changeset
  3176
    |methods|
ec11603c6e7e code reuse
Claus Gittinger <cg@exept.de>
parents: 11150
diff changeset
  3177
ec11603c6e7e code reuse
Claus Gittinger <cg@exept.de>
parents: 11150
diff changeset
  3178
    methods := OrderedCollection new.
ec11603c6e7e code reuse
Claus Gittinger <cg@exept.de>
parents: 11150
diff changeset
  3179
    self allClassesDo:[:eachClass |
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  3180
	methods addAll:(eachClass extensionsFrom:aProjectID).
11153
ec11603c6e7e code reuse
Claus Gittinger <cg@exept.de>
parents: 11150
diff changeset
  3181
    ].
ec11603c6e7e code reuse
Claus Gittinger <cg@exept.de>
parents: 11150
diff changeset
  3182
    ^ methods
ec11603c6e7e code reuse
Claus Gittinger <cg@exept.de>
parents: 11150
diff changeset
  3183
!
ec11603c6e7e code reuse
Claus Gittinger <cg@exept.de>
parents: 11150
diff changeset
  3184
9227
3aca7dee958d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9211
diff changeset
  3185
allImplementorsOf:aSelector
12919
a7ea070197c9 comment/format in: #allImplementorsOf:
Claus Gittinger <cg@exept.de>
parents: 12911
diff changeset
  3186
    "return a collection of classes which implement the given selector"
a7ea070197c9 comment/format in: #allImplementorsOf:
Claus Gittinger <cg@exept.de>
parents: 12911
diff changeset
  3187
9227
3aca7dee958d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9211
diff changeset
  3188
    |implementors|
3aca7dee958d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9211
diff changeset
  3189
3aca7dee958d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9211
diff changeset
  3190
    implementors := OrderedCollection new.
19681
ec20967ae600 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 19597
diff changeset
  3191
    self allImplementorsOf:aSelector do:[:cls | implementors add:cls].
ec20967ae600 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 19597
diff changeset
  3192
    ^ implementors
ec20967ae600 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 19597
diff changeset
  3193
ec20967ae600 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 19597
diff changeset
  3194
    "
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  3195
     Smalltalk allImplementorsOf:#isNil
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  3196
     (Smalltalk allImplementorsOf:#add:) size
19681
ec20967ae600 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 19597
diff changeset
  3197
    "
ec20967ae600 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 19597
diff changeset
  3198
ec20967ae600 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 19597
diff changeset
  3199
    "Modified: / 30-04-2016 / 17:37:39 / cg"
ec20967ae600 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 19597
diff changeset
  3200
!
ec20967ae600 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 19597
diff changeset
  3201
ec20967ae600 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 19597
diff changeset
  3202
allImplementorsOf:aSelector do:aBlock
ec20967ae600 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 19597
diff changeset
  3203
    "enumerate all classes which implement the given selector"
ec20967ae600 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 19597
diff changeset
  3204
9227
3aca7dee958d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9211
diff changeset
  3205
    self allClassesDo:[:cls |
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  3206
	(cls includesSelector:aSelector) ifTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  3207
	    aBlock value:cls.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  3208
	].
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  3209
	(cls class includesSelector:aSelector) ifTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  3210
	    aBlock value:cls class.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  3211
	].
19681
ec20967ae600 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 19597
diff changeset
  3212
    ].
ec20967ae600 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 19597
diff changeset
  3213
ec20967ae600 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 19597
diff changeset
  3214
    "
ec20967ae600 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 19597
diff changeset
  3215
     Smalltalk allImplementorsOf:#isNil do:[:cls | Transcript showCR:cls]
ec20967ae600 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 19597
diff changeset
  3216
     Smalltalk allImplementorsOf:#add: do:[:cls | Transcript showCR:cls]
ec20967ae600 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 19597
diff changeset
  3217
    "
ec20967ae600 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 19597
diff changeset
  3218
ec20967ae600 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 19597
diff changeset
  3219
    "Created: / 30-04-2016 / 17:36:45 / cg"
9227
3aca7dee958d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9211
diff changeset
  3220
!
3aca7dee958d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9211
diff changeset
  3221
19475
33b989d0287a #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19430
diff changeset
  3222
allLoadedPackageIDs
33b989d0287a #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19430
diff changeset
  3223
33b989d0287a #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19430
diff changeset
  3224
    ^ self allPackageIdsIncludingUnloadedClasses: false
33b989d0287a #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19430
diff changeset
  3225
33b989d0287a #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19430
diff changeset
  3226
33b989d0287a #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19430
diff changeset
  3227
    "
33b989d0287a #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19430
diff changeset
  3228
     Smalltalk allLoadedPackageIDs
33b989d0287a #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19430
diff changeset
  3229
    "
33b989d0287a #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19430
diff changeset
  3230
!
33b989d0287a #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19430
diff changeset
  3231
12376
fm
parents: 12358
diff changeset
  3232
allLoadedProjectIDs
19475
33b989d0287a #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19430
diff changeset
  3233
    <resource: #obsolete>
33b989d0287a #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19430
diff changeset
  3234
    self obsoleteMethodWarning:'use allLoadedPackageIDs'.
33b989d0287a #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19430
diff changeset
  3235
    ^ self allPackageIdsIncludingUnloadedClasses: false
12376
fm
parents: 12358
diff changeset
  3236
fm
parents: 12358
diff changeset
  3237
fm
parents: 12358
diff changeset
  3238
    "
fm
parents: 12358
diff changeset
  3239
     Smalltalk allLoadedProjectIDs
fm
parents: 12358
diff changeset
  3240
    "
fm
parents: 12358
diff changeset
  3241
!
fm
parents: 12358
diff changeset
  3242
19475
33b989d0287a #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19430
diff changeset
  3243
allPackageIDs
33b989d0287a #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19430
diff changeset
  3244
33b989d0287a #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19430
diff changeset
  3245
    ^ self allPackageIdsIncludingUnloadedClasses: true
33b989d0287a #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19430
diff changeset
  3246
33b989d0287a #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19430
diff changeset
  3247
    "
33b989d0287a #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19430
diff changeset
  3248
     Smalltalk allPackageIDs
33b989d0287a #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19430
diff changeset
  3249
    "
33b989d0287a #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19430
diff changeset
  3250
!
33b989d0287a #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19430
diff changeset
  3251
33b989d0287a #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19430
diff changeset
  3252
allPackageIdsIncludingUnloadedClasses: includeUnloadedClasses
33b989d0287a #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19430
diff changeset
  3253
    "Returns all package ids.
33b989d0287a #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19430
diff changeset
  3254
     Excludes packages coming from unloaded classes if includeUnloadedClasses is false.
33b989d0287a #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19430
diff changeset
  3255
    "
33b989d0287a #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19430
diff changeset
  3256
33b989d0287a #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19430
diff changeset
  3257
    |allProjects|
33b989d0287a #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19430
diff changeset
  3258
33b989d0287a #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19430
diff changeset
  3259
    allProjects := Set new.
33b989d0287a #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19430
diff changeset
  3260
    self allClassesDo:[:eachClass |
23789
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  3261
        |cls pkg|
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  3262
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  3263
        eachClass isRealNameSpace ifFalse:[
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  3264
            (includeUnloadedClasses or:[eachClass isLoaded]) ifTrue:[
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  3265
                cls := eachClass theNonMetaclass.
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  3266
                cls isPrivate ifTrue:[
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  3267
                    cls := cls topOwningClass
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  3268
                ].
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  3269
                pkg := cls package.
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  3270
                pkg size ~~ 0 ifTrue:[
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  3271
                    allProjects add:pkg.
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  3272
                ] ifFalse:[
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  3273
                    "/ for now, nameSpaces are not in any package;
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  3274
                    "/ this might change. Then, 0-sized packages are
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  3275
                    "/ illegal, and the following should be enabled.
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  3276
                    "/ self halt
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  3277
                ].
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  3278
                cls isJavaClass ifFalse:[
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  3279
                    cls instAndClassSelectorsAndMethodsDo:[:sel :mthd |
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  3280
                        allProjects add:mthd package asSymbol.
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  3281
                    ].
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  3282
                ].
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  3283
            ].
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  3284
        ].
19475
33b989d0287a #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19430
diff changeset
  3285
    ].
33b989d0287a #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19430
diff changeset
  3286
    allProjects := allProjects asOrderedCollection sort.
33b989d0287a #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19430
diff changeset
  3287
    ^ allProjects
33b989d0287a #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19430
diff changeset
  3288
33b989d0287a #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19430
diff changeset
  3289
    "
33b989d0287a #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19430
diff changeset
  3290
     Smalltalk allProjectsIdsIncludingUnloadedClasses: true
33b989d0287a #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19430
diff changeset
  3291
     Smalltalk allProjectsIdsIncludingUnloadedClasses: false
33b989d0287a #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19430
diff changeset
  3292
    "
23789
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  3293
afa1be88c07e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23773
diff changeset
  3294
    "Modified: / 01-03-2019 / 16:11:49 / Claus Gittinger"
19475
33b989d0287a #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19430
diff changeset
  3295
!
33b989d0287a #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19430
diff changeset
  3296
9254
9fc5d873b646 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9252
diff changeset
  3297
allProjectIDs
19475
33b989d0287a #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19430
diff changeset
  3298
    <resource: #obsolete>
33b989d0287a #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19430
diff changeset
  3299
    self obsoleteMethodWarning:'use allPackageIDs'.
33b989d0287a #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19430
diff changeset
  3300
    ^ self allPackageIDs
12376
fm
parents: 12358
diff changeset
  3301
fm
parents: 12358
diff changeset
  3302
    "
fm
parents: 12358
diff changeset
  3303
     Smalltalk allProjectIDs
fm
parents: 12358
diff changeset
  3304
    "
fm
parents: 12358
diff changeset
  3305
!
fm
parents: 12358
diff changeset
  3306
fm
parents: 12358
diff changeset
  3307
allProjectsIdsIncludingUnloadedClasses: includeUnloadedClasses
19475
33b989d0287a #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19430
diff changeset
  3308
    <resource: #obsolete>
12376
fm
parents: 12358
diff changeset
  3309
    "Returns all projects ids.
fm
parents: 12358
diff changeset
  3310
     Excludes projects coming from unloaded classes if includeUnloadedClasses is false.
fm
parents: 12358
diff changeset
  3311
    "
fm
parents: 12358
diff changeset
  3312
19475
33b989d0287a #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19430
diff changeset
  3313
    self obsoleteMethodWarning:'use allPackageIdsIncludingUnloadedClasses:'.
33b989d0287a #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19430
diff changeset
  3314
    ^ self allPackageIdsIncludingUnloadedClasses: includeUnloadedClasses
9254
9fc5d873b646 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9252
diff changeset
  3315
9fc5d873b646 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9252
diff changeset
  3316
    "
12376
fm
parents: 12358
diff changeset
  3317
     Smalltalk allProjectsIdsIncludingUnloadedClasses: true
fm
parents: 12358
diff changeset
  3318
     Smalltalk allProjectsIdsIncludingUnloadedClasses: false
9254
9fc5d873b646 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9252
diff changeset
  3319
    "
9fc5d873b646 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9252
diff changeset
  3320
!
9fc5d873b646 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9252
diff changeset
  3321
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3322
cellAt:aName
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3323
    "{ Pragma: +optSpace }"
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3324
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3325
    "return the address of a global cell
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3326
     - used internally for compiler only"
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3327
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3328
%{  /* NOCONTEXT */
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3329
    RETURN ( __GLOBAL_GETCELL(aName) );
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3330
%}.
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3331
    ^ self primitiveFailed
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3332
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3333
!
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3334
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3335
classCategoryCompletion:aPartialCategory
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3336
    "given a partial class category name, return an array consisting of
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3337
     2 entries: 1st: the best (longest) match
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  3338
		2nd: collection consisting of matching categories"
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3339
9508
564f30f49b1b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9506
diff changeset
  3340
    ^ DoWhatIMeanSupport classCategoryCompletion:aPartialCategory inEnvironment:self
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3341
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3342
    "
10071
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
  3343
     Smalltalk classCategoryCompletion:'Sys'
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
  3344
     Smalltalk classCategoryCompletion:'System'
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
  3345
     Smalltalk classCategoryCompletion:'System-BinaryStorage'
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3346
    "
9508
564f30f49b1b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9506
diff changeset
  3347
564f30f49b1b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9506
diff changeset
  3348
    "Modified: / 10-08-2006 / 13:06:34 / cg"
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3349
!
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3350
8570
0a7f80cc592f version bump
ca
parents: 8567
diff changeset
  3351
classNamed:aString
0a7f80cc592f version bump
ca
parents: 8567
diff changeset
  3352
    "return the class with name aString, or nil if absent.
0a7f80cc592f version bump
ca
parents: 8567
diff changeset
  3353
     To get to the metaClass, append ' class' to the string.
9374
8198d65aadd3 #classNamed: now loads autoloaded classes if a (possibly) private class of an
Stefan Vogel <sv@exept.de>
parents: 9292
diff changeset
  3354
     To get a nameSpace or private class, prefix the name as required.
8198d65aadd3 #classNamed: now loads autoloaded classes if a (possibly) private class of an
Stefan Vogel <sv@exept.de>
parents: 9292
diff changeset
  3355
     If a private class of an autoloaded class is referenced, the owning class
8198d65aadd3 #classNamed: now loads autoloaded classes if a (possibly) private class of an
Stefan Vogel <sv@exept.de>
parents: 9292
diff changeset
  3356
     will be loaded."
8198d65aadd3 #classNamed: now loads autoloaded classes if a (possibly) private class of an
Stefan Vogel <sv@exept.de>
parents: 9292
diff changeset
  3357
10127
70e1b66ceae1 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10126
diff changeset
  3358
    |cls sym nonMeta idx prefix rest namespace nsNameSymbol|
9374
8198d65aadd3 #classNamed: now loads autoloaded classes if a (possibly) private class of an
Stefan Vogel <sv@exept.de>
parents: 9292
diff changeset
  3359
8198d65aadd3 #classNamed: now loads autoloaded classes if a (possibly) private class of an
Stefan Vogel <sv@exept.de>
parents: 9292
diff changeset
  3360
    "Quick try - if everything is loaded, this will succeed.
8198d65aadd3 #classNamed: now loads autoloaded classes if a (possibly) private class of an
Stefan Vogel <sv@exept.de>
parents: 9292
diff changeset
  3361
     But be careful, to not invent new symbols ..."
453
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  3362
    sym := aString asSymbolIfInterned.
22650
580198cee5f9 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 22636
diff changeset
  3363
    sym isSymbol ifTrue:[
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  3364
	cls := self at:sym ifAbsent:nil.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  3365
	cls isBehavior ifTrue:[^ cls].
9374
8198d65aadd3 #classNamed: now loads autoloaded classes if a (possibly) private class of an
Stefan Vogel <sv@exept.de>
parents: 9292
diff changeset
  3366
    ].
8198d65aadd3 #classNamed: now loads autoloaded classes if a (possibly) private class of an
Stefan Vogel <sv@exept.de>
parents: 9292
diff changeset
  3367
1480
df0bea6285f8 Change the name of a classes Metaclass from e.g. "SmallIntegerclass" to
Stefan Vogel <sv@exept.de>
parents: 1461
diff changeset
  3368
    (aString endsWith:' class') ifTrue:[
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  3369
	nonMeta := self classNamed:(aString copyButLast:6).
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  3370
	nonMeta notNil ifTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  3371
	    ^ nonMeta theMetaclass
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  3372
	].
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  3373
	^ nil.
13602
5fe3c7ce7d7e comment/format in: #classNamed:
Claus Gittinger <cg@exept.de>
parents: 13601
diff changeset
  3374
    ].
5fe3c7ce7d7e comment/format in: #classNamed:
Claus Gittinger <cg@exept.de>
parents: 13601
diff changeset
  3375
5fe3c7ce7d7e comment/format in: #classNamed:
Claus Gittinger <cg@exept.de>
parents: 13601
diff changeset
  3376
    "no success yet. Try if this is a private class of an autoloaded class"
9374
8198d65aadd3 #classNamed: now loads autoloaded classes if a (possibly) private class of an
Stefan Vogel <sv@exept.de>
parents: 9292
diff changeset
  3377
    cls isNil ifTrue:[
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  3378
	idx := aString indexOfSubCollection:'::'.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  3379
	idx ~~ 0 ifTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  3380
	    prefix := aString copyTo:idx-1.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  3381
	    nsNameSymbol := prefix asSymbolIfInterned.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  3382
	    nsNameSymbol notNil ifTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  3383
		rest := aString copyFrom:idx+2.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  3384
		namespace := self at:prefix asSymbolIfInterned ifAbsent:nil.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  3385
		"namespace may be the owner of a private class.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  3386
		 NameSpaces and Behaviors have the same protocol"
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  3387
		[namespace isBehavior] whileTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  3388
		    idx := rest indexOfSubCollection:'::'.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  3389
		    idx ~~ 0 ifTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  3390
			prefix := rest copyTo:idx-1.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  3391
			rest := rest copyFrom:idx+2.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  3392
			"this does an implicit autoload if required"
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  3393
			namespace := namespace privateClassesAt:prefix.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  3394
		    ] ifFalse:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  3395
			namespace isLoaded ifTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  3396
			    cls := namespace privateClassesAt:rest.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  3397
			    cls isBehavior ifTrue:[^ cls].
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  3398
			].
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  3399
			namespace := nil.   "force exit of loop"
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  3400
		    ].
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  3401
		].
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  3402
	    ].
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  3403
	].
9374
8198d65aadd3 #classNamed: now loads autoloaded classes if a (possibly) private class of an
Stefan Vogel <sv@exept.de>
parents: 9292
diff changeset
  3404
    ].
8198d65aadd3 #classNamed: now loads autoloaded classes if a (possibly) private class of an
Stefan Vogel <sv@exept.de>
parents: 9292
diff changeset
  3405
453
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  3406
    ^ nil
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  3407
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  3408
    "
10071
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
  3409
     Smalltalk classNamed:'Object'
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
  3410
     Smalltalk classNamed:'Authentication::BasicAuthenticator::BasicAuthenticationData'
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
  3411
     Smalltalk classNamed:'Authentication::BasicAuthenticator::BasicAuthenticationData class'
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
  3412
     Smalltalk classNamed:'Authentication::BasicAuthenticator'
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
  3413
     Smalltalk classNamed:'fooBar'
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
  3414
     Smalltalk classNamed:'true'
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
  3415
     Smalltalk classNamed:'Object class'
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
  3416
     Smalltalk classNamed:'Metaclass'
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
  3417
     Smalltalk classNamed:'Array'
9374
8198d65aadd3 #classNamed: now loads autoloaded classes if a (possibly) private class of an
Stefan Vogel <sv@exept.de>
parents: 9292
diff changeset
  3418
     Smalltalk classNamed:'Array class'
453
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  3419
    "
644
9363244ef25d classNamed: fixed for metaclasses; handle matchCharacters in classNameCompletion
Claus Gittinger <cg@exept.de>
parents: 630
diff changeset
  3420
9468
2472391c602c bumped revision
Claus Gittinger <cg@exept.de>
parents: 9377
diff changeset
  3421
    "Created: / 24-11-1995 / 17:30:22 / cg"
2472391c602c bumped revision
Claus Gittinger <cg@exept.de>
parents: 9377
diff changeset
  3422
    "Modified: / 19-06-1996 / 14:22:21 / stefan"
10127
70e1b66ceae1 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10126
diff changeset
  3423
    "Modified: / 23-10-2006 / 18:06:53 / cg"
13602
5fe3c7ce7d7e comment/format in: #classNamed:
Claus Gittinger <cg@exept.de>
parents: 13601
diff changeset
  3424
    "Modified (comment): / 20-08-2011 / 16:43:07 / cg"
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3425
!
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3426
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3427
classNames
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3428
    "return a collection of all classNames in the system"
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3429
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3430
    ^ self allClasses collect:[:aClass | aClass name]
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3431
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3432
    "
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3433
     Smalltalk classNames
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3434
    "
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3435
!
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3436
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3437
classnameCompletion:aPartialClassName
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3438
    "given a partial classname, return an array consisting of
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3439
     2 entries: 1st: the best (longest) match
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  3440
		2nd: collection consisting of matching names"
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3441
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3442
    ^ DoWhatIMeanSupport classnameCompletion:aPartialClassName inEnvironment:self
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3443
!
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3444
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3445
classnameCompletion:aPartialClassName inEnvironment:anEnvironment
7563
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  3446
    "given a partial classname, return an array consisting of
7999
475bba3ead9a moved all input completion methods from Smalltalk to DoWhatIMeanSupport.
Claus Gittinger <cg@exept.de>
parents: 7996
diff changeset
  3447
     2 entries: 1st: the best (longest) match
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  3448
		2nd: collection consisting of matching names"
7999
475bba3ead9a moved all input completion methods from Smalltalk to DoWhatIMeanSupport.
Claus Gittinger <cg@exept.de>
parents: 7996
diff changeset
  3449
475bba3ead9a moved all input completion methods from Smalltalk to DoWhatIMeanSupport.
Claus Gittinger <cg@exept.de>
parents: 7996
diff changeset
  3450
    ^ DoWhatIMeanSupport classnameCompletion:aPartialClassName inEnvironment:anEnvironment
475bba3ead9a moved all input completion methods from Smalltalk to DoWhatIMeanSupport.
Claus Gittinger <cg@exept.de>
parents: 7996
diff changeset
  3451
475bba3ead9a moved all input completion methods from Smalltalk to DoWhatIMeanSupport.
Claus Gittinger <cg@exept.de>
parents: 7996
diff changeset
  3452
    "
10071
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
  3453
     Smalltalk classnameCompletion:'Arr'
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
  3454
     Smalltalk classnameCompletion:'Arra'
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
  3455
     Smalltalk classnameCompletion:'arra'
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
  3456
     Smalltalk classnameCompletion:'*rray'
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
  3457
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
  3458
     Smalltalk classnameCompletion:'Arr cl'
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
  3459
     Smalltalk classnameCompletion:'*rray cl'
453
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  3460
    "
644
9363244ef25d classNamed: fixed for metaclasses; handle matchCharacters in classNameCompletion
Claus Gittinger <cg@exept.de>
parents: 630
diff changeset
  3461
9363244ef25d classNamed: fixed for metaclasses; handle matchCharacters in classNameCompletion
Claus Gittinger <cg@exept.de>
parents: 630
diff changeset
  3462
    "Created: 24.11.1995 / 17:24:45 / cg"
2523
04db1fd74e0d try ignoring case in classNameCompletion
Claus Gittinger <cg@exept.de>
parents: 2514
diff changeset
  3463
    "Modified: 3.4.1997 / 18:25:01 / cg"
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3464
!
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3465
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3466
defaultNameSpace
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3467
    "return the default namespace, where new classes are installed,
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3468
     if NO special nameSpace handler is present"
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3469
9562
7d36dbb02bb3 code cleanup - remove old obsolete Project code
Claus Gittinger <cg@exept.de>
parents: 9550
diff changeset
  3470
    ^ Project defaultNameSpace.
7d36dbb02bb3 code cleanup - remove old obsolete Project code
Claus Gittinger <cg@exept.de>
parents: 9550
diff changeset
  3471
7d36dbb02bb3 code cleanup - remove old obsolete Project code
Claus Gittinger <cg@exept.de>
parents: 9550
diff changeset
  3472
    "Created: / 19-12-1996 / 23:49:25 / cg"
7d36dbb02bb3 code cleanup - remove old obsolete Project code
Claus Gittinger <cg@exept.de>
parents: 9550
diff changeset
  3473
    "Modified: / 17-08-2006 / 14:01:22 / cg"
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3474
!
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3475
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3476
globalNameCompletion:aPartialGlobalName
7999
475bba3ead9a moved all input completion methods from Smalltalk to DoWhatIMeanSupport.
Claus Gittinger <cg@exept.de>
parents: 7996
diff changeset
  3477
    "given a partial globalName, return an array consisting of
475bba3ead9a moved all input completion methods from Smalltalk to DoWhatIMeanSupport.
Claus Gittinger <cg@exept.de>
parents: 7996
diff changeset
  3478
     2 entries: 1st: the best (longest) match
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  3479
		2nd: collection consisting of matching names"
7999
475bba3ead9a moved all input completion methods from Smalltalk to DoWhatIMeanSupport.
Claus Gittinger <cg@exept.de>
parents: 7996
diff changeset
  3480
12614
b8fca618dcb6 changed: #globalNameCompletion:
Claus Gittinger <cg@exept.de>
parents: 12613
diff changeset
  3481
    ^ DoWhatIMeanSupport globalNameCompletion:aPartialGlobalName inEnvironment:self match:true
7999
475bba3ead9a moved all input completion methods from Smalltalk to DoWhatIMeanSupport.
Claus Gittinger <cg@exept.de>
parents: 7996
diff changeset
  3482
475bba3ead9a moved all input completion methods from Smalltalk to DoWhatIMeanSupport.
Claus Gittinger <cg@exept.de>
parents: 7996
diff changeset
  3483
    "
10071
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
  3484
     Smalltalk globalnameCompletion:'Arr'
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
  3485
     Smalltalk globalnameCompletion:'Arra'
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
  3486
     Smalltalk globalnameCompletion:'arra'
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
  3487
     Smalltalk globalnameCompletion:'*rray'
7999
475bba3ead9a moved all input completion methods from Smalltalk to DoWhatIMeanSupport.
Claus Gittinger <cg@exept.de>
parents: 7996
diff changeset
  3488
    "
475bba3ead9a moved all input completion methods from Smalltalk to DoWhatIMeanSupport.
Claus Gittinger <cg@exept.de>
parents: 7996
diff changeset
  3489
9508
564f30f49b1b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9506
diff changeset
  3490
    "Created: / 24-11-1995 / 17:24:45 / cg"
564f30f49b1b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9506
diff changeset
  3491
    "Modified: / 10-08-2006 / 13:05:39 / cg"
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3492
!
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3493
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3494
globalnameCompletion:aPartialGlobalName
7563
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  3495
    "given a partial globalName, return an array consisting of
7999
475bba3ead9a moved all input completion methods from Smalltalk to DoWhatIMeanSupport.
Claus Gittinger <cg@exept.de>
parents: 7996
diff changeset
  3496
     2 entries: 1st: the best (longest) match
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  3497
		2nd: collection consisting of matching names"
7999
475bba3ead9a moved all input completion methods from Smalltalk to DoWhatIMeanSupport.
Claus Gittinger <cg@exept.de>
parents: 7996
diff changeset
  3498
8358
0afa3ee38c37 Mark obsolete methods
Stefan Vogel <sv@exept.de>
parents: 8317
diff changeset
  3499
    <resource:#obsolete>
7999
475bba3ead9a moved all input completion methods from Smalltalk to DoWhatIMeanSupport.
Claus Gittinger <cg@exept.de>
parents: 7996
diff changeset
  3500
    self obsoleteMethodWarning:'use #globalNameCompletion:'.
9508
564f30f49b1b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9506
diff changeset
  3501
    ^ DoWhatIMeanSupport globalNameCompletion:aPartialGlobalName inEnvironment:self
7999
475bba3ead9a moved all input completion methods from Smalltalk to DoWhatIMeanSupport.
Claus Gittinger <cg@exept.de>
parents: 7996
diff changeset
  3502
475bba3ead9a moved all input completion methods from Smalltalk to DoWhatIMeanSupport.
Claus Gittinger <cg@exept.de>
parents: 7996
diff changeset
  3503
    "
10071
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
  3504
     Smalltalk globalnameCompletion:'Arr'
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
  3505
     Smalltalk globalnameCompletion:'Arra'
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
  3506
     Smalltalk globalnameCompletion:'arra'
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
  3507
     Smalltalk globalnameCompletion:'*rray'
5736
d625e5505254 globalNamecompletion
Claus Gittinger <cg@exept.de>
parents: 5716
diff changeset
  3508
    "
d625e5505254 globalNamecompletion
Claus Gittinger <cg@exept.de>
parents: 5716
diff changeset
  3509
9508
564f30f49b1b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9506
diff changeset
  3510
    "Created: / 24-11-1995 / 17:24:45 / cg"
564f30f49b1b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9506
diff changeset
  3511
    "Modified: / 10-08-2006 / 13:05:48 / cg"
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3512
!
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3513
13771
42c23bea6aaf *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 13675
diff changeset
  3514
hasClassNamed:aString
42c23bea6aaf *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 13675
diff changeset
  3515
    Symbol
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  3516
	hasInterned:aString
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  3517
	ifTrue:[:aSymbol | ^ (self at:aSymbol ifAbsent:[ nil ]) isClass ].
13602
5fe3c7ce7d7e comment/format in: #classNamed:
Claus Gittinger <cg@exept.de>
parents: 13601
diff changeset
  3518
    ^ false
5fe3c7ce7d7e comment/format in: #classNamed:
Claus Gittinger <cg@exept.de>
parents: 13601
diff changeset
  3519
5fe3c7ce7d7e comment/format in: #classNamed:
Claus Gittinger <cg@exept.de>
parents: 13601
diff changeset
  3520
    "Created: / 26-08-2009 / 11:43:03 / Jaroslav Havlin <havlij6@fel.cvut.cz>"
5fe3c7ce7d7e comment/format in: #classNamed:
Claus Gittinger <cg@exept.de>
parents: 13601
diff changeset
  3521
    "Modified: / 20-08-2011 / 16:41:31 / cg"
5fe3c7ce7d7e comment/format in: #classNamed:
Claus Gittinger <cg@exept.de>
parents: 13601
diff changeset
  3522
!
5fe3c7ce7d7e comment/format in: #classNamed:
Claus Gittinger <cg@exept.de>
parents: 13601
diff changeset
  3523
9290
a7119f29fe2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9259
diff changeset
  3524
hasNameSpaces
a7119f29fe2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9259
diff changeset
  3525
    "can be redefined by dummy namespaces/environments, to suppress
a7119f29fe2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9259
diff changeset
  3526
     the namespace display in a browser (PocketSmalltalk)"
a7119f29fe2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9259
diff changeset
  3527
a7119f29fe2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9259
diff changeset
  3528
    ^ true
a7119f29fe2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9259
diff changeset
  3529
!
a7119f29fe2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9259
diff changeset
  3530
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3531
hasNamespaces
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3532
    "can be redefined by dummy namespaces/environments, to suppress
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3533
     the namespace display in a browser (PocketSmalltalk)"
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3534
9290
a7119f29fe2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9259
diff changeset
  3535
    <resource:#obsolete>
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3536
    ^ true
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3537
!
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3538
10432
9d0a4de5e69c preps for selectorNamespaces.
Claus Gittinger <cg@exept.de>
parents: 10429
diff changeset
  3539
hasSelectorNameSpaces
9d0a4de5e69c preps for selectorNamespaces.
Claus Gittinger <cg@exept.de>
parents: 10429
diff changeset
  3540
    "for now return false
10999
e5cfd06920ca *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10998
diff changeset
  3541
     Selector namespaces are being implemented and supported by the VM,
10432
9d0a4de5e69c preps for selectorNamespaces.
Claus Gittinger <cg@exept.de>
parents: 10429
diff changeset
  3542
     but not yet fully supported by all tools...
9d0a4de5e69c preps for selectorNamespaces.
Claus Gittinger <cg@exept.de>
parents: 10429
diff changeset
  3543
     Therefore, for now, do not generate code which uses this feature."
9d0a4de5e69c preps for selectorNamespaces.
Claus Gittinger <cg@exept.de>
parents: 10429
diff changeset
  3544
9d0a4de5e69c preps for selectorNamespaces.
Claus Gittinger <cg@exept.de>
parents: 10429
diff changeset
  3545
    ^ false
9d0a4de5e69c preps for selectorNamespaces.
Claus Gittinger <cg@exept.de>
parents: 10429
diff changeset
  3546
9d0a4de5e69c preps for selectorNamespaces.
Claus Gittinger <cg@exept.de>
parents: 10429
diff changeset
  3547
    "Created: / 05-03-2007 / 13:26:28 / cg"
9d0a4de5e69c preps for selectorNamespaces.
Claus Gittinger <cg@exept.de>
parents: 10429
diff changeset
  3548
!
9d0a4de5e69c preps for selectorNamespaces.
Claus Gittinger <cg@exept.de>
parents: 10429
diff changeset
  3549
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3550
includes:something
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3551
    "this should come from Collection.
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3552
     will change the inheritance - Smalltalk is actually a collection"
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3553
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3554
    self do:[:element | element = something ifTrue:[^ true]].
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3555
    ^ false
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3556
!
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3557
14987
48fe827c49b5 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 14973
diff changeset
  3558
includesIdentical:something
48fe827c49b5 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 14973
diff changeset
  3559
    "this should come from Collection.
48fe827c49b5 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 14973
diff changeset
  3560
     will change the inheritance - Smalltalk is actually a collection"
48fe827c49b5 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 14973
diff changeset
  3561
48fe827c49b5 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 14973
diff changeset
  3562
    self do:[:element | element == something ifTrue:[^ true]].
48fe827c49b5 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 14973
diff changeset
  3563
    ^ false
48fe827c49b5 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 14973
diff changeset
  3564
!
48fe827c49b5 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 14973
diff changeset
  3565
10041
1ef0cb09523b protocol for startability via browser slightly changed
Claus Gittinger <cg@exept.de>
parents: 9937
diff changeset
  3566
isBrowserStartable
1ef0cb09523b protocol for startability via browser slightly changed
Claus Gittinger <cg@exept.de>
parents: 9937
diff changeset
  3567
    ^ false.
1ef0cb09523b protocol for startability via browser slightly changed
Claus Gittinger <cg@exept.de>
parents: 9937
diff changeset
  3568
1ef0cb09523b protocol for startability via browser slightly changed
Claus Gittinger <cg@exept.de>
parents: 9937
diff changeset
  3569
    "Created: / 06-10-2006 / 11:46:52 / cg"
1ef0cb09523b protocol for startability via browser slightly changed
Claus Gittinger <cg@exept.de>
parents: 9937
diff changeset
  3570
!
1ef0cb09523b protocol for startability via browser slightly changed
Claus Gittinger <cg@exept.de>
parents: 9937
diff changeset
  3571
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3572
isNameSpace
9227
3aca7dee958d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9211
diff changeset
  3573
    "return true, if the receiver is a nameSpace."
3aca7dee958d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9211
diff changeset
  3574
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3575
    ^ true
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3576
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3577
    "Created: 11.10.1996 / 18:10:43 / cg"
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3578
!
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3579
10169
142f2de83007 +isRealNameSpace
Claus Gittinger <cg@exept.de>
parents: 10162
diff changeset
  3580
isRealNameSpace
142f2de83007 +isRealNameSpace
Claus Gittinger <cg@exept.de>
parents: 10162
diff changeset
  3581
    "return true, if the receiver is a nameSpace, but not Smalltalk (which is also a class)."
142f2de83007 +isRealNameSpace
Claus Gittinger <cg@exept.de>
parents: 10162
diff changeset
  3582
142f2de83007 +isRealNameSpace
Claus Gittinger <cg@exept.de>
parents: 10162
diff changeset
  3583
    ^ false
142f2de83007 +isRealNameSpace
Claus Gittinger <cg@exept.de>
parents: 10162
diff changeset
  3584
142f2de83007 +isRealNameSpace
Claus Gittinger <cg@exept.de>
parents: 10162
diff changeset
  3585
    "Created: / 10-11-2006 / 17:02:19 / cg"
142f2de83007 +isRealNameSpace
Claus Gittinger <cg@exept.de>
parents: 10162
diff changeset
  3586
!
142f2de83007 +isRealNameSpace
Claus Gittinger <cg@exept.de>
parents: 10162
diff changeset
  3587
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3588
isTopLevelNameSpace
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3589
    ^ true
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3590
!
7563
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  3591
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  3592
isTopLevelNamespace
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  3593
    "obsolete - use isTopLevelNameSpace"
5365
95c615a40176 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5363
diff changeset
  3594
7432
155245708ca3 *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 7430
diff changeset
  3595
    <resource:#obsolete>
155245708ca3 *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 7430
diff changeset
  3596
7999
475bba3ead9a moved all input completion methods from Smalltalk to DoWhatIMeanSupport.
Claus Gittinger <cg@exept.de>
parents: 7996
diff changeset
  3597
    self obsoleteMethodWarning:'use #isTopLevelNameSpace'.
4458
6f46b35f787c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4431
diff changeset
  3598
    ^ true
6f46b35f787c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4431
diff changeset
  3599
6f46b35f787c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4431
diff changeset
  3600
    "Created: 11.10.1996 / 18:10:43 / cg"
6f46b35f787c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4431
diff changeset
  3601
!
6f46b35f787c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4431
diff changeset
  3602
9081
c957b05ad97f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9080
diff changeset
  3603
keyIsClassVariableNameKey:aKey
c957b05ad97f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9080
diff changeset
  3604
    |i|
c957b05ad97f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9080
diff changeset
  3605
c957b05ad97f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9080
diff changeset
  3606
    i := aKey lastIndexOf:$:.
c957b05ad97f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9080
diff changeset
  3607
    i ~~ 0 ifTrue:[
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  3608
	i > 1 ifTrue:[
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  3609
	    (aKey at:(i-1)) == $: ifFalse:[
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  3610
		^ true.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  3611
	    ].
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  3612
	].
9081
c957b05ad97f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9080
diff changeset
  3613
    ].
c957b05ad97f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9080
diff changeset
  3614
    ^ false.
c957b05ad97f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9080
diff changeset
  3615
c957b05ad97f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9080
diff changeset
  3616
    "
10071
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
  3617
     self keyIsClassVariableNameKey:'foo::bar'
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
  3618
     self keyIsClassVariableNameKey:'foo:bar'
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
  3619
     self keyIsClassVariableNameKey:':bar'
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
  3620
     self keyIsClassVariableNameKey:'::bar'
9081
c957b05ad97f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9080
diff changeset
  3621
    "
c957b05ad97f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9080
diff changeset
  3622
!
c957b05ad97f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9080
diff changeset
  3623
9374
8198d65aadd3 #classNamed: now loads autoloaded classes if a (possibly) private class of an
Stefan Vogel <sv@exept.de>
parents: 9292
diff changeset
  3624
loadedClassNamed:aString
8198d65aadd3 #classNamed: now loads autoloaded classes if a (possibly) private class of an
Stefan Vogel <sv@exept.de>
parents: 9292
diff changeset
  3625
    "Same as #classNamed,
8198d65aadd3 #classNamed: now loads autoloaded classes if a (possibly) private class of an
Stefan Vogel <sv@exept.de>
parents: 9292
diff changeset
  3626
     but a private class of an autoloaded class will not be found."
8198d65aadd3 #classNamed: now loads autoloaded classes if a (possibly) private class of an
Stefan Vogel <sv@exept.de>
parents: 9292
diff changeset
  3627
8198d65aadd3 #classNamed: now loads autoloaded classes if a (possibly) private class of an
Stefan Vogel <sv@exept.de>
parents: 9292
diff changeset
  3628
    |cls sym nonMeta|
8198d65aadd3 #classNamed: now loads autoloaded classes if a (possibly) private class of an
Stefan Vogel <sv@exept.de>
parents: 9292
diff changeset
  3629
8198d65aadd3 #classNamed: now loads autoloaded classes if a (possibly) private class of an
Stefan Vogel <sv@exept.de>
parents: 9292
diff changeset
  3630
    "Quick try - if everything is loaded, this will succeed.
8198d65aadd3 #classNamed: now loads autoloaded classes if a (possibly) private class of an
Stefan Vogel <sv@exept.de>
parents: 9292
diff changeset
  3631
     But be careful, to not invent new symbols ..."
8198d65aadd3 #classNamed: now loads autoloaded classes if a (possibly) private class of an
Stefan Vogel <sv@exept.de>
parents: 9292
diff changeset
  3632
    sym := aString asSymbolIfInterned.
8198d65aadd3 #classNamed: now loads autoloaded classes if a (possibly) private class of an
Stefan Vogel <sv@exept.de>
parents: 9292
diff changeset
  3633
    sym notNil ifTrue:[
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  3634
	cls := self at:sym ifAbsent:nil.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  3635
	cls isBehavior ifTrue:[^ cls].
9374
8198d65aadd3 #classNamed: now loads autoloaded classes if a (possibly) private class of an
Stefan Vogel <sv@exept.de>
parents: 9292
diff changeset
  3636
    ].
8198d65aadd3 #classNamed: now loads autoloaded classes if a (possibly) private class of an
Stefan Vogel <sv@exept.de>
parents: 9292
diff changeset
  3637
8198d65aadd3 #classNamed: now loads autoloaded classes if a (possibly) private class of an
Stefan Vogel <sv@exept.de>
parents: 9292
diff changeset
  3638
    (aString endsWith:' class') ifTrue:[
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  3639
	nonMeta := self loadedClassNamed:(aString copyButLast:6).
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  3640
	nonMeta notNil ifTrue:[
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  3641
	    ^ nonMeta theMetaclass
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  3642
	].
9374
8198d65aadd3 #classNamed: now loads autoloaded classes if a (possibly) private class of an
Stefan Vogel <sv@exept.de>
parents: 9292
diff changeset
  3643
    ].
8198d65aadd3 #classNamed: now loads autoloaded classes if a (possibly) private class of an
Stefan Vogel <sv@exept.de>
parents: 9292
diff changeset
  3644
    ^ nil
8198d65aadd3 #classNamed: now loads autoloaded classes if a (possibly) private class of an
Stefan Vogel <sv@exept.de>
parents: 9292
diff changeset
  3645
8198d65aadd3 #classNamed: now loads autoloaded classes if a (possibly) private class of an
Stefan Vogel <sv@exept.de>
parents: 9292
diff changeset
  3646
    "
10071
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
  3647
     Smalltalk loadedClassNamed:'Object'
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
  3648
     Smalltalk loadedClassNamed:'Authentication::BasicAuthenticator::BasicAuthenticationData'
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
  3649
     Smalltalk loadedClassNamed:'Authentication::BasicAuthenticator::BasicAuthenticationData class'
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
  3650
     Smalltalk loadedClassNamed:'Authentication::BasicAuthenticator'
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
  3651
     Smalltalk loadedClassNamed:'fooBar'
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
  3652
     Smalltalk loadedClassNamed:'true'
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
  3653
     Smalltalk loadedClassNamed:'Object class'
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
  3654
     Smalltalk loadedClassNamed:'Metaclass'
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
  3655
     Smalltalk loadedClassNamed:'Array'
9374
8198d65aadd3 #classNamed: now loads autoloaded classes if a (possibly) private class of an
Stefan Vogel <sv@exept.de>
parents: 9292
diff changeset
  3656
     Smalltalk loadedClassNamed:'Array class'
8198d65aadd3 #classNamed: now loads autoloaded classes if a (possibly) private class of an
Stefan Vogel <sv@exept.de>
parents: 9292
diff changeset
  3657
    "
8198d65aadd3 #classNamed: now loads autoloaded classes if a (possibly) private class of an
Stefan Vogel <sv@exept.de>
parents: 9292
diff changeset
  3658
!
8198d65aadd3 #classNamed: now loads autoloaded classes if a (possibly) private class of an
Stefan Vogel <sv@exept.de>
parents: 9292
diff changeset
  3659
7563
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  3660
methodProtocolCompletion:aPartialProtocolName
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  3661
    "given a partial method protocol name, return an array consisting of
10071
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
  3662
     2 entries: 1st: the best (longest) match
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  3663
		2nd: collection consisting of matching protocols"
7999
475bba3ead9a moved all input completion methods from Smalltalk to DoWhatIMeanSupport.
Claus Gittinger <cg@exept.de>
parents: 7996
diff changeset
  3664
9508
564f30f49b1b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9506
diff changeset
  3665
    ^ DoWhatIMeanSupport methodProtocolCompletion:aPartialProtocolName inEnvironment:self
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3666
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3667
    "
10071
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
  3668
     Smalltalk methodProtocolCompletion:'doc'
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
  3669
     Smalltalk methodProtocolCompletion:'docu'
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
  3670
     Smalltalk methodProtocolCompletion:'documenta'
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3671
    "
9508
564f30f49b1b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9506
diff changeset
  3672
564f30f49b1b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9506
diff changeset
  3673
    "Modified: / 10-08-2006 / 13:05:20 / cg"
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3674
!
5505
e99e8e9cbfef added #methodProtocolCompletion:
Claus Gittinger <cg@exept.de>
parents: 5504
diff changeset
  3675
7563
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  3676
numberOfGlobals
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  3677
    "return the number of global variables in the system"
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  3678
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  3679
    |tally "{ Class: SmallInteger }" |
617
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  3680
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  3681
    tally := 0.
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  3682
    self do:[:obj | tally := tally + 1].
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  3683
    ^ tally
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  3684
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  3685
    "Smalltalk numberOfGlobals"
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  3686
!
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  3687
7563
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  3688
referencesAny:aCollection
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  3689
    "redefined, since the references are only kept in the VM's symbol table"
3260
10e5199831ee added #referencesAny:
Claus Gittinger <cg@exept.de>
parents: 3155
diff changeset
  3690
10e5199831ee added #referencesAny:
Claus Gittinger <cg@exept.de>
parents: 3155
diff changeset
  3691
    self keysAndValuesDo:[:key :val |
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  3692
	aCollection do:[:anObject |
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  3693
	    (key == anObject) ifTrue:[^ true].
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  3694
	    (val == anObject ) ifTrue:[^ true].
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  3695
	]
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3696
    ].
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3697
    ^ super referencesAny:aCollection
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3698
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3699
    "Created: / 2.2.1998 / 16:01:20 / cg"
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3700
!
3260
10e5199831ee added #referencesAny:
Claus Gittinger <cg@exept.de>
parents: 3155
diff changeset
  3701
7563
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  3702
referencesDerivedInstanceOf:aClass
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  3703
    "redefined, since the references are only kept in the VM's symbol table"
617
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  3704
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  3705
    self keysAndValuesDo:[:key :val |
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  3706
	(key isKindOf:aClass) ifTrue:[^ true].
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  3707
	(val isKindOf:aClass) ifTrue:[^ true].
617
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  3708
    ].
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  3709
    ^ super referencesDerivedInstanceOf:aClass
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  3710
!
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  3711
7563
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  3712
referencesInstanceOf:aClass
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  3713
    "redefined, since the references are only kept in the VM's symbol table"
617
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  3714
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  3715
    self keysAndValuesDo:[:key :val |
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  3716
	(key isMemberOf:aClass) ifTrue:[^ true].
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  3717
	(val isMemberOf:aClass) ifTrue:[^ true].
617
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  3718
    ].
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  3719
    ^ super referencesInstanceOf:aClass
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  3720
!
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  3721
7563
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  3722
referencesObject:anObject
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  3723
    "redefined, since the references are only kept in the VM's symbol table"
6074
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6033
diff changeset
  3724
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6033
diff changeset
  3725
    self keysAndValuesDo:[:key :val |
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  3726
	(key == anObject) ifTrue:[^ true].
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  3727
	(val == anObject ) ifTrue:[^ true].
6074
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6033
diff changeset
  3728
    ].
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6033
diff changeset
  3729
    ^ super referencesObject:anObject
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6033
diff changeset
  3730
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3731
    "Modified: / 3.2.1998 / 14:22:46 / cg"
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3732
!
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3733
15766
e922cc8885de class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15741
diff changeset
  3734
resolveName:aName inClass:aClass
7563
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  3735
    "resolve aName as if compiled within aClass;
3026
7e1d4efc5ba5 *** empty log message ***
ca
parents: 3025
diff changeset
  3736
     i.e. if it has a private class with this name, return it;
7e1d4efc5ba5 *** empty log message ***
ca
parents: 3025
diff changeset
  3737
     if aName is known within the classes namespace, return that.
7e1d4efc5ba5 *** empty log message ***
ca
parents: 3025
diff changeset
  3738
     Otherwise, return a global with that name.
7e1d4efc5ba5 *** empty log message ***
ca
parents: 3025
diff changeset
  3739
     This should be used whereever Smalltalk>>at: used to be used,
7e1d4efc5ba5 *** empty log message ***
ca
parents: 3025
diff changeset
  3740
     to resolve a global by name."
7e1d4efc5ba5 *** empty log message ***
ca
parents: 3025
diff changeset
  3741
15766
e922cc8885de class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15741
diff changeset
  3742
    |nameUsed sym cls ns|
e922cc8885de class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15741
diff changeset
  3743
e922cc8885de class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15741
diff changeset
  3744
    aName isNil ifTrue:[^ nil].
e922cc8885de class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15741
diff changeset
  3745
    aName isBehavior ifTrue:[^ aName].       "/ already resolved
e922cc8885de class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15741
diff changeset
  3746
    nameUsed := aName.
e922cc8885de class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15741
diff changeset
  3747
e922cc8885de class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15741
diff changeset
  3748
    (nameUsed startsWith:'Smalltalk::') ifTrue:[
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  3749
	nameUsed := nameUsed copyFrom:12.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  3750
	^ self at:(nameUsed asSymbol) ifAbsent:nil.
15766
e922cc8885de class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15741
diff changeset
  3751
    ].
e922cc8885de class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15741
diff changeset
  3752
e922cc8885de class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15741
diff changeset
  3753
    sym := nameUsed asSymbol.
3026
7e1d4efc5ba5 *** empty log message ***
ca
parents: 3025
diff changeset
  3754
7e1d4efc5ba5 *** empty log message ***
ca
parents: 3025
diff changeset
  3755
    cls := aClass privateClassesAt:sym.
7e1d4efc5ba5 *** empty log message ***
ca
parents: 3025
diff changeset
  3756
    cls notNil ifTrue:[^ cls].
7e1d4efc5ba5 *** empty log message ***
ca
parents: 3025
diff changeset
  3757
7e1d4efc5ba5 *** empty log message ***
ca
parents: 3025
diff changeset
  3758
    ns := aClass nameSpace.
7e1d4efc5ba5 *** empty log message ***
ca
parents: 3025
diff changeset
  3759
    (ns notNil and:[ns ~~ Smalltalk]) ifTrue:[
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  3760
	ns isNameSpace ifTrue:[
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  3761
	    cls := ns at:sym ifAbsent:nil.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  3762
	] ifFalse:[
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  3763
	    cls := ns privateClassesAt:sym
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  3764
	].
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  3765
	cls notNil ifTrue:[^ cls].
3025
53b114d5be3e added #resolveClassNamed:
ca
parents: 3022
diff changeset
  3766
    ].
3026
7e1d4efc5ba5 *** empty log message ***
ca
parents: 3025
diff changeset
  3767
    ^ self at:sym ifAbsent:nil.
4356
54d1f0b81638 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4355
diff changeset
  3768
54d1f0b81638 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4355
diff changeset
  3769
    "Modified: / 9.7.1999 / 01:18:07 / cg"
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3770
!
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3771
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3772
selectorCompletion:aPartialSymbolName
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3773
    "given a partial selector, return an array consisting of
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3774
     2 entries: 1st: the longest match
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  3775
		2nd: collection consisting of matching implemented selectors"
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3776
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3777
    ^ DoWhatIMeanSupport selectorCompletion:aPartialSymbolName inEnvironment:self
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3778
!
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3779
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3780
selectorCompletion:aPartialSymbolName inEnvironment:anEnvironment
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3781
    "given a partial selector, return an array consisting of
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3782
     2 entries: 1st: the longest match
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  3783
		2nd: collection consisting of matching implemented selectors"
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3784
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3785
    ^ DoWhatIMeanSupport selectorCompletion:aPartialSymbolName inEnvironment:anEnvironment
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3786
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3787
    "
10071
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
  3788
     Smalltalk selectorCompletion:'at:p'
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
  3789
     Smalltalk selectorCompletion:'nextP'
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
  3790
     Smalltalk selectorCompletion:'nextp'
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3791
    "
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3792
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3793
    "Modified: / 7.6.1996 / 08:44:33 / stefan"
3565
966a108e3765 also do caseless selectorCompletion
Claus Gittinger <cg@exept.de>
parents: 3560
diff changeset
  3794
    "Modified: / 14.6.1998 / 15:54:03 / cg"
19681
ec20967ae600 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 19597
diff changeset
  3795
!
ec20967ae600 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 19597
diff changeset
  3796
ec20967ae600 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 19597
diff changeset
  3797
someImplementorOf:aSelector
ec20967ae600 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 19597
diff changeset
  3798
    "return any class, which implement the given selector. Nil if there is none.
ec20967ae600 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 19597
diff changeset
  3799
     (useful to search, if there is one at all)"
ec20967ae600 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 19597
diff changeset
  3800
ec20967ae600 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 19597
diff changeset
  3801
    self allImplementorsOf:aSelector do:[:cls | ^ cls].
ec20967ae600 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 19597
diff changeset
  3802
    ^ nil.
ec20967ae600 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 19597
diff changeset
  3803
ec20967ae600 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 19597
diff changeset
  3804
    "
ec20967ae600 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 19597
diff changeset
  3805
     Smalltalk someImplementorOf:#isNil
ec20967ae600 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 19597
diff changeset
  3806
     Smalltalk someImplementorOf:#add:
ec20967ae600 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 19597
diff changeset
  3807
    "
ec20967ae600 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 19597
diff changeset
  3808
ec20967ae600 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 19597
diff changeset
  3809
    "Created: / 30-04-2016 / 17:39:19 / cg"
453
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  3810
! !
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  3811
4431
1c7ee9a97eda *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4430
diff changeset
  3812
!Smalltalk class methodsFor:'queries-system'!
1c7ee9a97eda *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4430
diff changeset
  3813
15958
fd69e4694d91 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15872
diff changeset
  3814
isAmber
15980
83b70fa9bf0a class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15958
diff changeset
  3815
    "is this an Amber Smalltalk system ?
83b70fa9bf0a class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15958
diff changeset
  3816
     Return false here - this may be useful to write portable
15958
fd69e4694d91 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15872
diff changeset
  3817
     applications - add #isAmber to your Amber Smalltalk,
fd69e4694d91 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15872
diff changeset
  3818
     returning true there."
fd69e4694d91 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15872
diff changeset
  3819
fd69e4694d91 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15872
diff changeset
  3820
    ^ false
fd69e4694d91 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15872
diff changeset
  3821
fd69e4694d91 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15872
diff changeset
  3822
    "Created: / 18-12-2013 / 15:43:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
fd69e4694d91 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15872
diff changeset
  3823
!
fd69e4694d91 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15872
diff changeset
  3824
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3825
isDolphinSmalltalk
16803
bd94b8eacd88 class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 16764
diff changeset
  3826
    "is this a Dolphin Smalltalk system ?
15980
83b70fa9bf0a class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15958
diff changeset
  3827
     Return false here - this may be useful to write portable
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3828
     applications - add #isDolphinSmalltalk to your dolphin,
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3829
     returning true there."
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3830
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3831
    ^ false
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3832
!
4970
c5ab8ead5b8e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4963
diff changeset
  3833
15958
fd69e4694d91 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15872
diff changeset
  3834
isGemStone
15980
83b70fa9bf0a class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15958
diff changeset
  3835
    "is this a GemStone Smalltalk system ?
83b70fa9bf0a class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15958
diff changeset
  3836
     Return false here - this may be useful to write portable
15958
fd69e4694d91 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15872
diff changeset
  3837
     applications - add #isGemStone to your GemStone/S,
fd69e4694d91 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15872
diff changeset
  3838
     returning true there."
fd69e4694d91 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15872
diff changeset
  3839
fd69e4694d91 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15872
diff changeset
  3840
    ^ false
fd69e4694d91 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15872
diff changeset
  3841
fd69e4694d91 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15872
diff changeset
  3842
    "Created: / 18-12-2013 / 15:43:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
fd69e4694d91 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15872
diff changeset
  3843
!
fd69e4694d91 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15872
diff changeset
  3844
fd69e4694d91 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15872
diff changeset
  3845
isPharo
15980
83b70fa9bf0a class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15958
diff changeset
  3846
    "is this a Pharo Smalltalk system ?
83b70fa9bf0a class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15958
diff changeset
  3847
     Return false here - this may be useful to write portable
15958
fd69e4694d91 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15872
diff changeset
  3848
     applications - add #isPharo to your Pharo,
fd69e4694d91 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15872
diff changeset
  3849
     returning true there."
fd69e4694d91 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15872
diff changeset
  3850
fd69e4694d91 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15872
diff changeset
  3851
    ^ false
fd69e4694d91 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15872
diff changeset
  3852
fd69e4694d91 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15872
diff changeset
  3853
    "Created: / 18-12-2013 / 15:42:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
fd69e4694d91 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15872
diff changeset
  3854
!
fd69e4694d91 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15872
diff changeset
  3855
7563
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  3856
isSmalltalkMT
15980
83b70fa9bf0a class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15958
diff changeset
  3857
    "is this a Smalltalk-MT system ?
83b70fa9bf0a class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15958
diff changeset
  3858
     Return false here - this may be useful to write portable
7563
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  3859
     applications - add #isSmalltalkMT to your smalltalk-MT,
4970
c5ab8ead5b8e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4963
diff changeset
  3860
     returning true there."
c5ab8ead5b8e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4963
diff changeset
  3861
c5ab8ead5b8e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4963
diff changeset
  3862
    ^ false
c5ab8ead5b8e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4963
diff changeset
  3863
!
c5ab8ead5b8e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4963
diff changeset
  3864
7563
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  3865
isSmalltalkV
15980
83b70fa9bf0a class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15958
diff changeset
  3866
    "is this a Smalltalk/V system ?
83b70fa9bf0a class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15958
diff changeset
  3867
     Return false here - this may be useful to write portable
7563
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  3868
     applications - add #isSmalltalkV to your smalltalkV,
4431
1c7ee9a97eda *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4430
diff changeset
  3869
     returning true there."
1c7ee9a97eda *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4430
diff changeset
  3870
1c7ee9a97eda *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4430
diff changeset
  3871
    ^ false
1c7ee9a97eda *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4430
diff changeset
  3872
!
1c7ee9a97eda *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4430
diff changeset
  3873
7563
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  3874
isSmalltalkX
16803
bd94b8eacd88 class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 16764
diff changeset
  3875
    "is this a Smalltalk/X system ?
15980
83b70fa9bf0a class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15958
diff changeset
  3876
     Return true here - this may be useful to write portable
22799
5cc8b7ebdd62 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 22793
diff changeset
  3877
     applications.
5cc8b7ebdd62 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 22793
diff changeset
  3878
     Add #isSmalltalkX to your other smalltalks, returning false there.
5cc8b7ebdd62 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 22793
diff changeset
  3879
     Notice: the ST/X compilers know about this, and inline the code
5cc8b7ebdd62 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 22793
diff changeset
  3880
     (not generating code for the false branch).
5cc8b7ebdd62 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 22793
diff changeset
  3881
     So in ST/X, this check costs you absolutely nothing."
4431
1c7ee9a97eda *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4430
diff changeset
  3882
1c7ee9a97eda *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4430
diff changeset
  3883
    ^ true
1c7ee9a97eda *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4430
diff changeset
  3884
!
1c7ee9a97eda *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4430
diff changeset
  3885
7563
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  3886
isSqueak
15980
83b70fa9bf0a class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15958
diff changeset
  3887
    "is this a SqueakSmalltalk system ?
83b70fa9bf0a class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15958
diff changeset
  3888
     Return false here - this may be useful to write portable
7563
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  3889
     applications - add #isSqueak to your squeak,
4431
1c7ee9a97eda *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4430
diff changeset
  3890
     returning true there."
1c7ee9a97eda *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4430
diff changeset
  3891
1c7ee9a97eda *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4430
diff changeset
  3892
    ^ false
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3893
!
4431
1c7ee9a97eda *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4430
diff changeset
  3894
16013
1c60a86125e7 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15980
diff changeset
  3895
isSqueakLike
1c60a86125e7 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15980
diff changeset
  3896
    "is this a Squeak, Pharo, Cuis or similar Smalltalk system ?
1c60a86125e7 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15980
diff changeset
  3897
     Return false here - this may be useful to write portable
1c60a86125e7 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15980
diff changeset
  3898
     applications - add #isSqueakLike to your squeak, pharo,...
1c60a86125e7 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15980
diff changeset
  3899
     returning true there."
1c60a86125e7 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15980
diff changeset
  3900
1c60a86125e7 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15980
diff changeset
  3901
    ^ false
1c60a86125e7 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15980
diff changeset
  3902
!
1c60a86125e7 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15980
diff changeset
  3903
7563
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  3904
isVisualAge
15980
83b70fa9bf0a class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15958
diff changeset
  3905
    "is this a VisualAge Smalltalk system ?
83b70fa9bf0a class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15958
diff changeset
  3906
     Return false here - this may be useful to write portable
7563
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  3907
     applications - add #isVisualAge to your visualAge,
4431
1c7ee9a97eda *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4430
diff changeset
  3908
     returning true there."
1c7ee9a97eda *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4430
diff changeset
  3909
1c7ee9a97eda *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4430
diff changeset
  3910
    ^ false
1c7ee9a97eda *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4430
diff changeset
  3911
!
1c7ee9a97eda *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4430
diff changeset
  3912
17369
d50c90bc1a91 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17350
diff changeset
  3913
isVisualSmalltalkEnterprise
16843
88fc65939c60 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16831
diff changeset
  3914
    "is this a VSE Smalltalk system ?
88fc65939c60 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16831
diff changeset
  3915
     Return false here - this may be useful to write portable
88fc65939c60 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16831
diff changeset
  3916
     applications - add #isVisualSmallalkEnterprise to your VSE,
88fc65939c60 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16831
diff changeset
  3917
     returning true there."
88fc65939c60 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16831
diff changeset
  3918
88fc65939c60 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16831
diff changeset
  3919
    ^ false
88fc65939c60 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16831
diff changeset
  3920
!
88fc65939c60 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16831
diff changeset
  3921
7563
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  3922
isVisualWorks
15980
83b70fa9bf0a class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15958
diff changeset
  3923
    "is this a VisualWorks Smalltalk system ?
83b70fa9bf0a class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15958
diff changeset
  3924
     Return false here - this may be useful to write portable
7563
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  3925
     applications - add #isVisualWorks to your visualWorks,
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3926
     returning true there."
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3927
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3928
    ^ false
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3929
! !
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3930
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  3931
!Smalltalk class methodsFor:'startup'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3932
9032
ef419ad5e15a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9030
diff changeset
  3933
browserWindowStartup
13056
1fa92a4cd9cc comment in #browserWindowStartup
Claus Gittinger <cg@exept.de>
parents: 13014
diff changeset
  3934
    "invoked, when st/x is started as a plugin in a (currently firefox) browser.
1fa92a4cd9cc comment in #browserWindowStartup
Claus Gittinger <cg@exept.de>
parents: 13014
diff changeset
  3935
     In contrast to squeak (where a single window is used to show the display bitmap),
1fa92a4cd9cc comment in #browserWindowStartup
Claus Gittinger <cg@exept.de>
parents: 13014
diff changeset
  3936
     the browser window is used as a pseudo root-window for a single aplication window.
1fa92a4cd9cc comment in #browserWindowStartup
Claus Gittinger <cg@exept.de>
parents: 13014
diff changeset
  3937
     If required, that app must ensure that multiple apps (if any) are setup as a
1fa92a4cd9cc comment in #browserWindowStartup
Claus Gittinger <cg@exept.de>
parents: 13014
diff changeset
  3938
     multiwindow application.
1fa92a4cd9cc comment in #browserWindowStartup
Claus Gittinger <cg@exept.de>
parents: 13014
diff changeset
  3939
     Actually, control is transferred to PluginSupport, which is suppoesed to know what to do"
1fa92a4cd9cc comment in #browserWindowStartup
Claus Gittinger <cg@exept.de>
parents: 13014
diff changeset
  3940
9032
ef419ad5e15a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9030
diff changeset
  3941
    |windowIDString numericWindowID windowID params idx process|
ef419ad5e15a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9030
diff changeset
  3942
ef419ad5e15a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9030
diff changeset
  3943
    idx := CommandLineArguments indexOf:'--browserWindow:'.
ef419ad5e15a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9030
diff changeset
  3944
    windowIDString := CommandLineArguments at:idx+1.
ef419ad5e15a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9030
diff changeset
  3945
    numericWindowID := Integer fromString:windowIDString.
ef419ad5e15a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9030
diff changeset
  3946
    windowID := ExternalAddress newAddress:numericWindowID.
ef419ad5e15a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9030
diff changeset
  3947
ef419ad5e15a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9030
diff changeset
  3948
    idx := CommandLineArguments indexOf:'--browserParameters:'.
ef419ad5e15a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9030
diff changeset
  3949
    idx ~~ 0 ifTrue:[
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  3950
	params := Dictionary new.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  3951
	(CommandLineArguments copyFrom:idx+1) pairWiseDo:[:key :value |
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  3952
	    params at:key put:value.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  3953
	].
9032
ef419ad5e15a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9030
diff changeset
  3954
    ].
ef419ad5e15a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9030
diff changeset
  3955
ef419ad5e15a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9030
diff changeset
  3956
    'browserWindow is: ' errorPrint. windowID errorPrintCR.
ef419ad5e15a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9030
diff changeset
  3957
    'browserParameters are: ' errorPrint. params errorPrintCR.
ef419ad5e15a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9030
diff changeset
  3958
    'Display is: ' errorPrint. Display errorPrintCR.
ef419ad5e15a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9030
diff changeset
  3959
ef419ad5e15a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9030
diff changeset
  3960
    process := [
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  3961
	PluginSupport
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  3962
	    startInBrowserWithWindowID:windowID
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  3963
	    parameters:params.
9032
ef419ad5e15a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9030
diff changeset
  3964
    ] newProcess.
9043
e6106f500263 do not use numeric process prios
Claus Gittinger <cg@exept.de>
parents: 9036
diff changeset
  3965
    process priority:(Processor userSchedulingPriority).
9032
ef419ad5e15a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9030
diff changeset
  3966
    process name:'browser start handler'.
ef419ad5e15a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9030
diff changeset
  3967
    process beGroupLeader.
ef419ad5e15a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9030
diff changeset
  3968
    process resume.
ef419ad5e15a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9030
diff changeset
  3969
    process := nil.
ef419ad5e15a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9030
diff changeset
  3970
ef419ad5e15a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9030
diff changeset
  3971
    Processor dispatchLoop.
ef419ad5e15a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9030
diff changeset
  3972
    Smalltalk exit.
13056
1fa92a4cd9cc comment in #browserWindowStartup
Claus Gittinger <cg@exept.de>
parents: 13014
diff changeset
  3973
1fa92a4cd9cc comment in #browserWindowStartup
Claus Gittinger <cg@exept.de>
parents: 13014
diff changeset
  3974
    "Modified: / 11-09-2010 / 14:06:59 / cg"
9032
ef419ad5e15a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9030
diff changeset
  3975
!
ef419ad5e15a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9030
diff changeset
  3976
20856
f665f0659097 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 20855
diff changeset
  3977
defineCommandLineAsWorkspaceVariablesForScripts
f665f0659097 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 20855
diff changeset
  3978
    "/ enable this, so we can provide _$1.._$n in the script
20858
ffcbac4dd7ef #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 20857
diff changeset
  3979
    ParserFlags allowUnderscoreInIdentifier:true.
20856
f665f0659097 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 20855
diff changeset
  3980
    ParserFlags allowDollarInIdentifier:true.
f665f0659097 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 20855
diff changeset
  3981
    ParserFlags warnDollarInIdentifier:false.
20858
ffcbac4dd7ef #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 20857
diff changeset
  3982
    ParserFlags warnUnderscoreInIdentifier:false.
20859
b4091df11596 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 20858
diff changeset
  3983
    ParserFlags allowOldStyleAssignment:false.
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  3984
20856
f665f0659097 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 20855
diff changeset
  3985
    "/ add bindings for arguments
f665f0659097 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 20855
diff changeset
  3986
    Workspace workspaceVariableAt:('_$0') put:CommandName.
20857
e13cdc7188f1 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 20856
diff changeset
  3987
    Workspace workspaceVariableAt:('_$n') put:CommandLineArguments size.
20860
216e672e8d44 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 20859
diff changeset
  3988
    Workspace workspaceVariableAt:('_$$') put:CommandLineArguments.
20856
f665f0659097 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 20855
diff changeset
  3989
    CommandLineArguments doWithIndex:[:arg :i |
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  3990
	Workspace workspaceVariableAt:('_$',i printString) put:arg.
20856
f665f0659097 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 20855
diff changeset
  3991
    ].
f665f0659097 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 20855
diff changeset
  3992
!
f665f0659097 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 20855
diff changeset
  3993
7563
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  3994
displayInitializationDone
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  3995
    "inform the restart, that the display has been initialized"
6559
2ec6d0d1b821 Changed Workstation initialization
Stefan Vogel <sv@exept.de>
parents: 6539
diff changeset
  3996
2ec6d0d1b821 Changed Workstation initialization
Stefan Vogel <sv@exept.de>
parents: 6539
diff changeset
  3997
    CallbackSignal raiseRequest.
2ec6d0d1b821 Changed Workstation initialization
Stefan Vogel <sv@exept.de>
parents: 6539
diff changeset
  3998
!
2ec6d0d1b821 Changed Workstation initialization
Stefan Vogel <sv@exept.de>
parents: 6539
diff changeset
  3999
13893
580686880e8f added: #executeStartBlocks
Claus Gittinger <cg@exept.de>
parents: 13892
diff changeset
  4000
executeStartBlocks
580686880e8f added: #executeStartBlocks
Claus Gittinger <cg@exept.de>
parents: 13892
diff changeset
  4001
    |startBlocks|
580686880e8f added: #executeStartBlocks
Claus Gittinger <cg@exept.de>
parents: 13892
diff changeset
  4002
580686880e8f added: #executeStartBlocks
Claus Gittinger <cg@exept.de>
parents: 13892
diff changeset
  4003
    startBlocks := self startBlocks.
580686880e8f added: #executeStartBlocks
Claus Gittinger <cg@exept.de>
parents: 13892
diff changeset
  4004
    startBlocks notNil ifTrue:[
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4005
	'Smalltalk [info]: execute startBlocks...' infoPrintCR.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4006
	startBlocks do:[:aBlock|
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4007
	    Error handle:[:ex |
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4008
		InfoPrinting == true ifTrue:[
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4009
		    'Smalltalk [warning]: error caught in startBlock: ' infoPrint.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4010
		    ex description infoPrintCR.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4011
		    ex infoPrintCR.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4012
		    thisContext fullPrintAll.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4013
		].
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4014
	    ] do: aBlock
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4015
	].
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4016
	startBlocks removeAll.
13893
580686880e8f added: #executeStartBlocks
Claus Gittinger <cg@exept.de>
parents: 13892
diff changeset
  4017
    ].
580686880e8f added: #executeStartBlocks
Claus Gittinger <cg@exept.de>
parents: 13892
diff changeset
  4018
580686880e8f added: #executeStartBlocks
Claus Gittinger <cg@exept.de>
parents: 13892
diff changeset
  4019
    "Created: / 07-01-2012 / 12:58:39 / cg"
580686880e8f added: #executeStartBlocks
Claus Gittinger <cg@exept.de>
parents: 13892
diff changeset
  4020
!
580686880e8f added: #executeStartBlocks
Claus Gittinger <cg@exept.de>
parents: 13892
diff changeset
  4021
11375
bcdaeec8353c splash support
Claus Gittinger <cg@exept.de>
parents: 11367
diff changeset
  4022
hideSplashWindow
bcdaeec8353c splash support
Claus Gittinger <cg@exept.de>
parents: 11367
diff changeset
  4023
%{
bcdaeec8353c splash support
Claus Gittinger <cg@exept.de>
parents: 11367
diff changeset
  4024
#ifdef WIN32
bcdaeec8353c splash support
Claus Gittinger <cg@exept.de>
parents: 11367
diff changeset
  4025
    extern void __win32_hideSplashScreen();
bcdaeec8353c splash support
Claus Gittinger <cg@exept.de>
parents: 11367
diff changeset
  4026
bcdaeec8353c splash support
Claus Gittinger <cg@exept.de>
parents: 11367
diff changeset
  4027
    __win32_hideSplashScreen();
bcdaeec8353c splash support
Claus Gittinger <cg@exept.de>
parents: 11367
diff changeset
  4028
#endif
bcdaeec8353c splash support
Claus Gittinger <cg@exept.de>
parents: 11367
diff changeset
  4029
%}
bcdaeec8353c splash support
Claus Gittinger <cg@exept.de>
parents: 11367
diff changeset
  4030
!
bcdaeec8353c splash support
Claus Gittinger <cg@exept.de>
parents: 11367
diff changeset
  4031
20720
7e060ec1953c #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 20719
diff changeset
  4032
lateOpenDisplay
20737
cbaefc448648 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 20720
diff changeset
  4033
    "this is called when a view is opened without a display being already opened."
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  4034
22636
7607be4b8c15 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22572
diff changeset
  4035
    |display|
7607be4b8c15 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22572
diff changeset
  4036
7607be4b8c15 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22572
diff changeset
  4037
    display := Smalltalk openDisplay.
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  4038
    display notNil ifTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  4039
	IsRepl ifFalse:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  4040
	    display exitOnLastClose:true.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  4041
	].
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  4042
	"/ Processor exitWhenNoMoreUserProcesses:true.
22636
7607be4b8c15 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22572
diff changeset
  4043
    ].
7607be4b8c15 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22572
diff changeset
  4044
    ^ display
7607be4b8c15 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22572
diff changeset
  4045
7607be4b8c15 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22572
diff changeset
  4046
    "Modified: / 20-03-2018 / 12:43:29 / stefan"
20720
7e060ec1953c #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 20719
diff changeset
  4047
!
7e060ec1953c #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 20719
diff changeset
  4048
7563
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  4049
mainStartup:graphicalMode
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  4050
    "common start/restart action, if there is a Display, initialize it
1578
9df8cc1ec5c4 start & restart actions merged into a common method.
Claus Gittinger <cg@exept.de>
parents: 1573
diff changeset
  4051
     and start dispatching; otherwise go into a read-eval-print loop."
9df8cc1ec5c4 start & restart actions merged into a common method.
Claus Gittinger <cg@exept.de>
parents: 1573
diff changeset
  4052
9012
43ef70cac099 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9011
diff changeset
  4053
    |process imageName thisIsARestart idx|
1578
9df8cc1ec5c4 start & restart actions merged into a common method.
Claus Gittinger <cg@exept.de>
parents: 1573
diff changeset
  4054
23628
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4055
    VerboseStartup ifTrue:['mainStartup...' infoPrintCR].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4056
1578
9df8cc1ec5c4 start & restart actions merged into a common method.
Claus Gittinger <cg@exept.de>
parents: 1573
diff changeset
  4057
    imageName := ObjectMemory imageName.
2249
cdb6c87f0707 send returnFromSnapshot notification later -
Claus Gittinger <cg@exept.de>
parents: 2212
diff changeset
  4058
    thisIsARestart := imageName notNil.
1578
9df8cc1ec5c4 start & restart actions merged into a common method.
Claus Gittinger <cg@exept.de>
parents: 1573
diff changeset
  4059
19788
5b67ddd14655 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 19681
diff changeset
  4060
    true "graphicalMode" ifTrue:[
23628
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4061
        Display isNil ifTrue:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4062
            (StartupClass notNil
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4063
            and:[ (StartupClass perform:#isHeadless ifNotUnderstood:false) ]) ifFalse:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4064
                self openDisplay.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4065
            ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4066
        ].
10644
a67765a8a0d3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10643
diff changeset
  4067
    ].
a67765a8a0d3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10643
diff changeset
  4068
10645
48da7d0c8fb5 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10644
diff changeset
  4069
    StandAlone ifFalse:[
23628
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4070
        "
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4071
         enable the graphical debugger/inspector
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4072
         (they could have been (re)defined as autoloaded in the patches file)
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4073
        "
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4074
        VerboseStartup ifTrue:['initStandardTools...' infoPrintCR].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4075
        self initStandardTools.
10645
48da7d0c8fb5 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10644
diff changeset
  4076
    ].
48da7d0c8fb5 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10644
diff changeset
  4077
1578
9df8cc1ec5c4 start & restart actions merged into a common method.
Claus Gittinger <cg@exept.de>
parents: 1573
diff changeset
  4078
    "
10071
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
  4079
     if there is a display, start its event dispatcher
1578
9df8cc1ec5c4 start & restart actions merged into a common method.
Claus Gittinger <cg@exept.de>
parents: 1573
diff changeset
  4080
    "
9df8cc1ec5c4 start & restart actions merged into a common method.
Claus Gittinger <cg@exept.de>
parents: 1573
diff changeset
  4081
    Display notNil ifTrue:[
23628
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4082
        Display deviceIOTimeoutErrorSignal handlerBlock:[:ex |
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4083
            SaveEmergencyImage == true ifTrue:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4084
                'Display [warning]: broken display connection - emergency save in ''crash.img''.' infoPrintCR.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4085
                ObjectMemory primSnapShotOn:'crash.img'.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4086
            ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4087
            'Display [warning]: broken display connection - exit.' infoPrintCR.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4088
            self exit:11.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4089
        ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4090
        VerboseStartup ifTrue:['display-dispatch...' infoPrintCR].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4091
        Display startDispatch.
1578
9df8cc1ec5c4 start & restart actions merged into a common method.
Claus Gittinger <cg@exept.de>
parents: 1573
diff changeset
  4092
    ].
9df8cc1ec5c4 start & restart actions merged into a common method.
Claus Gittinger <cg@exept.de>
parents: 1573
diff changeset
  4093
9016
2979527dbdf4 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9015
diff changeset
  4094
    idx := CommandLineArguments indexOf:'--browserWindow:'.
9029
09b858d6135d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9028
diff changeset
  4095
    IsPlugin := (idx ~~ 0).
09b858d6135d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9028
diff changeset
  4096
    IsPlugin ifTrue:[
23628
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4097
        'Smalltalk [info]: startup browser window...' infoPrintCR.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4098
        self browserWindowStartup.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4099
        "/ not reached
9012
43ef70cac099 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9011
diff changeset
  4100
    ].
43ef70cac099 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9011
diff changeset
  4101
1578
9df8cc1ec5c4 start & restart actions merged into a common method.
Claus Gittinger <cg@exept.de>
parents: 1573
diff changeset
  4102
    Initializing := false.
9df8cc1ec5c4 start & restart actions merged into a common method.
Claus Gittinger <cg@exept.de>
parents: 1573
diff changeset
  4103
2074
01f7e1396c18 fixed standalone startup (broke when startupblocks where invented ...)
Claus Gittinger <cg@exept.de>
parents: 2050
diff changeset
  4104
    "/ start a process, which evaluates all StartBlocks
01f7e1396c18 fixed standalone startup (broke when startupblocks where invented ...)
Claus Gittinger <cg@exept.de>
parents: 2050
diff changeset
  4105
    "/ this used to be done right here (in this system-process),
01f7e1396c18 fixed standalone startup (broke when startupblocks where invented ...)
Claus Gittinger <cg@exept.de>
parents: 2050
diff changeset
  4106
    "/ but lead to trouble, when it suspended.
01f7e1396c18 fixed standalone startup (broke when startupblocks where invented ...)
Claus Gittinger <cg@exept.de>
parents: 2050
diff changeset
  4107
    "/ Therefore, it is now done by an extra user-process.
01f7e1396c18 fixed standalone startup (broke when startupblocks where invented ...)
Claus Gittinger <cg@exept.de>
parents: 2050
diff changeset
  4108
7043
d88be9c553d2 Release references to processes in #mainStartup:
Stefan Vogel <sv@exept.de>
parents: 7040
diff changeset
  4109
    process := [
23628
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4110
        VerboseStartup ifTrue:[ 'Smalltalk [info]: startup process 1 active.' infoPrintCR].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4111
        StartBlocks notNil ifTrue:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4112
            self executeStartBlocks.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4113
            StartBlocks := nil.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4114
        ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4115
        ImageStartBlocks notNil ifTrue:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4116
            VerboseStartup ifTrue:[ 'Smalltalk [info]: execute imageStartBlocks...' infoPrintCR].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4117
            ImageStartBlocks do:[:aBlock|
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4118
                VerboseStartup ifTrue:[ ('Smalltalk [info]: startBlock: %1...' bindWith:aBlock) infoPrintCR].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4119
                aBlock value
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4120
            ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4121
        ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4122
        StandAlone ifFalse:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4123
            (SilentLoading == true) ifFalse:[   "i.e. undefined counts as false"
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4124
                thisIsARestart ifTrue:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4125
                    Transcript cr.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4126
                    Transcript showCR:('Smalltalk restarted from:'
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4127
                                        , imageName
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4128
                                        , ' (saved '
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4129
                                        , ObjectMemory imageSaveTime printString
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4130
                                        , ')' ).
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4131
                ] ifFalse:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4132
                    Transcript showCR:(self hello).
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4133
                    Transcript showCR:(self copyrightString).
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4134
                ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4135
                Transcript cr.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4136
            ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4137
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4138
            DemoMode==true ifTrue:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4139
                Transcript showCR:'*** Restricted use:                              ***'.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4140
                Transcript showCR:'*** This program may be used for education only. ***'.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4141
                Transcript showCR:'*** Please read the files COPYRIGHT and LICENSE  ***'.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4142
                Transcript showCR:'*** for more details.                            ***'.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4143
                Transcript cr.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4144
            ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4145
        ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4146
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4147
        thisIsARestart ifTrue:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4148
            "/
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4149
            "/ the final late notification - users can now assume that
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4150
            "/ views, forms etc. have been recreated.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4151
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4152
            ObjectMemory changed:#returnFromSnapshot.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4153
        ]
7039
6f1c02381145 Do not keep reference to start block handler process.
Stefan Vogel <sv@exept.de>
parents: 7000
diff changeset
  4154
7040
d24ef75bc6c3 *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 7039
diff changeset
  4155
    ] newProcess.
d24ef75bc6c3 *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 7039
diff changeset
  4156
9043
e6106f500263 do not use numeric process prios
Claus Gittinger <cg@exept.de>
parents: 9036
diff changeset
  4157
    process priority:(Processor userSchedulingPriority).
7043
d88be9c553d2 Release references to processes in #mainStartup:
Stefan Vogel <sv@exept.de>
parents: 7040
diff changeset
  4158
    process name:'start block handler'.
d88be9c553d2 Release references to processes in #mainStartup:
Stefan Vogel <sv@exept.de>
parents: 7040
diff changeset
  4159
    process beGroupLeader.
d88be9c553d2 Release references to processes in #mainStartup:
Stefan Vogel <sv@exept.de>
parents: 7040
diff changeset
  4160
    process resume.
d88be9c553d2 Release references to processes in #mainStartup:
Stefan Vogel <sv@exept.de>
parents: 7040
diff changeset
  4161
    process := nil.
1650
b4b36961d1bc Add StartBlocks and ImageStartBlocks.
Stefan Vogel <sv@exept.de>
parents: 1647
diff changeset
  4162
10139
a3f6265978ad Start bachgroundCollector and -Finalizer in mainStartup
Stefan Vogel <sv@exept.de>
parents: 10131
diff changeset
  4163
    ObjectMemory startBackgroundCollectorAt:5.
a3f6265978ad Start bachgroundCollector and -Finalizer in mainStartup
Stefan Vogel <sv@exept.de>
parents: 10131
diff changeset
  4164
    ObjectMemory startBackgroundFinalizationAt:5.
1650
b4b36961d1bc Add StartBlocks and ImageStartBlocks.
Stefan Vogel <sv@exept.de>
parents: 1647
diff changeset
  4165
2074
01f7e1396c18 fixed standalone startup (broke when startupblocks where invented ...)
Claus Gittinger <cg@exept.de>
parents: 2050
diff changeset
  4166
    "/ start a process, which evaluates the startupClass>>startupSelector
01f7e1396c18 fixed standalone startup (broke when startupblocks where invented ...)
Claus Gittinger <cg@exept.de>
parents: 2050
diff changeset
  4167
    "/ message.
01f7e1396c18 fixed standalone startup (broke when startupblocks where invented ...)
Claus Gittinger <cg@exept.de>
parents: 2050
diff changeset
  4168
1578
9df8cc1ec5c4 start & restart actions merged into a common method.
Claus Gittinger <cg@exept.de>
parents: 1573
diff changeset
  4169
    (StartupClass notNil and:[StartupSelector notNil]) ifTrue:[
23628
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4170
        "
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4171
         allow more customization by reading an image specific rc-file
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4172
        "
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4173
        thisIsARestart ifTrue:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4174
            (imageName asFilename hasSuffix:'img') ifTrue:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4175
                imageName := imageName copyButLast:4
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4176
            ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4177
            self fileIn:(imageName , '.rc')
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4178
        ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4179
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4180
        Display notNil ifTrue:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4181
            Display exitOnLastClose:true.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4182
        ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4183
        Processor exitWhenNoMoreUserProcesses:true.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4184
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4185
        process := [
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4186
            'Smalltalk [info]: startup process 2 active.' infoPrintCR.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4187
            StandAlone ifTrue:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4188
                AbortOperationRequest handle:[:ex |
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4189
                    'Smalltalk [info]: aborted - exit.' infoPrintCR.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4190
                    OperatingSystem exit:1
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4191
                ] do:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4192
                    ('Smalltalk [info]: call ',StartupSelector,' of ',StartupClass name,' (1)') infoPrintCR.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4193
                    StartupClass perform:StartupSelector withArguments:StartupArguments.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4194
                ]
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4195
            ] ifFalse:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4196
                ('Smalltalk [info]: call ',StartupSelector,' of ',StartupClass name,' (2)') infoPrintCR.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4197
                StartupClass perform:StartupSelector withArguments:StartupArguments.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4198
            ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4199
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4200
            "/
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4201
            "/ non-GUI apps exit after the startup;
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4202
            "/ assume that GUI apps have created & opened some view ...
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4203
            "/
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4204
            Display isNil ifTrue:[
24136
0f13645d4faf #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24123
diff changeset
  4205
                (StartupClass perform:#isHeadless ifNotUnderstood:false) ifTrue:[
24094
76558849874f #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24062
diff changeset
  4206
                    Smalltalk exit:0.
76558849874f #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24062
diff changeset
  4207
                ].    
23628
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4208
                'Smalltalk [info]: no Display - exit.' infoPrintCR.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4209
                Smalltalk exit:11.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4210
            ].
16666
c343b9e62a1a class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16655
diff changeset
  4211
"/            "/
c343b9e62a1a class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16655
diff changeset
  4212
"/            "/ GUI apps exit after the last user process has finished
c343b9e62a1a class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16655
diff changeset
  4213
"/            "/
c343b9e62a1a class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16655
diff changeset
  4214
"/            Display exitOnLastClose:true.
23628
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4215
            Processor exitWhenNoMoreUserProcesses:true.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4216
        ] newProcess.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4217
        process priority:(Processor userSchedulingPriority).
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4218
        process name:'main'.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4219
        process beGroupLeader.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4220
        process resume.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4221
        process := nil.    "do not refer to process"
11681
4c274a7ef60c Fix stc compile error in prev change
Stefan Vogel <sv@exept.de>
parents: 11679
diff changeset
  4222
    ].
4c274a7ef60c Fix stc compile error in prev change
Stefan Vogel <sv@exept.de>
parents: 11679
diff changeset
  4223
4c274a7ef60c Fix stc compile error in prev change
Stefan Vogel <sv@exept.de>
parents: 11679
diff changeset
  4224
    StandAlone ifTrue:[
23628
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4225
        Display notNil ifTrue:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4226
            FlyByHelp notNil ifTrue:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4227
                FlyByHelp start
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4228
            ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4229
        ].
16211
656bd37ab2a4 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16199
diff changeset
  4230
    ].
656bd37ab2a4 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16199
diff changeset
  4231
20746
1dcfc78996ef #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 20743
diff changeset
  4232
"/    Display notNil ifTrue:[
1dcfc78996ef #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 20743
diff changeset
  4233
"/        Display exitOnLastClose:true.
1dcfc78996ef #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 20743
diff changeset
  4234
"/    ].
21592
abc75cdd7f65 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21586
diff changeset
  4235
    OperatingSystem finishLaunching.
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  4236
11681
4c274a7ef60c Fix stc compile error in prev change
Stefan Vogel <sv@exept.de>
parents: 11679
diff changeset
  4237
    "
4c274a7ef60c Fix stc compile error in prev change
Stefan Vogel <sv@exept.de>
parents: 11679
diff changeset
  4238
     if view-classes exist, start dispatching;
4c274a7ef60c Fix stc compile error in prev change
Stefan Vogel <sv@exept.de>
parents: 11679
diff changeset
  4239
     otherwise go into a read-eval-print loop
4c274a7ef60c Fix stc compile error in prev change
Stefan Vogel <sv@exept.de>
parents: 11679
diff changeset
  4240
    "
4c274a7ef60c Fix stc compile error in prev change
Stefan Vogel <sv@exept.de>
parents: 11679
diff changeset
  4241
    ((Display notNil and:[graphicalMode])
4c274a7ef60c Fix stc compile error in prev change
Stefan Vogel <sv@exept.de>
parents: 11679
diff changeset
  4242
     or:[process notNil
13851
5ab434e0a636 changed: #mainStartup: for scripting stand alone apps
Claus Gittinger <cg@exept.de>
parents: 13850
diff changeset
  4243
     or:[HeadlessOperation
20827
efb00b398fc8 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 20811
diff changeset
  4244
     or:[StandAlone]]]
efb00b398fc8 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 20811
diff changeset
  4245
    ) ifTrue:[
23628
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4246
        Processor exitWhenNoMoreUserProcesses:true.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4247
        Processor dispatchLoop.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4248
        "done - the last process finished"
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4249
        'Smalltalk [info]: last process finished - exit.' infoPrintCR.
11681
4c274a7ef60c Fix stc compile error in prev change
Stefan Vogel <sv@exept.de>
parents: 11679
diff changeset
  4250
    ] ifFalse:[
23628
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4251
        StandAlone ifFalse:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4252
            self readEvalPrintLoop
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4253
        ]
11681
4c274a7ef60c Fix stc compile error in prev change
Stefan Vogel <sv@exept.de>
parents: 11679
diff changeset
  4254
    ].
4c274a7ef60c Fix stc compile error in prev change
Stefan Vogel <sv@exept.de>
parents: 11679
diff changeset
  4255
4c274a7ef60c Fix stc compile error in prev change
Stefan Vogel <sv@exept.de>
parents: 11679
diff changeset
  4256
    self exit
4c274a7ef60c Fix stc compile error in prev change
Stefan Vogel <sv@exept.de>
parents: 11679
diff changeset
  4257
13526
cfa0ed74dd6f changed:
Claus Gittinger <cg@exept.de>
parents: 13518
diff changeset
  4258
    "Created: / 18-07-1996 / 21:07:39 / cg"
cfa0ed74dd6f changed:
Claus Gittinger <cg@exept.de>
parents: 13518
diff changeset
  4259
    "Modified: / 09-09-1996 / 17:42:50 / stefan"
21592
abc75cdd7f65 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21586
diff changeset
  4260
    "Modified: / 28-02-2017 / 10:59:43 / cg"
24136
0f13645d4faf #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24123
diff changeset
  4261
    "Modified: / 23-05-2019 / 11:24:37 / Claus Gittinger"
1578
9df8cc1ec5c4 start & restart actions merged into a common method.
Claus Gittinger <cg@exept.de>
parents: 1573
diff changeset
  4262
!
9df8cc1ec5c4 start & restart actions merged into a common method.
Claus Gittinger <cg@exept.de>
parents: 1573
diff changeset
  4263
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4264
openDisplay
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4265
    "try to open a display connection.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4266
     If so, also read display- and keyboard.rc"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4267
13385
0fa57f2d37f2 changed: #openDisplay
Stefan Vogel <sv@exept.de>
parents: 13370
diff changeset
  4268
    |commandName|
0fa57f2d37f2 changed: #openDisplay
Stefan Vogel <sv@exept.de>
parents: 13370
diff changeset
  4269
0fa57f2d37f2 changed: #openDisplay
Stefan Vogel <sv@exept.de>
parents: 13370
diff changeset
  4270
    commandName := Smalltalk commandName.
0fa57f2d37f2 changed: #openDisplay
Stefan Vogel <sv@exept.de>
parents: 13370
diff changeset
  4271
    (commandName, ' [info]: opening display...') infoPrintCR.
10649
82b327ec636d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10646
diff changeset
  4272
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4273
    Display isNil ifTrue:[
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  4274
	Screen notNil ifTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  4275
	    [
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  4276
		Screen openDefaultDisplay:nil.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  4277
	    ] on:Screen deviceOpenErrorSignal do:[:ex|
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  4278
		"do not use #errorPrintCR, it is no error, when an app supports display and no display.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  4279
		 in case shell exec 'app --version' we do not want this error string as part of the output"
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  4280
		('%1 [error]: No display connection to: %2' bindWith:commandName with:ex parameter) infoPrintCR.
19984
584c3db7e691 *** empty log message ***
sr
parents: 19974
diff changeset
  4281
"/                ('%1 [error]: No display connection to: %2' bindWith:commandName with:ex parameter) errorPrintCR.
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  4282
		(commandName, ' [info]: Either set the DISPLAY environment variable,') infoPrintCR.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  4283
		(commandName, ' [info]: or start smalltalk with a -display argument.') infoPrintCR.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  4284
		HeadlessOperation == true ifFalse:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  4285
		    OperatingSystem exit:1.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  4286
		].
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  4287
	    ].
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  4288
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  4289
	    Display notNil ifTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  4290
		(self secureFileIn:'display.rc') ifFalse:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  4291
		    "/ 'Smalltalk [warning]: no display.rc found; screen setting might be wrong.' errorPrintCR.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  4292
		    (self secureFileIn:'keyboard.rc') ifFalse:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  4293
			"/ 'Smalltalk [warning]: no keyboard.rc found; shortkey setting might be wrong.' errorPrintCR.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  4294
		    ]
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  4295
		]
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  4296
	    ].
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  4297
	]
22636
7607be4b8c15 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22572
diff changeset
  4298
    ].
7607be4b8c15 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22572
diff changeset
  4299
7607be4b8c15 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22572
diff changeset
  4300
    ^ Display
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4301
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4302
    "Created: / 06-12-2006 / 15:38:17 / cg"
22636
7607be4b8c15 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22572
diff changeset
  4303
    "Modified: / 20-03-2018 / 12:39:55 / stefan"
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4304
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4305
20757
b41faaeaf46e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 20755
diff changeset
  4306
providingDisplayDo:aBlock
b41faaeaf46e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 20755
diff changeset
  4307
    "/ provide a Display, if needed
b41faaeaf46e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 20755
diff changeset
  4308
    (Smalltalk at:#Screen) currentScreenQuerySignal handle:[:ex |
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  4309
	Display isNil ifTrue:[ self lateOpenDisplay ].
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  4310
	ex proceedWith:Display.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  4311
    ] do:aBlock
20757
b41faaeaf46e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 20755
diff changeset
  4312
!
b41faaeaf46e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 20755
diff changeset
  4313
20832
81f3da354a97 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 20831
diff changeset
  4314
readEvalPrintLoop
81f3da354a97 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 20831
diff changeset
  4315
    "say hello, then go into a read-eval-print loop"
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  4316
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4317
    "{ Pragma: +optSpace }"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4318
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  4319
    |repl|
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  4320
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  4321
    repl := ReadEvalPrintLoop new.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  4322
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  4323
    SilentLoading == true ifTrue:[
22792
642855917cc2 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22791
diff changeset
  4324
        repl answerPrompt:''.
642855917cc2 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22791
diff changeset
  4325
        repl prompt:''.
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  4326
    ] ifFalse:[
22792
642855917cc2 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22791
diff changeset
  4327
        Transcript showCR:(self hello).
642855917cc2 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22791
diff changeset
  4328
        Transcript showCR:(self copyrightString).
642855917cc2 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22791
diff changeset
  4329
        Transcript cr.
22793
d825d0de0d94 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22792
diff changeset
  4330
        Transcript showCR:'Read-eval-print loop.'.
d825d0de0d94 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22792
diff changeset
  4331
        Transcript showCR:'(exit with "#exit" or EOF; help with "?"; expressions are terminated with ".")'.
22792
642855917cc2 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22791
diff changeset
  4332
        repl prompt:'STX> '.
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  4333
    ].
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  4334
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  4335
    repl
22792
642855917cc2 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22791
diff changeset
  4336
        doChunkFormat:false;
22831
754ac658dc28 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 22799
diff changeset
  4337
        errorStream:Stderr;
22792
642855917cc2 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22791
diff changeset
  4338
        readEvalPrintLoop
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4339
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4340
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4341
restart
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4342
    "startup after an image has been loaded;
18385
2d0a9c256e0e class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 18384
diff changeset
  4343
     This is called by the VM's main entry - you should not find senders from Smalltalk.
2d0a9c256e0e class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 18384
diff changeset
  4344
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4345
     there are three change-notifications made to dependents of ObjectMemory,
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4346
     which allow a stepwise re-init: #earlyRestart, #restarted and #returnFromSnapshot.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4347
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4348
     #earlySystemInstallation is sent for ST80 compatibility
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4349
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4350
     #earlyRestart is send first, nothing has been setup yet.
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4351
		   (should be used to flush all device dependent entries)
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4352
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4353
     #restarted is send right after.
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4354
		   (should be used to recreate external resources (fds, bitmaps etc)
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4355
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4356
     #returnFromSnapshot is sent last
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4357
		   (should be used to restart processes, reOpen Streams which cannot
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4358
		    be automatically be reopened (i.e. Sockets, Pipes) and so on.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4359
		   (Notice that positionable fileStreams are already reopened and repositioned)
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4360
     "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4361
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4362
    |deb insp transcript idx|
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4363
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4364
    "/
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4365
    "/ when we arrive here, all objects from our previous life
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4366
    "/ have been reloaded - however, some may still contain invalid device
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4367
    "/ handles, display information etc.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4368
    "/ also, dynamically loaded modules have not yet been reloaded yet.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4369
    "/ and the concrete OS, concrete FileName etc. are still refering to
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4370
    "/ the previous classes.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4371
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4372
    Initializing := true.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4373
    AbstractOperatingSystem initializeConcreteClass.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4374
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4375
    ImageRestartTime := Timestamp now.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4376
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4377
    CommandLine := CommandLineArguments copy.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4378
    CommandLineArguments := CommandLineArguments asOrderedCollection.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4379
    CommandName := CommandLineArguments removeFirst. "/ the command
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4380
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4381
    idx := CommandLineArguments indexOf:'-q'.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4382
    idx == 0 ifTrue:[
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4383
	idx := CommandLineArguments indexOf:'--silent'.
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4384
    ].
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4385
    idx ~~ 0 ifTrue:[
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4386
	Object infoPrinting:false.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4387
	ObjectMemory infoPrinting:false.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4388
	CommandLineArguments removeAtIndex:idx.
16269
b5bc3b162a92 class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 16252
diff changeset
  4389
    ].
b5bc3b162a92 class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 16252
diff changeset
  4390
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4391
    "/ start catching SIGSEGV and SIGBUS
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4392
    OperatingSystem enableHardSignalInterrupts.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4393
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4394
    "/ reinit Filename
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4395
    Filename reinitialize.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4396
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4397
    "/ flush cached path directories (may have changed in the meanwhile)
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4398
    self flushPathCaches.
15334
aead0a7a558a class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15333
diff changeset
  4399
    self reinitializePackagePath.
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4400
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4401
    "/ reinit the default streams: Stdin, Stdout and Stderr
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4402
    "/ after that, we can write to stderr.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4403
    self reinitStandardStreams.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4404
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4405
    "/ redirect Transcript to Stderr during startup
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4406
    transcript := Transcript.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4407
    Transcript := Stderr.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4408
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4409
    "/ temporary switch back to dumb interface -
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4410
    "/ to handle errors while view-stuff is not yet reinitialized
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4411
    insp := Inspector.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4412
    deb := Debugger.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4413
    deb notNil ifTrue:[
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4414
	deb reinitialize
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4415
    ].
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4416
    Inspector := MiniInspector.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4417
    Debugger := MiniDebugger.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4418
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4419
    "/ reload any dynamically loaded objects.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4420
    "/ this must be done before doing anything else below,
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4421
    "/ because the Processor may restart processes which use
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4422
    "/ this code.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4423
    "/ Also, a dynamic object might be registered as dependent of
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4424
    "/ ObjectFileLoader; therefore, must reload before doing any notifications.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4425
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4426
    ObjectFileLoader notNil ifTrue:[
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4427
	ObjectFileLoader reloadAllRememberedObjectFiles.
16269
b5bc3b162a92 class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 16252
diff changeset
  4428
    ].
b5bc3b162a92 class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 16252
diff changeset
  4429
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4430
    "/ invalidate all display connections.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4431
    "/ This is required to avoid trouble if someone accesses
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4432
    "/ a display during early startup.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4433
    Screen notNil ifTrue:[
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4434
	Screen allScreens do:[:eachDisplay |
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4435
	    eachDisplay invalidateConnection.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4436
	].
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4437
    ].
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4438
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4439
    ObjectMemory changed:#earlySystemInstallation.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4440
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4441
    "/ reinitialize the Processor - restartable processes
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4442
    "/ are now restarted here (but not yet scheduled).
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4443
    Processor reinitialize.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4444
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4445
    "/ flush device handles & recreate OS resources (if possible)
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4446
    "/ (mostly view/GC/color & font stuff)
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4447
    ObjectMemory
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4448
	changed:#earlyRestart; changed:#restarted.
16269
b5bc3b162a92 class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 16252
diff changeset
  4449
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4450
    "/ start catching SIGINT and SIGQUIT
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4451
    OperatingSystem enableUserInterrupts.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4452
    OperatingSystem enableCrashSignalInterrupts.
12782
226df0172288 changed: #restart
Stefan Vogel <sv@exept.de>
parents: 12780
diff changeset
  4453
    ObjectMemory restoreGarbageCollectorSettings.
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4454
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4455
    "/ give user a chance to re-customize things in smalltalk_r.rc.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4456
    "/ reading if smalltalk_r.rc may be suppressed by the --faststart argument.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4457
    idx := CommandLineArguments indexOf:'--faststart'.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4458
    idx == 0 ifTrue:[
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4459
	idx := CommandLineArguments indexOf:'--fastStart'.
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4460
    ].
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4461
    idx ~~ 0 ifTrue:[
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4462
	CommandLineArguments removeAtIndex:idx.
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4463
    ] ifFalse:[
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4464
	CallbackSignal := QuerySignal new.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4465
	[
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4466
	    Class withoutUpdatingChangesDo:[
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4467
		(self fileIn:(self commandName , '_r.rc')) ifFalse:[
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4468
		    "no _r.rc file where executable is; try default smalltalk_r.rc"
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4469
		    self fileIn:'smalltalk_r.rc'
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4470
		].
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4471
	    ]
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4472
	] on:CallbackSignal do:[:ex|
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4473
	    "/ now, display and view-stuff works;
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4474
	    "/ back to the previous debugging interface
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4475
	    Inspector := insp.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4476
	    Debugger := deb.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4477
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4478
	    "/ reinstall Transcript, if not changed during restart.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4479
	    "/ if there was no Transcript, go to stderr
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4480
	    (transcript notNil and:[Transcript == Stderr]) ifTrue:[
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4481
		Transcript := transcript.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4482
	    ].
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4483
	    Initializing := false.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4484
	    ex proceed.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4485
	].
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4486
	CallbackSignal := nil.
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4487
    ].
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4488
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4489
    "/ reinitialization (restart) of Display is normally performed
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4490
    "/ in the restart script. If this has not been run for some reason,
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4491
    "/ do in now.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4492
    Initializing ifTrue:[
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4493
	Display notNil ifTrue:[
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4494
	    [
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4495
		Display reinitializeFor:Screen defaultDisplayName.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4496
	    ] on:Screen deviceOpenErrorSignal do:[
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4497
		'Smalltalk [error]: Cannot restart connection to: ' errorPrint.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4498
		Screen defaultDisplayName errorPrintCR.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4499
		OperatingSystem exit:1.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4500
	    ].
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4501
	].
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4502
	"/ now, display and view-stuff works;
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4503
	"/ back to the previous debugging interface
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4504
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4505
	Inspector := insp.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4506
	Debugger := deb.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4507
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4508
	"/ reinstall Transcript, if not changed during restart.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4509
	"/ if there was no Transcript, go to stderr
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4510
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4511
	(transcript notNil and:[Transcript == Stderr]) ifTrue:[
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4512
	    Transcript := transcript.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4513
	].
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4514
	Initializing := false.
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4515
    ].
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4516
    Screen notNil ifTrue:[
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4517
	"clean up leftover screens (and views) that haven't been reopened.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4518
	 Operate on a copy, since brokenConnection removes us from AllScreens"
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4519
	Screen allScreens copy do:[:eachDisplay |
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4520
	    eachDisplay isOpen ifFalse:[
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4521
		'Smalltalk [info]: cannot reopen secondary display: ' errorPrint.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4522
		eachDisplay errorPrintCR.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4523
		eachDisplay cleanupAfterDispatch; brokenConnection.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4524
	    ]
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4525
	].
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4526
    ].
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4527
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4528
    deb := insp := transcript := nil.   "avoid dangling refs"
13526
cfa0ed74dd6f changed:
Claus Gittinger <cg@exept.de>
parents: 13518
diff changeset
  4529
    (StartupClass perform:#keepSplashWindowOpen ifNotUnderstood:[false]) ifFalse:[
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4530
	self hideSplashWindow.   "/ if there is one, it's now time to hide it
13526
cfa0ed74dd6f changed:
Claus Gittinger <cg@exept.de>
parents: 13518
diff changeset
  4531
    ].
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4532
    self mainStartup:true
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  4533
13526
cfa0ed74dd6f changed:
Claus Gittinger <cg@exept.de>
parents: 13518
diff changeset
  4534
    "Modified: / 03-08-1999 / 09:42:21 / stefan"
cfa0ed74dd6f changed:
Claus Gittinger <cg@exept.de>
parents: 13518
diff changeset
  4535
    "Modified: / 29-07-2011 / 17:58:23 / cg"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4536
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4537
11399
19962a6e2972 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11393
diff changeset
  4538
showSplashMessage:aString
19962a6e2972 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11393
diff changeset
  4539
    "put the message into the splash screen (if there is one).
19962a6e2972 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11393
diff changeset
  4540
     Use this for messages during startup"
19962a6e2972 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11393
diff changeset
  4541
19962a6e2972 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11393
diff changeset
  4542
    self showSplashMessage:aString color:nil.
19962a6e2972 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11393
diff changeset
  4543
!
19962a6e2972 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11393
diff changeset
  4544
11388
292d92d3ed5e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11387
diff changeset
  4545
showSplashMessage:aMessageStringOrNil color:rgbValueOrNil
11389
4f63adbf978a comments
Claus Gittinger <cg@exept.de>
parents: 11388
diff changeset
  4546
    "put the message into the splash screen (if there is one)."
4f63adbf978a comments
Claus Gittinger <cg@exept.de>
parents: 11388
diff changeset
  4547
11388
292d92d3ed5e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11387
diff changeset
  4548
%{
292d92d3ed5e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11387
diff changeset
  4549
#ifdef WIN32
292d92d3ed5e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11387
diff changeset
  4550
    extern void __win32_splashMessage();
292d92d3ed5e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11387
diff changeset
  4551
    char *msg = (char *)0;
292d92d3ed5e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11387
diff changeset
  4552
    int clr = 0;
292d92d3ed5e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11387
diff changeset
  4553
12481
805176d238d2 change __isString() to __isStringLike() in primitive code
Stefan Vogel <sv@exept.de>
parents: 12413
diff changeset
  4554
    if (__isStringLike(aMessageStringOrNil)) {
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4555
	msg = __stringVal(aMessageStringOrNil);
11388
292d92d3ed5e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11387
diff changeset
  4556
    }
292d92d3ed5e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11387
diff changeset
  4557
    if (__isSmallInteger(rgbValueOrNil)) {
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4558
	clr = __intVal(rgbValueOrNil);
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  4559
	__win32_splashMessageColor(clr);
11388
292d92d3ed5e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11387
diff changeset
  4560
    }
292d92d3ed5e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11387
diff changeset
  4561
    __win32_splashMessage(msg);
292d92d3ed5e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11387
diff changeset
  4562
#endif
292d92d3ed5e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11387
diff changeset
  4563
%}
292d92d3ed5e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11387
diff changeset
  4564
!
292d92d3ed5e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11387
diff changeset
  4565
292d92d3ed5e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11387
diff changeset
  4566
splashInfo:aString
11389
4f63adbf978a comments
Claus Gittinger <cg@exept.de>
parents: 11388
diff changeset
  4567
    "like infoPrintCR,
4f63adbf978a comments
Claus Gittinger <cg@exept.de>
parents: 11388
diff changeset
  4568
     but in addition put the message into the splash screen (if there is one).
4f63adbf978a comments
Claus Gittinger <cg@exept.de>
parents: 11388
diff changeset
  4569
     Use this for info messages during startup"
4f63adbf978a comments
Claus Gittinger <cg@exept.de>
parents: 11388
diff changeset
  4570
12883
133a10b7bd12 changed: #splashInfo:
Claus Gittinger <cg@exept.de>
parents: 12867
diff changeset
  4571
    aString notNil ifTrue:[ aString infoPrintCR ].
11388
292d92d3ed5e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11387
diff changeset
  4572
    self showSplashMessage:aString color:nil.
292d92d3ed5e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11387
diff changeset
  4573
!
292d92d3ed5e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11387
diff changeset
  4574
7563
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  4575
start
20831
020ba0f38412 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 20830
diff changeset
  4576
    "low level entry from the VM's main.
020ba0f38412 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 20830
diff changeset
  4577
     After initializeSystem, this is the very first real entry into the Smalltalk world.
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  4578
     Analyzes the command line and checks what to do
20831
020ba0f38412 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 20830
diff changeset
  4579
     (i.e. script/repl/eval or full blown IDE).
020ba0f38412 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 20830
diff changeset
  4580
     Also handles --load and various debug options.
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  4581
     Caveat:
23628
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4582
        this has become too complicated and desperately needs a rewrite.
21020
55d520adcce5 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21019
diff changeset
  4583
55d520adcce5 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21019
diff changeset
  4584
     Also:
23628
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4585
        Be very careful when changing things here;
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4586
        especially be careful to ensure that the scripting options are robust against any
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4587
        missing packages; so the error handlers should not depend on any stream, logger etc. features.
21020
55d520adcce5 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21019
diff changeset
  4588
     "
617
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  4589
15872
605d272f5e1c class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15783
diff changeset
  4590
    |idx graphicalMode arg didReadRCFile keepSplashWindow|
960
e3b75f50d0cd changes for standAlone operation
Claus Gittinger <cg@exept.de>
parents: 948
diff changeset
  4591
23628
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4592
    VerboseStartup ifTrue:['start...' infoPrintCR].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4593
19597
435f19b58541 #FEATURE by sr
sr
parents: 19589
diff changeset
  4594
    graphicalMode := Smalltalk isSmalltalkDevelopmentSystem.
617
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  4595
    Initializing := true.
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  4596
15872
605d272f5e1c class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15783
diff changeset
  4597
    keepSplashWindow := StartupClass perform:#keepSplashWindowOpen ifNotUnderstood:[false].
13526
cfa0ed74dd6f changed:
Claus Gittinger <cg@exept.de>
parents: 13518
diff changeset
  4598
23628
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4599
    "/ remove possibly leftover --debug arg (not removed in initVerboseFlags, for whatever reason)
21016
94e96557d795 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21015
diff changeset
  4600
    idx := CommandLineArguments indexOf:'--debug'.
94e96557d795 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21015
diff changeset
  4601
    (idx ~~ 0) ifTrue:[
23628
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4602
        CommandLineArguments removeAtIndex:idx.
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  4603
    ].
21016
94e96557d795 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21015
diff changeset
  4604
617
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  4605
    "
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  4606
     while reading patches- and rc-file, do not add things into change-file
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  4607
    "
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  4608
    Class withoutUpdatingChangesDo:[
23628
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4609
        |commandFiles rcFile defaultRC prevCatchSetting
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4610
         isEval isPrint isFilter isRepl isRunMain idxFileArg process|
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4611
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4612
        isEval := isPrint := isFilter := isRepl := isRunMain := false.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4613
        didReadRCFile := false.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4614
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4615
        StandAlone ifFalse:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4616
            "/ self initializeVerboseFlags.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4617
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4618
            "/
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4619
            "/ look for any '-q', '-e', '-l' or '-f' command line arguments
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4620
            "/ and handle them;
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4621
            "/ read startup and patches file
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4622
            "/
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4623
            idx := CommandLineArguments indexOfAny:#('-R' '--repl').
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4624
            isRepl := IsRepl := (idx ~~ 0).
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4625
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4626
            idx := CommandLineArguments indexOfAny:#('-q' '--silent').
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4627
            idx ~~ 0 ifTrue:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4628
                Object infoPrinting:false.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4629
                ObjectMemory infoPrinting:false.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4630
                CommandLineArguments removeAtIndex:idx.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4631
                SilentLoading := true.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4632
            ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4633
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4634
            [
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4635
                idx := CommandLineArguments indexOfAny:#('-pp' '--packagePath').
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4636
                idx ~~ 0
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4637
            ] whileTrue:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4638
                arg := CommandLineArguments at:idx + 1.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4639
                CommandLineArguments removeAtIndex:idx+1; removeAtIndex:idx.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4640
                (arg asCollectionOfSubstringsSeparatedByAny:',;') do:[:each |
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4641
                    self packagePath addLast:each.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4642
                    VerboseStartup ifTrue:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4643
                        ('Smalltalk [info]: add to packagePath: "', arg, '".') infoPrintCR.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4644
                    ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4645
                ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4646
            ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4647
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4648
            [
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4649
                idx := CommandLineArguments indexOfAny:#('-l' '--load').
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4650
                idx ~~ 0
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4651
            ] whileTrue:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4652
                arg := CommandLineArguments at:idx + 1.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4653
                CommandLineArguments removeAtIndex:idx+1; removeAtIndex:idx.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4654
                Smalltalk silentlyLoadingDo:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4655
                    (arg asCollectionOfSubstringsSeparatedByAny:',;') do:[:each |
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4656
                        each asFilename exists ifTrue:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4657
                            (VerboseStartup | VerboseLoading) ifTrue:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4658
                                ('Smalltalk [info]: loading file: "', each, '".') infoPrintCR.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4659
                            ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4660
                            Smalltalk fileIn:each
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4661
                        ] ifFalse:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4662
                            (VerboseStartup | VerboseLoading) ifTrue:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4663
                                ('Smalltalk [info]: loading package: "', each, '".') infoPrintCR.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4664
                            ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4665
                            Smalltalk loadPackage:each
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4666
                        ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4667
                    ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4668
                ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4669
            ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4670
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4671
            "/ look for a '-e filename' or '--execute filename' or '--script filename' argument
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4672
            "/ this will force fileIn of filename only, no standard startup.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4673
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4674
            idx := CommandLineArguments indexOfAny:#('-e' '--execute' '--script').
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4675
            idx ~~ 0 ifTrue:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4676
                SilentLoading := true.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4677
                CommandName := arg := CommandLineArguments at:idx + 1.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4678
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4679
                CommandLineArguments
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4680
                    removeAtIndex:idx+1; removeAtIndex:idx.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4681
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4682
                self startSchedulerAndBackgroundCollector.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4683
                keepSplashWindow ifFalse:[ self hideSplashWindow ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4684
                Initializing := false.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4685
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4686
                process := [
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4687
                    Processor exitWhenNoMoreUserProcesses:true.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4688
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4689
                    "/ set workspace variables
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4690
                    self defineCommandLineAsWorkspaceVariablesForScripts.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4691
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4692
                    "/ provide a Display, if needed
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4693
                    self providingDisplayDo:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4694
                        VerboseStartup ifTrue:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4695
                            ('Smalltalk [info]: reading script from: "', arg, '".') infoPrintCR.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4696
                        ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4697
                        NoHandlerError handle:[:ex |
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4698
                            Debugging == true ifTrue:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4699
                                MiniDebugger enterException:ex.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4700
                            ] ifFalse:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4701
                                Silent ifFalse:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4702
                                    'Smalltalk [error]: ' _errorPrint. ex exception description _errorPrintCR.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4703
                                ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4704
                                (VerboseStartup or:[ObjectMemory debugPrinting]) ifTrue:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4705
                                    ex suspendedContext fullPrintAll.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4706
                                ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4707
                                self exit:1.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4708
                            ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4709
                            self exit:1.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4710
                            "/ ex reject.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4711
                        ] do:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4712
                            UserInterrupt handle:[:ex |
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4713
                                Debugging == true ifTrue:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4714
                                    'user interrupt (type "c" to continue; "x" to exit; "?" for help).' errorPrintCR.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4715
                                    "/ thisContext fullPrintAll.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4716
                                    MiniDebugger enterException:ex.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4717
                                    ex proceed.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4718
                                ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4719
                                Silent ifFalse:[ 'user interrupt.' errorPrintCR ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4720
                                self exit:128+(OperatingSystem sigINT).
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4721
                            ] do:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4722
                                |cmdStream result|
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4723
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4724
                                arg = '-' ifTrue:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4725
                                    cmdStream := Stdin.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4726
                                ] ifFalse:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4727
                                    IsSTScript := true.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4728
                                    cmdStream := arg asFilename readStream.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4729
                                ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4730
                                result := [
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4731
                                    self fileInStream:cmdStream
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4732
                                           lazy:nil
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4733
                                           silent:self verbose not
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4734
                                           logged:false
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4735
                                           addPath:nil
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4736
                                ] ensure:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4737
                                    IsSTScript ifTrue:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4738
                                        "/ do not close Stdin
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4739
                                        cmdStream close.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4740
                                    ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4741
                                ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4742
                                result ifFalse:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4743
                                    self exit:1.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4744
                                ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4745
                            ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4746
                        ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4747
                    ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4748
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4749
                    "/ after the script, if Screen has been opened and there are any open windows,
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4750
                    "/ then do not exit
20758
212ca877b8af #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 20757
diff changeset
  4751
false ifTrue:[
23628
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4752
                    Display notNil ifTrue:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4753
                        Processor exitWhenNoMoreUserProcesses:true.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4754
                        "/ Display exitOnLastClose:true.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4755
                        "/ Display checkForEndOfDispatch.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4756
                    ] ifFalse:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4757
                        self exit.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4758
                    ].
20758
212ca877b8af #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 20757
diff changeset
  4759
].
23628
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4760
                ] newProcess.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4761
                process priority:(Processor userSchedulingPriority).
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4762
                process name:'main'.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4763
                process beGroupLeader.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4764
                process resume.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4765
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4766
                Processor dispatchLoop.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4767
                self exit
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4768
            ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4769
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4770
            "look for a '-f filename' or '--file filename' argument
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4771
             if scripting, these are loaded before -P, -E or -R action.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4772
             if not scripting, this will force evaluation of filename instead of smalltalk.rc"
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4773
            [
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4774
                idxFileArg := CommandLineArguments indexOfAny:#('-f' '--file').
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4775
                (idxFileArg ~~ 0)
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4776
            ] whileTrue:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4777
                commandFiles isNil ifTrue:[ commandFiles := OrderedCollection new ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4778
                commandFiles add:(CommandLineArguments at:idxFileArg+1).
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4779
                CommandLineArguments removeAtIndex:idxFileArg+1; removeAtIndex:idxFileArg.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4780
            ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4781
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4782
            "/ look for a '-E expr' or '--eval expr' argument (-P or --print to print the result of evaluation)
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4783
            "/ or -F/--filter or a '--repl' argument
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4784
            "/ E, P and F this will force evaluation of expr only, no standard startup
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4785
            "/ repl go into an interactive loop.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4786
            idx := CommandLineArguments indexOfAny:#('-E' '--eval').
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4787
            (isEval := (idx ~~ 0)) ifFalse:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4788
                idx := CommandLineArguments indexOfAny:#('-P' '--print').
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4789
                (isPrint := (idx ~~ 0)) ifFalse:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4790
                    idx := CommandLineArguments indexOfAny:#('-F' '--filter').
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4791
                    (isFilter := (idx ~~ 0)) ifFalse:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4792
                        idx := CommandLineArguments indexOfAny:#('-R' '--repl').
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4793
                        (isRepl := (idx ~~ 0)) ifFalse:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4794
                            idx := CommandLineArguments indexOfAny:#('--run').
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4795
                            isRunMain := (idx ~~ 0)
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4796
                        ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4797
                    ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4798
                ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4799
            ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4800
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4801
            (isEval | isPrint | isFilter | isRepl | isRunMain) ifTrue:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4802
                |args|
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4803
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4804
                VerboseStartup ifTrue:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4805
                    ('Smalltalk [info]: eval/filter/print or repl') infoPrintCR.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4806
                ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4807
                isRepl ifFalse:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4808
                    CommandLineArguments size <= idx ifTrue:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4809
                        StandAlone := true.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4810
                        self exitWithErrorMessage:'missing argument after -E/-P/-F/--run.'.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4811
                    ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4812
                    isFilter ifTrue:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4813
                        args := CommandLineArguments copyFrom:idx + 1.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4814
                        CommandLineArguments removeFromIndex:idx+1.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4815
                        VerboseStartup ifTrue:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4816
                            ('Smalltalk [info]: filter expression(s): ') infoPrint.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4817
                            args infoPrintCR.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4818
                        ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4819
                    ] ifFalse:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4820
                        arg := CommandLineArguments at:idx + 1.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4821
                        CommandLineArguments removeAtIndex:idx+1.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4822
                        VerboseStartup ifTrue:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4823
                            ('Smalltalk [info]: eval expression: ') infoPrint.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4824
                            arg infoPrintCR.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4825
                        ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4826
                    ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4827
                ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4828
                CommandLineArguments removeAtIndex:idx.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4829
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4830
                self startSchedulerAndBackgroundCollector.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4831
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4832
                keepSplashWindow ifFalse:[ self hideSplashWindow ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4833
                Initializing := false.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4834
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4835
                "/ set workspace variables
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4836
                self defineCommandLineAsWorkspaceVariablesForScripts.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4837
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4838
                "/ all of the above allow for a -f file to be loaded before any other action
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4839
                (commandFiles notEmptyOrNil) ifTrue:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4840
                    commandFiles do:[:commandFile |
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4841
                        (VerboseStartup | VerboseLoading) ifTrue:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4842
                            ('Smalltalk [info]: reading command file from: "', commandFile, '".') infoPrintCR.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4843
                        ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4844
                        Smalltalk silentlyLoadingDo:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4845
                            (self secureFileIn:commandFile) ifFalse:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4846
                                StandAlone := true.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4847
                                self exitWithErrorMessage:('"', commandFile, '" not found.').
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4848
                            ]
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4849
                        ]
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4850
                    ]
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4851
                ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4852
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4853
                isRepl ifFalse:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4854
                    Debugging == true ifFalse:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4855
                        "/ remove the Debugger
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4856
                        Debugger := nil.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4857
                    ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4858
                ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4859
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4860
                process := [
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4861
                    self providingDisplayDo:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4862
                        isRepl ifTrue:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4863
                            Processor exitWhenNoMoreUserProcesses:false.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4864
                            Processor activeProcess name:'repl'.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4865
                            self readEvalPrintLoop.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4866
                            self exit.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4867
                        ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4868
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4869
                        Processor exitWhenNoMoreUserProcesses:true.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4870
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4871
                        NoHandlerError handle:[:ex |
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4872
                            Debugging == true ifTrue:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4873
                                MiniDebugger enterException:ex.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4874
                            ] ifFalse:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4875
                                Silent ifFalse:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4876
                                    'Smalltalk [error]: ' _errorPrint. ex description _errorPrintCR.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4877
                                ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4878
                                (VerboseStartup or:[ObjectMemory debugPrinting]) ifTrue:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4879
                                    ex suspendedContext fullPrintAll.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4880
                                ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4881
                                self exit:1.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4882
                            ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4883
                            self exit:1.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4884
                            "/ ex reject.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4885
                        ] do:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4886
                            UserInterrupt handle:[:ex |
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4887
                                Debugging == true ifTrue:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4888
                                    'user interrupt (type "c" to continue; "x" to exit; "?" for help).' errorPrintCR.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4889
                                    "/ thisContext fullPrintAll.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4890
                                    MiniDebugger enterException:ex.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4891
                                    ex proceed.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4892
                                ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4893
                                Silent ifFalse:[ 'user interrupt.' errorPrintCR ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4894
                                self exit:128+(OperatingSystem sigINT).
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4895
                            ] do:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4896
                                |filterCode filterStart filterEnd|
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4897
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4898
                                isFilter ifTrue:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4899
                                    "/ --filter - apply code to each input line.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4900
                                    "/ compile code only once
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4901
                                    (args size == 1) ifTrue:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4902
                                        VerboseStartup ifTrue:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4903
                                            'Smalltalk [info]: filter 1-arg' infoPrintCR.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4904
                                        ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4905
                                        filterCode := args at:1.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4906
                                    ] ifFalse:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4907
                                        (args size == 3) ifTrue:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4908
                                            VerboseStartup ifTrue:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4909
                                                'Smalltalk [info]: filter 3-arg' infoPrintCR.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4910
                                            ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4911
                                            filterStart := args at:1.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4912
                                            filterCode := args at:2.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4913
                                            filterEnd := args at:3.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4914
                                        ] ifFalse:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4915
                                            StandAlone := true.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4916
                                            self exitWithErrorMessage:'--filter must be followed by 1 or 3 expression arg(s)'
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4917
                                        ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4918
                                    ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4919
                                    filterStart notEmptyOrNil ifTrue:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4920
                                        VerboseStartup ifTrue:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4921
                                            ('Smalltalk [info]: eval: "', filterStart, '"...') infoPrintCR.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4922
                                        ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4923
                                        Compiler evaluate:filterStart notifying:(EvalScriptingErrorHandler new source:filterStart)
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4924
                                    ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4925
                                    VerboseStartup ifTrue:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4926
                                        ('Smalltalk [info]: compile: "', filterCode, '"...') infoPrintCR.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4927
                                    ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4928
                                    Compiler
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4929
                                        compile:'doIt:line ',filterCode
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4930
                                        forClass:String
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4931
                                        notifying:(EvalScriptingErrorHandler new source:filterCode).
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4932
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4933
                                    [Stdin atEnd] whileFalse:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4934
                                        |line|
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4935
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4936
                                        line := Stdin nextLine.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4937
                                        line doIt:line.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4938
                                    ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4939
                                    filterEnd notEmptyOrNil ifTrue:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4940
                                        VerboseStartup ifTrue:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4941
                                            ('Smalltalk [info]: eval: "', filterEnd, '"...') infoPrintCR.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4942
                                        ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4943
                                        Compiler evaluate:filterEnd notifying:(EvalScriptingErrorHandler new source:filterEnd)
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4944
                                    ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4945
                                ] ifFalse:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4946
                                    (isPrint | isEval) ifTrue:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4947
                                        "/ --print or --eval
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4948
                                        |rslt|
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4949
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4950
                                        rslt := Parser new
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4951
                                                    evaluate:arg
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4952
                                                    notifying:(EvalScriptingErrorHandler new source:arg)
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4953
                                                    compile:true.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4954
                                        isPrint ifTrue:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4955
                                            rslt printCR.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4956
                                        ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4957
                                    ] ifFalse:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4958
                                        "/ --run <className>
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4959
                                        |className class|
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4960
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4961
                                        className := arg.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4962
                                        class := Smalltalk classNamed:className.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4963
                                        class isNil ifTrue:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4964
                                            StandAlone := true.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4965
                                            self exitWithErrorMessage:'no such class: "', className, '".'
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4966
                                        ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4967
                                        (class respondsTo:#main:) ifTrue:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4968
                                            class main:CommandLineArguments.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4969
                                        ] ifFalse:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4970
                                            (class respondsTo:#main) ifTrue:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4971
                                                class main.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4972
                                            ] ifFalse:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4973
                                                (class respondsTo:#start) ifTrue:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4974
                                                    class start.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4975
                                                ] ifFalse:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4976
                                                    StandAlone := true.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4977
                                                    self exitWithErrorMessage:'class has no "main:", "main" or "start" method.'
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4978
                                                ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4979
                                            ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4980
                                        ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4981
                                    ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4982
                                ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4983
                            ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4984
                        ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4985
                    ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4986
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4987
                    "/ after the script, if Screen has been opened and there are any open windows,
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4988
                    "/ then do not exit
20758
212ca877b8af #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 20757
diff changeset
  4989
false ifTrue:[
23628
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4990
                    Display notNil ifTrue:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4991
                        Processor exitWhenNoMoreUserProcesses:true.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4992
                        "/ Display exitOnLastClose:true.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4993
                        "/ Display checkForEndOfDispatch.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4994
                        VerboseStartup ifTrue:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4995
                            ('Smalltalk [info]: display opened.') infoPrintCR.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4996
                        ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4997
                    ] ifFalse:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4998
                        VerboseStartup ifTrue:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  4999
                            ('Smalltalk [info]: no display - exit after script.') infoPrintCR.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5000
                        ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5001
                        self exit.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5002
                    ].
20758
212ca877b8af #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 20757
diff changeset
  5003
].
23628
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5004
                    VerboseStartup ifTrue:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5005
                        ('Smalltalk [info]: script/repl/eval finished.') infoPrintCR.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5006
                    ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5007
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5008
                ] newProcess.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5009
                process priority:(Processor userSchedulingPriority).
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5010
                process name:'main'.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5011
                process beGroupLeader.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5012
                process resume.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5013
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5014
                Processor dispatchLoop.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5015
                VerboseStartup ifTrue:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5016
                    ('Smalltalk [info]: exit normally.') infoPrintCR.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5017
                ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5018
                self exit
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5019
            ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5020
        ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5021
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5022
        commandFiles notNil ifTrue:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5023
            SilentLoading := true.  "/ suppress the hello & copyright messages
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5024
            self addStartBlock:
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5025
                [
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5026
                    commandFiles do:[:commandFile |
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5027
                        VerboseStartup ifTrue:[('filing in %1' bindWith:commandFile) infoPrintCR].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5028
                        (self secureFileIn:commandFile) ifFalse:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5029
                            self exitWithErrorMessage:('startup file "', commandFile, '" not found.').
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5030
                        ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5031
                    ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5032
                ].
16091
775b7b8d2571 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16090
diff changeset
  5033
775b7b8d2571 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16090
diff changeset
  5034
"/            self startSchedulerAndBackgroundCollector.
775b7b8d2571 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16090
diff changeset
  5035
"/            keepSplashWindow ifFalse:[ self hideSplashWindow ].
775b7b8d2571 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16090
diff changeset
  5036
"/            Initializing := false.
775b7b8d2571 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16090
diff changeset
  5037
"/
775b7b8d2571 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16090
diff changeset
  5038
"/            (self secureFileIn:commandFile) ifFalse:[
775b7b8d2571 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16090
diff changeset
  5039
"/                ('Smalltalk [error]: startup file "', commandFile, '" not found.') errorPrintCR.
775b7b8d2571 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16090
diff changeset
  5040
"/                OperatingSystem exit:1.
775b7b8d2571 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16090
diff changeset
  5041
"/            ].
23628
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5042
        ] ifFalse:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5043
            "/ look for <command>.rc
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5044
            "/ if not found, read smalltalk.rc (or stxapp.rc for standAlone operation)
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5045
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5046
            rcFile := self commandName asFilename withSuffix:'rc'.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5047
            VerboseStartup ifTrue:[('filing in %1' bindWith:rcFile) infoPrintCR].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5048
            (didReadRCFile := rcFile exists and:[self secureFileIn:rcFile]) ifFalse:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5049
                StandAlone ifFalse:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5050
                    defaultRC := 'smalltalk.rc' "/asFilename
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5051
                ] ifTrue:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5052
                    defaultRC := 'stxapp.rc' "/asFilename
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5053
                ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5054
                "JV@2011-11-01: DO NOT check defaultRC exist - this prevents smalltalk to
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5055
                    to be started with different working directory than stx/projects/smalltalk !!!!!!"
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5056
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5057
                "/didReadRCFile := defaultRC exists and:[self secureFileIn:defaultRC].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5058
                VerboseStartup ifTrue:[('filing in %1' bindWith:defaultRC) infoPrintCR].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5059
                didReadRCFile := (self getSystemFileName:defaultRC) notNil
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5060
                                 and:[self secureFileIn:defaultRC].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5061
                didReadRCFile ifFalse:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5062
                    StandAlone ifFalse:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5063
                        'Smalltalk [warning]: no startup rc-file found. Going into line-by-line interpreter.' infoPrintCR.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5064
                        graphicalMode := false.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5065
                    ]
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5066
                ]
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5067
            ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5068
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5069
            "/ ('StandAlone is %1' bindWith:StandAlone) printCR.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5070
            "/ ('Headless is %1' bindWith:HeadlessOperation) printCR.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5071
            "/ ('Display is %1' bindWith:Display) printCR.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5072
            "/ ('Screen is %1' bindWith:Screen) printCR.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5073
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5074
            keepSplashWindow ifFalse:[ self hideSplashWindow ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5075
            didReadRCFile ifFalse:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5076
                'private.rc' asFilename exists ifTrue:[ 
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5077
                    VerboseStartup ifTrue:[('filing in private.rc') infoPrintCR].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5078
                    self secureFileIn:'private.rc' 
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5079
                ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5080
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5081
                "/
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5082
                "/ No RC file found;
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5083
                "/ Setup more default stuff
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5084
                "/
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5085
                StandAlone ifFalse:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5086
                    "/ its a smalltalk - proceed in interpreter.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5087
                    'Smalltalk [warning]: no startup rc-file found. Going into line-by-line interpreter.' infoPrintCR.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5088
                    graphicalMode := false.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5089
                ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5090
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5091
                "/ setup more defaults...
13537
647c75f02ce7 changed:
Claus Gittinger <cg@exept.de>
parents: 13536
diff changeset
  5092
"/                ObjectMemory startBackgroundCollectorAt:5.
647c75f02ce7 changed:
Claus Gittinger <cg@exept.de>
parents: 13536
diff changeset
  5093
"/                ObjectMemory startBackgroundFinalizationAt:5.
23628
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5094
                self addStartBlock:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5095
                    self startSchedulerAndBackgroundCollector
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5096
                ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5097
            ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5098
        ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5099
        (CommandLineArguments includes:'--scripting') ifTrue:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5100
            self addStartBlock:[
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5101
                StandaloneStartup handleScriptingOptionsFromArguments:CommandLineArguments.
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5102
            ].
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5103
        ].
617
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  5104
    ].
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  5105
10644
a67765a8a0d3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10643
diff changeset
  5106
    HeadlessOperation ifTrue:[
23628
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5107
        graphicalMode := false.
15872
605d272f5e1c class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15783
diff changeset
  5108
    ].
605d272f5e1c class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15783
diff changeset
  5109
605d272f5e1c class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15783
diff changeset
  5110
    keepSplashWindow ifFalse:[ self hideSplashWindow ].
1578
9df8cc1ec5c4 start & restart actions merged into a common method.
Claus Gittinger <cg@exept.de>
parents: 1573
diff changeset
  5111
    self mainStartup:graphicalMode
9df8cc1ec5c4 start & restart actions merged into a common method.
Claus Gittinger <cg@exept.de>
parents: 1573
diff changeset
  5112
15872
605d272f5e1c class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15783
diff changeset
  5113
    "Modified: / 17-12-2013 / 16:44:40 / cg"
22147
998484c2c1a3 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 22015
diff changeset
  5114
    "Modified: / 01-08-2017 / 11:08:47 / stefan"
23628
8a9baee8f42a #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 23588
diff changeset
  5115
    "Modified: / 22-01-2019 / 14:01:44 / Claus Gittinger"
13536
839fe9c57304 added: #startSchedulerAndBackgroundCollector
Claus Gittinger <cg@exept.de>
parents: 13532
diff changeset
  5116
!
839fe9c57304 added: #startSchedulerAndBackgroundCollector
Claus Gittinger <cg@exept.de>
parents: 13532
diff changeset
  5117
839fe9c57304 added: #startSchedulerAndBackgroundCollector
Claus Gittinger <cg@exept.de>
parents: 13532
diff changeset
  5118
startSchedulerAndBackgroundCollector
839fe9c57304 added: #startSchedulerAndBackgroundCollector
Claus Gittinger <cg@exept.de>
parents: 13532
diff changeset
  5119
    Processor startTimeSlicing.
839fe9c57304 added: #startSchedulerAndBackgroundCollector
Claus Gittinger <cg@exept.de>
parents: 13532
diff changeset
  5120
    Processor supportDynamicPriorities:true.
13537
647c75f02ce7 changed:
Claus Gittinger <cg@exept.de>
parents: 13536
diff changeset
  5121
647c75f02ce7 changed:
Claus Gittinger <cg@exept.de>
parents: 13536
diff changeset
  5122
    ObjectMemory startBackgroundCollectorAt:5.
647c75f02ce7 changed:
Claus Gittinger <cg@exept.de>
parents: 13536
diff changeset
  5123
    ObjectMemory startBackgroundFinalizationAt:5.
13536
839fe9c57304 added: #startSchedulerAndBackgroundCollector
Claus Gittinger <cg@exept.de>
parents: 13532
diff changeset
  5124
    ObjectMemory backgroundCollectProcess priorityRange:(4 to:9).
839fe9c57304 added: #startSchedulerAndBackgroundCollector
Claus Gittinger <cg@exept.de>
parents: 13532
diff changeset
  5125
    ObjectMemory backgroundFinalizationProcess priorityRange:(4 to:9).
839fe9c57304 added: #startSchedulerAndBackgroundCollector
Claus Gittinger <cg@exept.de>
parents: 13532
diff changeset
  5126
839fe9c57304 added: #startSchedulerAndBackgroundCollector
Claus Gittinger <cg@exept.de>
parents: 13532
diff changeset
  5127
    "Created: / 31-07-2011 / 20:01:33 / cg"
11808
14b417cf2b51 Define #startStartBlockProcess
Stefan Vogel <sv@exept.de>
parents: 11690
diff changeset
  5128
!
14b417cf2b51 Define #startStartBlockProcess
Stefan Vogel <sv@exept.de>
parents: 11690
diff changeset
  5129
14b417cf2b51 Define #startStartBlockProcess
Stefan Vogel <sv@exept.de>
parents: 11690
diff changeset
  5130
startStartBlockProcess
14b417cf2b51 Define #startStartBlockProcess
Stefan Vogel <sv@exept.de>
parents: 11690
diff changeset
  5131
    "at the end of the smalltalk initialization, start all actions that
14b417cf2b51 Define #startStartBlockProcess
Stefan Vogel <sv@exept.de>
parents: 11690
diff changeset
  5132
     were delayed until the ProcessorScheduler is running in a separate process"
14b417cf2b51 Define #startStartBlockProcess
Stefan Vogel <sv@exept.de>
parents: 11690
diff changeset
  5133
14b417cf2b51 Define #startStartBlockProcess
Stefan Vogel <sv@exept.de>
parents: 11690
diff changeset
  5134
    |p|
14b417cf2b51 Define #startStartBlockProcess
Stefan Vogel <sv@exept.de>
parents: 11690
diff changeset
  5135
14b417cf2b51 Define #startStartBlockProcess
Stefan Vogel <sv@exept.de>
parents: 11690
diff changeset
  5136
    p :=
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  5137
	[
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  5138
	    self executeStartBlocks.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  5139
	] newProcess.
12022
205ac90337cc oops- fileNameForClass
Claus Gittinger <cg@exept.de>
parents: 12019
diff changeset
  5140
205ac90337cc oops- fileNameForClass
Claus Gittinger <cg@exept.de>
parents: 12019
diff changeset
  5141
    p
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  5142
	priority:(Processor userSchedulingPriority);
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  5143
	name:'start block handler';
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  5144
	beGroupLeader;
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  5145
	resume.
13892
3a39b1ef1d6f changed:
Claus Gittinger <cg@exept.de>
parents: 13883
diff changeset
  5146
13893
580686880e8f added: #executeStartBlocks
Claus Gittinger <cg@exept.de>
parents: 13892
diff changeset
  5147
    "Modified: / 07-01-2012 / 12:59:01 / cg"
1097
14711c00f386 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  5148
! !
14711c00f386 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  5149
13947
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5150
!Smalltalk class methodsFor:'startup and exit'!
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5151
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5152
addExitBlock:aBlock
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5153
    "{ Pragma: +optSpace }"
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5154
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5155
    "add a block to be executed when Smalltalk finishes.
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5156
     This feature is currently not used anywhere - but could be useful for
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5157
     cleanup in stand alone applications.
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5158
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5159
     Better use: ObjectMemory>>#addDependent: and handle the change message
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5160
     #aboutToQuit."
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5161
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5162
    ExitBlocks isNil ifTrue:[
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  5163
	ExitBlocks := OrderedCollection with:aBlock
13947
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5164
    ] ifFalse:[
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  5165
	ExitBlocks add:aBlock
13947
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5166
    ]
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5167
!
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5168
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5169
addImageStartBlock:aBlock
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5170
    "{ Pragma: +optSpace }"
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5171
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5172
    "add a blocks to be executed in a separate process after
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5173
     everything has been initialized.
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5174
     These blocks will be executed after an image restart."
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5175
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5176
    ImageStartBlocks isNil ifTrue:[
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  5177
	ImageStartBlocks := OrderedCollection with:aBlock
13947
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5178
    ] ifFalse:[
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  5179
	ImageStartBlocks add:aBlock
13947
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5180
    ]
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5181
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5182
    "Created: 9.9.1996 / 16:48:20 / stefan"
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5183
!
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5184
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5185
addStartBlock:aBlock
15980
83b70fa9bf0a class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15958
diff changeset
  5186
    "to be called ONLY during very early startup (before the process scheduler
83b70fa9bf0a class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15958
diff changeset
  5187
     is started) to add a block to be executed in a separate process after
83b70fa9bf0a class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15958
diff changeset
  5188
     everything has been initialized.
83b70fa9bf0a class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15958
diff changeset
  5189
     Used to allow a startup script (which is executed BEFORE the scheduler and
83b70fa9bf0a class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15958
diff changeset
  5190
     UI display is startup up) to add actions which require those subsystems to
83b70fa9bf0a class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15958
diff changeset
  5191
     be operating.
83b70fa9bf0a class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15958
diff changeset
  5192
     These blocks will be executed only once and not be executed after an image restart.
13947
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5193
     Initial processes such as the launcher are usually started here
15980
83b70fa9bf0a class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15958
diff changeset
  5194
     (see smalltalk.rc / private.rc).
83b70fa9bf0a class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15958
diff changeset
  5195
     ONLY to be called from such an rc file."
13947
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5196
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5197
    "{ Pragma: +optSpace }"
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5198
15980
83b70fa9bf0a class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15958
diff changeset
  5199
    "/ to protect against "mis-users" of this mehtod...
83b70fa9bf0a class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15958
diff changeset
  5200
    Initializing ifFalse:[
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  5201
	aBlock value
16170
ca4d03def070 endOfDipatch if running scripts
Claus Gittinger <cg@exept.de>
parents: 16164
diff changeset
  5202
    ] ifTrue:[
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  5203
	StartBlocks isNil ifTrue:[
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  5204
	    StartBlocks := OrderedCollection with:aBlock
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  5205
	] ifFalse:[
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  5206
	    StartBlocks add:aBlock
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  5207
	]
15980
83b70fa9bf0a class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15958
diff changeset
  5208
    ].
13947
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5209
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5210
    "Created: / 09-09-1996 / 16:46:53 / stefan"
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5211
    "Modified (comment): / 18-08-2011 / 09:18:42 / cg"
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5212
!
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5213
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5214
exit
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5215
    "{ Pragma: +optSpace }"
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5216
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5217
    "finish the Smalltalk system"
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5218
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5219
    self exit:0
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5220
    "not reached"
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5221
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5222
    "Be careful evaluating this
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5223
     Smalltalk exit
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5224
    "
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5225
!
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5226
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5227
exit:statusInteger
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5228
    "{ Pragma: +optSpace }"
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5229
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5230
    "finish the Smalltalk system"
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5231
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5232
    ObjectMemory changed:#aboutToExit.  "/ for ST/X backward compatibility
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5233
    ObjectMemory changed:#aboutToQuit.  "/ for ST-80 compatibility
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5234
    ExitBlocks notNil ifTrue:[
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5235
	ExitBlocks do:[:aBlock |
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5236
	    aBlock value
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5237
	]
21782
05d815aaf51d #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21599
diff changeset
  5238
    ].
05d815aaf51d #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21599
diff changeset
  5239
    Display notNil ifTrue:[ Display closeConnection ].
05d815aaf51d #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21599
diff changeset
  5240
13947
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5241
    OperatingSystem exit:statusInteger
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5242
    "not reached"
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5243
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5244
    "Be careful evaluating this
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5245
     Smalltalk exit:1
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5246
    "
21782
05d815aaf51d #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21599
diff changeset
  5247
05d815aaf51d #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 21599
diff changeset
  5248
    "Modified: / 30-05-2017 / 21:36:35 / cg"
19014
8056dc26f7d7 #FEATURE
Stefan Vogel <sv@exept.de>
parents: 18924
diff changeset
  5249
!
8056dc26f7d7 #FEATURE
Stefan Vogel <sv@exept.de>
parents: 18924
diff changeset
  5250
19958
8d7c3bde4483 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 19919
diff changeset
  5251
exitIfStandalone
8d7c3bde4483 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 19919
diff changeset
  5252
    "if this is a standalone application, exit.
8d7c3bde4483 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 19919
diff changeset
  5253
     Otherwise give a warning and abort.
8d7c3bde4483 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 19919
diff changeset
  5254
     Call this in your code instead of Smalltalk exit,
8d7c3bde4483 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 19919
diff changeset
  5255
     so the code can be tested in the IDE without danger of shuttong down ST/X"
8d7c3bde4483 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 19919
diff changeset
  5256
8d7c3bde4483 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 19919
diff changeset
  5257
    "{ Pragma: +optSpace }"
8d7c3bde4483 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 19919
diff changeset
  5258
8d7c3bde4483 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 19919
diff changeset
  5259
    self exitIfStandalone:0
8d7c3bde4483 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 19919
diff changeset
  5260
8d7c3bde4483 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 19919
diff changeset
  5261
    "Created: / 06-06-2016 / 14:56:49 / cg"
8d7c3bde4483 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 19919
diff changeset
  5262
!
8d7c3bde4483 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 19919
diff changeset
  5263
8d7c3bde4483 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 19919
diff changeset
  5264
exitIfStandalone:statusInteger
8d7c3bde4483 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 19919
diff changeset
  5265
    "if this is a standalone application, exit.
8d7c3bde4483 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 19919
diff changeset
  5266
     Otherwise give a warning and abort.
8d7c3bde4483 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 19919
diff changeset
  5267
     Call this in your code instead of Smalltalk exit,
8d7c3bde4483 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 19919
diff changeset
  5268
     so the code can be tested in the IDE without danger of shuttong down ST/X"
8d7c3bde4483 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 19919
diff changeset
  5269
8d7c3bde4483 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 19919
diff changeset
  5270
    "{ Pragma: +optSpace }"
8d7c3bde4483 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 19919
diff changeset
  5271
8d7c3bde4483 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 19919
diff changeset
  5272
    Smalltalk isStandAloneApp ifTrue:[
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5273
	self exit:statusInteger
19958
8d7c3bde4483 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 19919
diff changeset
  5274
    ] ifFalse:[
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5275
	self warn:'Application asks Smalltalk to exit (this is suppressed in IDE).'.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5276
	AbortOperationRequest raise.
19958
8d7c3bde4483 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 19919
diff changeset
  5277
    ]
8d7c3bde4483 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 19919
diff changeset
  5278
8d7c3bde4483 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 19919
diff changeset
  5279
    "
8d7c3bde4483 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 19919
diff changeset
  5280
     Smalltalk exitIfStandalone:1
8d7c3bde4483 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 19919
diff changeset
  5281
    "
8d7c3bde4483 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 19919
diff changeset
  5282
8d7c3bde4483 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 19919
diff changeset
  5283
    "Created: / 06-06-2016 / 14:56:00 / cg"
8d7c3bde4483 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 19919
diff changeset
  5284
!
8d7c3bde4483 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 19919
diff changeset
  5285
19014
8056dc26f7d7 #FEATURE
Stefan Vogel <sv@exept.de>
parents: 18924
diff changeset
  5286
exitOrError:exitCode
8056dc26f7d7 #FEATURE
Stefan Vogel <sv@exept.de>
parents: 18924
diff changeset
  5287
    "exit only if running as standalone application.
8056dc26f7d7 #FEATURE
Stefan Vogel <sv@exept.de>
parents: 18924
diff changeset
  5288
     Raise an error in the development system.
8056dc26f7d7 #FEATURE
Stefan Vogel <sv@exept.de>
parents: 18924
diff changeset
  5289
     Useful for testing standalone apps which should not kill
8056dc26f7d7 #FEATURE
Stefan Vogel <sv@exept.de>
parents: 18924
diff changeset
  5290
     your development system."
8056dc26f7d7 #FEATURE
Stefan Vogel <sv@exept.de>
parents: 18924
diff changeset
  5291
8056dc26f7d7 #FEATURE
Stefan Vogel <sv@exept.de>
parents: 18924
diff changeset
  5292
    self isStandAloneApp ifTrue:[
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5293
	self exit:exitCode.
19014
8056dc26f7d7 #FEATURE
Stefan Vogel <sv@exept.de>
parents: 18924
diff changeset
  5294
    ].
8056dc26f7d7 #FEATURE
Stefan Vogel <sv@exept.de>
parents: 18924
diff changeset
  5295
    self error:'standalone smalltalk would exit here with exit code: ', exitCode printString.
8056dc26f7d7 #FEATURE
Stefan Vogel <sv@exept.de>
parents: 18924
diff changeset
  5296
8056dc26f7d7 #FEATURE
Stefan Vogel <sv@exept.de>
parents: 18924
diff changeset
  5297
    "
8056dc26f7d7 #FEATURE
Stefan Vogel <sv@exept.de>
parents: 18924
diff changeset
  5298
     self exitOrError:0
8056dc26f7d7 #FEATURE
Stefan Vogel <sv@exept.de>
parents: 18924
diff changeset
  5299
    "
20715
07093a7832f0 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 20714
diff changeset
  5300
!
07093a7832f0 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 20714
diff changeset
  5301
07093a7832f0 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 20714
diff changeset
  5302
exitWithErrorMessage:msg
07093a7832f0 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 20714
diff changeset
  5303
    ('Smalltalk [error]: ',msg) errorPrintCR.
07093a7832f0 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 20714
diff changeset
  5304
    self exitOrError:1
13947
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5305
! !
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5306
1750
36ff7e62388a care for privateClasses in remove
Claus Gittinger <cg@exept.de>
parents: 1713
diff changeset
  5307
!Smalltalk class methodsFor:'startup queries'!
1097
14711c00f386 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1095
diff changeset
  5308
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5309
commandLine
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5310
    "return the full command line arguments (with which ST/X was started)"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5311
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5312
    ^ CommandLine
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5313
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5314
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5315
     Smalltalk commandLine
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5316
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5317
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5318
    "Created: 19.7.1996 / 11:09:06 / cg"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5319
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5320
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5321
commandLineArgumentNamed:aString
16110
c17880a91e5e class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16100
diff changeset
  5322
    "extract a named argument from the command line arguments.
c17880a91e5e class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16100
diff changeset
  5323
     This searches for the given string in the command line and returns the next argument after it."
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5324
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5325
    |args index|
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5326
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5327
    args := self commandLineArguments.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5328
    index := args indexOf:aString.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5329
    (index between:1 and:(args size - 1)) ifTrue:[
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  5330
	^ args at:index+1
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5331
    ].
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5332
    ^ nil.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5333
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5334
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5335
     self commandLineArgumentNamed:'-display'
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5336
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5337
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5338
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5339
commandLineArguments
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5340
    "return the user command line arguments;
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5341
     This is a collection of strings (separated command line words),
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5342
     from which the internal startup arguments have already been removed.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5343
     I.e. if started with: 'smalltalk -I -f xxx foo bar baz',
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5344
     the commandLineArguments will be #('foo' 'bar' 'baz').
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5345
     In contrast, the value returned by #commandLine will be the full set of words."
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5346
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5347
    ^ CommandLineArguments
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5348
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5349
    "Modified: 19.7.1996 / 11:11:03 / cg"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5350
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5351
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5352
commandName
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5353
    "return the excutables name - this is normally 'stx',
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5354
     but can be something else for standAlone apps."
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5355
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5356
    ^ CommandName.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5357
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5358
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5359
     Smalltalk commandName
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5360
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5361
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5362
    "Modified: 19.7.1996 / 11:11:16 / cg"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5363
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5364
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5365
hasNoConsole
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5366
    "return true, if this is a console-less application (i.e. I am winstx)
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5367
     i.e. there should be no writing to stdout/stderr"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5368
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5369
    ^ HasNoConsole ? false
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5370
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5371
    "
10071
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
  5372
     Smalltalk hasNoConsole
9054
d9de09e49007 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9047
diff changeset
  5373
    "
d9de09e49007 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9047
diff changeset
  5374
!
d9de09e49007 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9047
diff changeset
  5375
17435
6057cb39678c class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17434
diff changeset
  5376
ignoreAssertions
6057cb39678c class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17434
diff changeset
  5377
    "return true, if assertions are to be ignored (i.e. not executed).
6057cb39678c class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17434
diff changeset
  5378
     This is false by default in an IDE (i.e. full smalltalk),
6057cb39678c class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17434
diff changeset
  5379
     but can be set to true for standAlone applications
6057cb39678c class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17434
diff changeset
  5380
     (whether that is a good idea and helps, is another question)
17439
1928276a394c added class variable IgnoreAssertions
Claus Gittinger <cg@exept.de>
parents: 17438
diff changeset
  5381
     However, it may make the app a little faster, if assertions are compatational
17435
6057cb39678c class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17434
diff changeset
  5382
     expensive, as they are skipped (the stc compiler is generatig code which skips those)."
6057cb39678c class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17434
diff changeset
  5383
17439
1928276a394c added class variable IgnoreAssertions
Claus Gittinger <cg@exept.de>
parents: 17438
diff changeset
  5384
    ^ IgnoreAssertions ? false
17435
6057cb39678c class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17434
diff changeset
  5385
!
6057cb39678c class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17434
diff changeset
  5386
17438
fa80b8989917 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17436
diff changeset
  5387
ignoreAssertions:aBoolean
fa80b8989917 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17436
diff changeset
  5388
    "set to true, if assertions are to be ignored (i.e. not executed).
fa80b8989917 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17436
diff changeset
  5389
     This is false by default in an IDE (i.e. full smalltalk),
fa80b8989917 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17436
diff changeset
  5390
     but can be set to true for standAlone applications
fa80b8989917 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17436
diff changeset
  5391
     (whether that is a good idea and helps, is another question)
17439
1928276a394c added class variable IgnoreAssertions
Claus Gittinger <cg@exept.de>
parents: 17438
diff changeset
  5392
     However, it may make the app a little faster, if assertions are compatational
17438
fa80b8989917 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17436
diff changeset
  5393
     expensive, as they are skipped (the stc compiler is generatig code which skips those)."
fa80b8989917 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17436
diff changeset
  5394
17439
1928276a394c added class variable IgnoreAssertions
Claus Gittinger <cg@exept.de>
parents: 17438
diff changeset
  5395
    IgnoreAssertions := aBoolean
17438
fa80b8989917 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17436
diff changeset
  5396
!
fa80b8989917 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17436
diff changeset
  5397
22679
be7996acb8aa #FEATURE by stefan
Stefan Vogel <sv@exept.de>
parents: 22650
diff changeset
  5398
isDebuggableApp
be7996acb8aa #FEATURE by stefan
Stefan Vogel <sv@exept.de>
parents: 22650
diff changeset
  5399
    "return true, if we want to see a Debugger, MiniDebugger or extended debugging output
be7996acb8aa #FEATURE by stefan
Stefan Vogel <sv@exept.de>
parents: 22650
diff changeset
  5400
     in some situations."
be7996acb8aa #FEATURE by stefan
Stefan Vogel <sv@exept.de>
parents: 22650
diff changeset
  5401
be7996acb8aa #FEATURE by stefan
Stefan Vogel <sv@exept.de>
parents: 22650
diff changeset
  5402
    ^ self isStandAloneApp not or:[self isStandAloneDebug].
be7996acb8aa #FEATURE by stefan
Stefan Vogel <sv@exept.de>
parents: 22650
diff changeset
  5403
be7996acb8aa #FEATURE by stefan
Stefan Vogel <sv@exept.de>
parents: 22650
diff changeset
  5404
    "
be7996acb8aa #FEATURE by stefan
Stefan Vogel <sv@exept.de>
parents: 22650
diff changeset
  5405
     Smalltalk isDebuggableApp
be7996acb8aa #FEATURE by stefan
Stefan Vogel <sv@exept.de>
parents: 22650
diff changeset
  5406
    "
be7996acb8aa #FEATURE by stefan
Stefan Vogel <sv@exept.de>
parents: 22650
diff changeset
  5407
be7996acb8aa #FEATURE by stefan
Stefan Vogel <sv@exept.de>
parents: 22650
diff changeset
  5408
    "Created: / 19-04-2018 / 10:30:17 / stefan"
be7996acb8aa #FEATURE by stefan
Stefan Vogel <sv@exept.de>
parents: 22650
diff changeset
  5409
!
be7996acb8aa #FEATURE by stefan
Stefan Vogel <sv@exept.de>
parents: 22650
diff changeset
  5410
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5411
isHeadless
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5412
    "return true, if this is a headless application
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5413
     i.e. no default Display connection is required/used"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5414
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5415
    ^ HeadlessOperation ? false
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5416
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5417
    "
10071
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
  5418
     Smalltalk isHeadless
9029
09b858d6135d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9028
diff changeset
  5419
    "
09b858d6135d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9028
diff changeset
  5420
!
09b858d6135d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9028
diff changeset
  5421
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5422
isPlugin
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5423
    "return true, if this is a plugin application
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5424
     i.e. running in a browserWindow"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5425
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5426
    ^ IsPlugin ? false
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5427
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5428
    "
10071
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
  5429
     Smalltalk isPlugin
9029
09b858d6135d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9028
diff changeset
  5430
    "
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  5431
!
4957
d2470714f2da headless stuff
Stefan Vogel <sv@exept.de>
parents: 4956
diff changeset
  5432
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5433
isSTScript
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5434
    "return true, if this is stscript. i.e. the stx scripting engine."
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5435
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5436
    ^ IsSTScript ? false
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5437
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5438
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5439
     Smalltalk isSTScript
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5440
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5441
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5442
    "Created: / 06-12-2006 / 16:41:21 / cg"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5443
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5444
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5445
isSharedLibraryComponent
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5446
    "return true, if this is a shared library component of another application
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5447
     i.e. a dll within another app."
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5448
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5449
    ^ IsSharedLibraryComponent ? false
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5450
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5451
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5452
     Smalltalk isSharedLibraryComponent
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5453
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5454
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5455
    "Created: / 10-08-2006 / 13:09:34 / cg"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5456
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5457
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5458
isSmalltalkDevelopmentSystem
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5459
    "return true, if this is a real smalltalk system
17421
9f2dac6c6efb class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17399
diff changeset
  5460
     i.e. NOT a stripped or a linked standAlone application (such as the webServer)
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5461
     and NOT a plugIn (i.e. running in a browser)
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5462
     and NOT a sharedLibrary component (i.e. a dll in another app).
17421
9f2dac6c6efb class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17399
diff changeset
  5463
     This is used to determine, whether debugging is possible/desired or not."
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5464
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5465
    self isPlugin ifTrue:[^ false].                     "/ I am a browser-plugin
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5466
    self isSharedLibraryComponent ifTrue:[^ false].     "/ I am a COM-ponent
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5467
    self isSTScript ifTrue:[^ true ].                   "/ I am stScript
10999
e5cfd06920ca *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10998
diff changeset
  5468
    ^ self isStandAloneApp not.
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5469
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5470
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5471
     Smalltalk isSmalltalkDevelopmentSystem
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5472
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5473
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5474
    "Created: / 10-08-2006 / 13:12:49 / cg"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5475
    "Modified: / 06-12-2006 / 16:42:56 / cg"
15565
3dae2c24b592 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15334
diff changeset
  5476
    "Modified (comment): / 27-07-2013 / 15:36:20 / cg"
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5477
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5478
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5479
isStandAloneApp
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5480
    "return true, if this is a standAlone application
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5481
     i.e. a stripped & linked application (such as the webServer)
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5482
     in contrast to a full smalltalk (development) system."
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5483
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5484
    ^ StandAlone ? false
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5485
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5486
    "
10071
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
  5487
     Smalltalk isStandAloneApp
9029
09b858d6135d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9028
diff changeset
  5488
    "
617
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  5489
!
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  5490
13947
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5491
isStandAloneDebug
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5492
    "return true, if this is a standAlone application which
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5493
     was started with the -debug option."
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5494
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5495
    ^ DebuggingStandAlone ? false
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5496
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5497
    "
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5498
     Smalltalk isStandAloneDebug
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5499
    "
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5500
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5501
    "Created: / 19-01-2012 / 10:17:41 / cg"
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5502
!
efccef803a92 added: #isStandAloneDebug
Claus Gittinger <cg@exept.de>
parents: 13893
diff changeset
  5503
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5504
startupArguments
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5505
    "return the arguments passed to StartupClass when stx gets started.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5506
     Usually these are nil,
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5507
     but saving an image with a non-nil StartupClass/StartupSelector/StartupArgs allows for
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5508
     a simple way to configure and create stand-alone applications"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5509
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5510
    ^ StartupArguments
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5511
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5512
    "
10071
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
  5513
     Smalltalk startupArguments
9029
09b858d6135d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9028
diff changeset
  5514
    "
7563
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  5515
!
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  5516
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5517
startupClass
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5518
    "return the class, that will get the start message when smalltalk
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5519
     starts and its non-nil. Usually this is nil,
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5520
     but saving an image with a non-nil StartupClass/StartupSelector/StartupArgs allows for
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5521
     a simple way to configure and create stand-alone applications"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5522
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5523
    ^ StartupClass
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5524
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5525
    "
10071
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
  5526
     Smalltalk startupClass
9029
09b858d6135d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9028
diff changeset
  5527
    "
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  5528
!
8570
0a7f80cc592f version bump
ca
parents: 8567
diff changeset
  5529
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5530
startupClass:aClass selector:aSymbol arguments:anArrayOrNil
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5531
    "{ Pragma: +optSpace }"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5532
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5533
    "set the class, selector and arguments to be performed when smalltalk
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5534
     starts. Setting those before saving a snapshot, will make the saved
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5535
     image come up executing your application (instead of the normal mainloop)"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5536
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5537
    StartupClass := aClass.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5538
    StartupSelector := aSymbol.
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  5539
    StartupArguments := anArrayOrNil
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  5540
!
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  5541
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5542
startupSelector
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5543
    "return the selector, that will be sent to StartupClass.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5544
     Usually this is nil,
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5545
     but saving an image with a non-nil StartupClass/StartupSelector allows for
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5546
     a simple way to configure and create stand-alone applications"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5547
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5548
    ^ StartupSelector
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5549
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5550
    "
10071
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
  5551
     Smalltalk startupSelector
9029
09b858d6135d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9028
diff changeset
  5552
    "
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5553
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5554
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5555
wasStartedFromImage
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5556
    "return true, if this smalltalk was started from an image,
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5557
     as opposed to a fresh and clean startup"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5558
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5559
    ^ ImageRestartTime notNil
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5560
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5561
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5562
     Smalltalk wasStartedFromImage
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5563
    "
70
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
  5564
! !
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
  5565
1750
36ff7e62388a care for privateClasses in remove
Claus Gittinger <cg@exept.de>
parents: 1713
diff changeset
  5566
!Smalltalk class methodsFor:'system environment'!
1069
72db6bd8ce0a category changes
Claus Gittinger <cg@exept.de>
parents: 1004
diff changeset
  5567
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5568
language
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5569
    "return the language setting"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5570
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5571
    ^ Language
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5572
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5573
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5574
     Smalltalk language
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5575
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5576
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5577
    "Modified: 26.4.1996 / 17:10:05 / cg"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5578
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5579
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5580
language:aLanguageSymbol
10991
98fe8942f27e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10971
diff changeset
  5581
    "set the language - send out change notifications"
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5582
18733
20fc1bb8fe15 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 18732
diff changeset
  5583
    aLanguageSymbol ~= Language ifTrue:[
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5584
	Language := aLanguageSymbol asSymbol.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5585
	self changed:#Language
18733
20fc1bb8fe15 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 18732
diff changeset
  5586
    ].
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5587
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5588
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5589
     Smalltalk language:#de
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5590
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5591
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5592
    "Modified: / 19-10-2006 / 23:17:29 / cg"
21928
b14c2d0608e0 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 21782
diff changeset
  5593
    "Modified: / 29-06-2017 / 15:05:04 / stefan"
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5594
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5595
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5596
language:aLanguageSymbol territory:aTerritorySymbol
10991
98fe8942f27e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10971
diff changeset
  5597
    "set the language & territory - send out change notifications"
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5598
18733
20fc1bb8fe15 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 18732
diff changeset
  5599
    ((Language ~= aLanguageSymbol) or:[ LanguageTerritory ~= aTerritorySymbol]) ifTrue:[
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5600
	Language := aLanguageSymbol asSymbol.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5601
	LanguageTerritory := aTerritorySymbol asSymbol.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5602
	self changed:#Language
18733
20fc1bb8fe15 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 18732
diff changeset
  5603
    ].
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5604
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5605
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5606
     Smalltalk language:#de territory:#de
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5607
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5608
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5609
    "Created: / 19-10-2006 / 22:16:22 / cg"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5610
    "Modified: / 19-10-2006 / 23:17:36 / cg"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5611
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5612
13212
e75edfda9b2e added: #languageAndTerritory
Claus Gittinger <cg@exept.de>
parents: 13135
diff changeset
  5613
languageAndTerritory
e75edfda9b2e added: #languageAndTerritory
Claus Gittinger <cg@exept.de>
parents: 13135
diff changeset
  5614
    "return the language and territory in the format lang-terr (i.e. de-de, en-us)"
e75edfda9b2e added: #languageAndTerritory
Claus Gittinger <cg@exept.de>
parents: 13135
diff changeset
  5615
e75edfda9b2e added: #languageAndTerritory
Claus Gittinger <cg@exept.de>
parents: 13135
diff changeset
  5616
    ^ Language , '-' , (LanguageTerritory ? Language)
e75edfda9b2e added: #languageAndTerritory
Claus Gittinger <cg@exept.de>
parents: 13135
diff changeset
  5617
e75edfda9b2e added: #languageAndTerritory
Claus Gittinger <cg@exept.de>
parents: 13135
diff changeset
  5618
    "
e75edfda9b2e added: #languageAndTerritory
Claus Gittinger <cg@exept.de>
parents: 13135
diff changeset
  5619
     Smalltalk languageAndTerritory
e75edfda9b2e added: #languageAndTerritory
Claus Gittinger <cg@exept.de>
parents: 13135
diff changeset
  5620
    "
e75edfda9b2e added: #languageAndTerritory
Claus Gittinger <cg@exept.de>
parents: 13135
diff changeset
  5621
e75edfda9b2e added: #languageAndTerritory
Claus Gittinger <cg@exept.de>
parents: 13135
diff changeset
  5622
    "Created: / 16-01-2011 / 10:19:42 / cg"
e75edfda9b2e added: #languageAndTerritory
Claus Gittinger <cg@exept.de>
parents: 13135
diff changeset
  5623
!
e75edfda9b2e added: #languageAndTerritory
Claus Gittinger <cg@exept.de>
parents: 13135
diff changeset
  5624
20615
8fbfa364a4aa #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 20603
diff changeset
  5625
languageCodeset
8fbfa364a4aa #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 20603
diff changeset
  5626
    ^ LanguageCodeset
8fbfa364a4aa #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 20603
diff changeset
  5627
!
8fbfa364a4aa #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 20603
diff changeset
  5628
8fbfa364a4aa #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 20603
diff changeset
  5629
languageModifier
8fbfa364a4aa #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 20603
diff changeset
  5630
    ^ LanguageModifier
8fbfa364a4aa #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 20603
diff changeset
  5631
!
8fbfa364a4aa #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 20603
diff changeset
  5632
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5633
languageTerritory
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5634
    "return the language territory setting"
7563
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  5635
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  5636
    ^ LanguageTerritory
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  5637
!
Claus Gittinger <cg@exept.de>
parents: 7561
diff changeset
  5638
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5639
languageTerritory:aTerritorySymbol
10991
98fe8942f27e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10971
diff changeset
  5640
    "set the language territory - send out change notifications"
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5641
18924
f5063aa4e434 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 18868
diff changeset
  5642
    aTerritorySymbol ~= LanguageTerritory ifTrue:[
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5643
	LanguageTerritory := aTerritorySymbol asSymbol.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5644
	self changed:#LanguageTerritory
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5645
    ].
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5646
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5647
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5648
     Time now
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5649
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5650
     Smalltalk languageTerritory:#us.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5651
     Time now
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5652
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5653
     Smalltalk languageTerritory:#de.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5654
     Time now
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5655
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5656
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5657
    "Modified: / 19-10-2006 / 23:17:40 / cg"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5658
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5659
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5660
setLanguage:aLanguageSymbol
10991
98fe8942f27e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10971
diff changeset
  5661
    "set the language without change notification"
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5662
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5663
    Language := aLanguageSymbol.
10991
98fe8942f27e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10971
diff changeset
  5664
!
98fe8942f27e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10971
diff changeset
  5665
98fe8942f27e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10971
diff changeset
  5666
setLanguage:aLanguageSymbol territory:aTerritorySymbol
98fe8942f27e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10971
diff changeset
  5667
    "set the language & territory - no change notification"
98fe8942f27e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10971
diff changeset
  5668
98fe8942f27e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10971
diff changeset
  5669
    Language := aLanguageSymbol asSymbol.
98fe8942f27e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10971
diff changeset
  5670
    LanguageTerritory := aTerritorySymbol asSymbol.
1069
72db6bd8ce0a category changes
Claus Gittinger <cg@exept.de>
parents: 1004
diff changeset
  5671
! !
72db6bd8ce0a category changes
Claus Gittinger <cg@exept.de>
parents: 1004
diff changeset
  5672
1750
36ff7e62388a care for privateClasses in remove
Claus Gittinger <cg@exept.de>
parents: 1713
diff changeset
  5673
!Smalltalk class methodsFor:'system management'!
70
73055652dd21 *** empty log message ***
claus
parents: 62
diff changeset
  5674
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5675
compressSources
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5676
    "{ Pragma: +optSpace }"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5677
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5678
    "compress the sources file, and remove all method source strings
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5679
     from the system and replace them by refs to a string in the source file.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5680
     This is a bit different in ST/X than in other smalltalks,
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5681
     since we use per-class sourcefiles for the compiled classes,
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5682
     and a mix of in-memory strings and one-for-all sourceFile for
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5683
     incremental compiled methods.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5684
     Therefore, only those sources which are not coming from compiled
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5685
     methods are put into the 'st.src' file - all others are untouched.
20811
f372f9dccfb2 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20772
diff changeset
  5686
     This is being automated - so don't care for now."
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5687
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5688
    |newStream table source pos fileName|
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5689
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5690
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5691
     first, find all methods which contain either a string-ref
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5692
     or an external string in the 'st.src' file
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5693
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5694
    newStream := 'src.tmp' asFilename writeStream.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5695
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5696
    table := IdentityDictionary new:100.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5697
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5698
    Method allSubInstancesDo:[:aMethod |
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5699
	source := nil.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5700
	aMethod sourcePosition notNil ifTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5701
	    aMethod sourceFilename = 'st.src' ifTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5702
		source := aMethod source.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5703
	    ]
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5704
	] ifFalse:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5705
	    source := aMethod source
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5706
	].
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5707
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5708
	source notNil ifTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5709
	    pos := newStream position + 1.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5710
	    newStream nextChunkPut:source.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5711
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5712
	    "
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5713
	     dont change the methods info - maybe some write error
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5714
	     occurs later, in that case we abort and leave everything
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5715
	     untouched.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5716
	    "
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5717
	    table at:aMethod put:pos
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5718
	]
11655
4306fb61b9f8 sync common source file before replacing the old copy
Stefan Vogel <sv@exept.de>
parents: 11624
diff changeset
  5719
    ].
4306fb61b9f8 sync common source file before replacing the old copy
Stefan Vogel <sv@exept.de>
parents: 11624
diff changeset
  5720
4306fb61b9f8 sync common source file before replacing the old copy
Stefan Vogel <sv@exept.de>
parents: 11624
diff changeset
  5721
    newStream syncData; close.
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5722
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5723
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5724
     now, rename the new source file,
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5725
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5726
    fileName := (ObjectMemory nameForSources).
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5727
    'src.tmp' asFilename renameTo:fileName.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5728
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5729
    "good - now go over all changed methods, and change their
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5730
     source reference"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5731
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5732
    table keysAndValuesDo:[:aMethod :pos |
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5733
	aMethod localSourceFilename:fileName position:pos.
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5734
"/        aMethod printCR.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5735
    ].
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5736
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5737
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5738
     Smalltalk compressSources
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5739
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5740
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5741
    "Modified: 16.1.1997 / 01:25:58 / cg"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5742
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5743
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5744
generateSingleSourceFile
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5745
    "{ Pragma: +optSpace }"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5746
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5747
    "generate the sources file, and remove all method source strings
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5748
     from the system and replace them by refs to a string in the source file.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5749
     This makes the image independent from the per-class source files
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5750
     and makes transportation of endUser applications easier, since
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5751
     only 3 files (executable, image and sourceFile) need to be
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5752
     transported."
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5753
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5754
    |newStream table source pos fileName|
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5755
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5756
    newStream := 'src.tmp' asFilename writeStream.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5757
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5758
    table := IdentityDictionary new:100.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5759
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5760
    Method allSubInstancesDo:[:aMethod |
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5761
	source := aMethod source.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5762
	source notNil ifTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5763
	    pos := newStream position + 1.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5764
	    newStream nextChunkPut:source.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5765
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5766
	    "
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5767
	     don't change the method's info - maybe some write error
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5768
	     occurs later, in that case we abort and leave everything
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5769
	     untouched.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5770
	    "
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5771
	    table at:aMethod put:pos
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5772
	]
11655
4306fb61b9f8 sync common source file before replacing the old copy
Stefan Vogel <sv@exept.de>
parents: 11624
diff changeset
  5773
    ].
4306fb61b9f8 sync common source file before replacing the old copy
Stefan Vogel <sv@exept.de>
parents: 11624
diff changeset
  5774
4306fb61b9f8 sync common source file before replacing the old copy
Stefan Vogel <sv@exept.de>
parents: 11624
diff changeset
  5775
    newStream syncData; close.
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5776
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5777
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5778
     now, rename the new source file,
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5779
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5780
    fileName := (ObjectMemory nameForSources).
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5781
    'src.tmp' asFilename renameTo:fileName.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5782
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5783
    "good - now go over all changed methods, and change their
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5784
     source reference"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5785
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5786
    table keysAndValuesDo:[:aMethod :pos |
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5787
	aMethod localSourceFilename:fileName position:pos.
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5788
"/        aMethod printCR.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5789
    ].
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5790
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5791
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5792
     Smalltalk generateSingleSourceFile
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5793
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5794
22373
99d8da048a8f #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 22314
diff changeset
  5795
    "Modified: / 16-01-1997 / 01:25:58 / cg"
99d8da048a8f #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 22314
diff changeset
  5796
    "Created: / 17-10-1997 / 13:00:56 / cg"
99d8da048a8f #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 22314
diff changeset
  5797
    "Modified (comment): / 21-11-2017 / 13:08:41 / cg"
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5798
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5799
15596
6e05c159e789 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15594
diff changeset
  5800
installAutoloadedClassFromSourceFile:aFilename
6e05c159e789 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15594
diff changeset
  5801
    "install aFilename (which must be a smalltalk source file) as autoloaded class
6e05c159e789 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15594
diff changeset
  5802
     (extract the class definition chunk from the file and create an autoloaded
6e05c159e789 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15594
diff changeset
  5803
      class stub for it)"
6e05c159e789 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15594
diff changeset
  5804
6e05c159e789 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15594
diff changeset
  5805
    |chunks filename|
6e05c159e789 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15594
diff changeset
  5806
6e05c159e789 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15594
diff changeset
  5807
    filename := aFilename asFilename.
6e05c159e789 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15594
diff changeset
  5808
6e05c159e789 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15594
diff changeset
  5809
    ChangeSet::InvalidChangeChunkError handle:[:ex |
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  5810
	^ self
15596
6e05c159e789 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15594
diff changeset
  5811
    ] do:[
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  5812
	filename readingFileDo:[:s|
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  5813
	    chunks := ChangeSet fromStream:s while:[:chunk | chunk isMethodChange not].
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  5814
	].
16170
ca4d03def070 endOfDipatch if running scripts
Claus Gittinger <cg@exept.de>
parents: 16164
diff changeset
  5815
    ].
ca4d03def070 endOfDipatch if running scripts
Claus Gittinger <cg@exept.de>
parents: 16164
diff changeset
  5816
ca4d03def070 endOfDipatch if running scripts
Claus Gittinger <cg@exept.de>
parents: 16164
diff changeset
  5817
    chunks
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  5818
	select:[:eachChunk | eachChunk isClassDefinitionChange]
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  5819
	thenDo:[:eachClassChunk |
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  5820
		eachClassChunk installAsAutoloadedClassIfPublicWithFilename:filename asAbsoluteFilename "withoutSuffix" name "baseName"
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  5821
	].
15596
6e05c159e789 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15594
diff changeset
  5822
6e05c159e789 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15594
diff changeset
  5823
    "Created: / 01-08-2013 / 16:57:26 / cg"
6e05c159e789 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15594
diff changeset
  5824
!
6e05c159e789 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15594
diff changeset
  5825
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5826
installAutoloadedClassNamed:clsName category:cat package:package revision:revisionOrNil
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5827
    "create & install an autoload stub for a class named: clsName,
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5828
     to be loaded from package.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5829
     If revisionOrNil is non-nil, set it up to load exactly that revision
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5830
     (otherwise, the newest revision will be loaded"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5831
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5832
    ^ self
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  5833
	installAutoloadedClassNamed:clsName
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  5834
	category:cat
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  5835
	package:package
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  5836
	revision:revisionOrNil
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  5837
	numClassInstVars:nil.
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  5838
!
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  5839
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5840
installAutoloadedClassNamed:clsName category:cat package:package revision:revisionOrNil numClassInstVars:numClassInstVarsOrNil
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5841
    "create & install an autoload stub for a class named: clsName,
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5842
     to be loaded from package.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5843
     If revisionOrNil is non-nil, set it up to load exactly that revision
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5844
     (otherwise, the newest revision will be loaded"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5845
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5846
    |clsSym cls|
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5847
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5848
    clsSym := clsName asSymbol.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5849
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5850
    "/ install if not already compiled-in
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5851
    (cls := self at:clsSym) isNil ifTrue:[
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  5852
	Autoload subclass:clsSym
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  5853
	    instanceVariableNames:''
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  5854
	    classVariableNames:''
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  5855
	    poolDictionaries:''
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  5856
	    category:cat
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  5857
	    inEnvironment:Smalltalk.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  5858
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  5859
	cls := self at:clsSym.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  5860
	cls isNil ifTrue:[
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  5861
	    ('Smalltalk [warning]: failed to install ' , clsName , ' as autoloaded.') infoPrintCR.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  5862
	] ifFalse:[
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  5863
	    cls package:package asSymbol.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  5864
	    revisionOrNil notNil ifTrue:[
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  5865
		cls setBinaryRevision:revisionOrNil
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  5866
	    ]
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  5867
	]
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5868
    ] ifFalse:[
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  5869
	"/ class already present - however, if unloaded, check for category/package change
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  5870
	cls isLoaded ifFalse:[
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  5871
	    package ~= cls package ifTrue:[
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  5872
		cls withoutUpdatingChangesDo:[
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  5873
		    cls package:package asSymbol.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  5874
		].
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  5875
	    ].
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  5876
	    cat ~= cls category ifTrue:[
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  5877
		cls withoutUpdatingChangesDo:[
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  5878
		    cls category:cat.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  5879
		].
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  5880
	    ].
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  5881
	].
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5882
    ].
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5883
    ^ cls.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5884
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5885
    "Created: / 05-11-1998 / 15:10:25 / cg"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5886
    "Modified: / 16-01-2007 / 12:56:18 / cg"
11169
32fda240ee57 #installAutoloadedClassNamed:category:package:revision:numClassInstVars:
Stefan Vogel <sv@exept.de>
parents: 11153
diff changeset
  5887
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5888
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5889
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5890
installAutoloadedClasses
11679
69e588cca61f Do not use relative pathnames when searching for packages, etc.
Stefan Vogel <sv@exept.de>
parents: 11670
diff changeset
  5891
    "scan all packages and install all classes found there as
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5892
     autoloaded. This takes some time ..."
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5893
11679
69e588cca61f Do not use relative pathnames when searching for packages, etc.
Stefan Vogel <sv@exept.de>
parents: 11670
diff changeset
  5894
    |dirsConsulted|
69e588cca61f Do not use relative pathnames when searching for packages, etc.
Stefan Vogel <sv@exept.de>
parents: 11670
diff changeset
  5895
17588
05b944f08b13 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17582
diff changeset
  5896
    LoadInProgressQuery answerNotifyLoadingDo:[
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  5897
	dirsConsulted := Set new.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  5898
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  5899
	"/ along the package-path
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  5900
	self packagePath do:[:eachPathComponent |
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  5901
	    (dirsConsulted includes:eachPathComponent) ifFalse:[
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  5902
		self
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  5903
		    recursiveInstallAutoloadedClassesFrom:eachPathComponent
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  5904
		    rememberIn:dirsConsulted
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  5905
		    maxLevels:15
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  5906
		    noAutoload:false
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  5907
		    packageTop:eachPathComponent
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  5908
		    showSplashInLevels:2.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  5909
	    ]
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  5910
	].
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  5911
	self splashInfo:nil.
17548
e7eab3f01aba class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17534
diff changeset
  5912
    ].
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5913
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5914
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5915
     Smalltalk installAutoloadedClasses
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5916
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5917
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5918
    "Created: / 14.2.1997 / 17:32:57 / cg"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5919
    "Modified: / 13.12.1999 / 11:56:50 / cg"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5920
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5921
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5922
installAutoloadedClassesFrom:anAbbrevFilePath
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5923
    "read the given abbreviation file; install all classes found there as
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5924
     autoloaded. This takes some time ..."
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5925
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5926
    |f s|
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5927
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5928
    f := self getSystemFileName:anAbbrevFilePath.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5929
    f isNil ifTrue:[f := self getPackageFileName:anAbbrevFilePath].
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5930
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5931
    f notNil ifTrue:[
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5932
	f := f asFilename.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5933
	f isDirectory ifTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5934
	    f := f construct:'abbrev.stc'
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5935
	].
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5936
	[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5937
	    s := f readStream.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5938
	    self installAutoloadedClassesFromStream:s.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5939
	    s close.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5940
	] on:FileStream openErrorSignal
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5941
	do:[:ex| "do nothing"].
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5942
    ]
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5943
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5944
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5945
     Smalltalk installAutoloadedClassesFrom:'include/abbrev.stc'
19911
0b24a97a0bb7 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 19907
diff changeset
  5946
     Smalltalk installAutoloadedClassesFrom:'../../goodies/communication/abbrev.stc'
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5947
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5948
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5949
    "Modified: / 5.11.1998 / 15:10:51 / cg"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5950
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5951
13531
6ab20c7e1dec added: #installAutoloadedClassesFromAbbrevFile:
Claus Gittinger <cg@exept.de>
parents: 13529
diff changeset
  5952
installAutoloadedClassesFromAbbrevFile:aFilename
6ab20c7e1dec added: #installAutoloadedClassesFromAbbrevFile:
Claus Gittinger <cg@exept.de>
parents: 13529
diff changeset
  5953
    aFilename readingFileDo:[:abbrevStream |
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5954
	self installAutoloadedClassesFromStream:abbrevStream.
13531
6ab20c7e1dec added: #installAutoloadedClassesFromAbbrevFile:
Claus Gittinger <cg@exept.de>
parents: 13529
diff changeset
  5955
    ]
6ab20c7e1dec added: #installAutoloadedClassesFromAbbrevFile:
Claus Gittinger <cg@exept.de>
parents: 13529
diff changeset
  5956
19911
0b24a97a0bb7 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 19907
diff changeset
  5957
    "
0b24a97a0bb7 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 19907
diff changeset
  5958
     self installAutoloadedClassesFromAbbrevFile:('../../goodies/communication/abbrev.stc' asFilename)
0b24a97a0bb7 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 19907
diff changeset
  5959
    "
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5960
13531
6ab20c7e1dec added: #installAutoloadedClassesFromAbbrevFile:
Claus Gittinger <cg@exept.de>
parents: 13529
diff changeset
  5961
    "Created: / 29-07-2011 / 20:39:21 / cg"
6ab20c7e1dec added: #installAutoloadedClassesFromAbbrevFile:
Claus Gittinger <cg@exept.de>
parents: 13529
diff changeset
  5962
!
6ab20c7e1dec added: #installAutoloadedClassesFromAbbrevFile:
Claus Gittinger <cg@exept.de>
parents: 13529
diff changeset
  5963
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5964
installAutoloadedClassesFromStream:anAbbrevFileStream
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5965
    "read the given abbreviation file;
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5966
     install all classes found there as autoloaded, and also update the
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5967
     abbreviation (className-to-fileName mapping) table.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5968
     This takes some time ..."
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5969
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5970
    |s2 l abbrevFileName info clsName cls abbrev package cat numClassInstVars words w|
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5971
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5972
    anAbbrevFileStream isFileStream ifTrue:[
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5973
	abbrevFileName := anAbbrevFileStream pathName.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5974
	info := 'declared from: ', abbrevFileName.
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5975
    ].
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5976
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5977
    "/ yes, create any required nameSpace, without asking user.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5978
    Class createNameSpaceQuerySignal answer:true do:[
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5979
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5980
	[anAbbrevFileStream atEnd] whileFalse:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5981
	    l := anAbbrevFileStream nextLine withoutSeparators.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5982
	    "Skip empty lines and comments"
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5983
	    (l notEmpty and:[l first ~= $#]) ifTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5984
		"/ must do it manually, caring for quoted strings.
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5985
"/                words := line asCollectionOfWords.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  5986
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5987
		words := OrderedCollection new.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5988
		s2 := l readStream.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5989
		[s2 atEnd] whileFalse:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5990
		    s2 skipSeparators.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5991
		    s2 peek == $' ifTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5992
			s2 next.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5993
			w := s2 upTo:$'.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5994
			s2 skipSeparators.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5995
		    ] ifFalse:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5996
			w := s2 upToSeparator
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5997
		    ].
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5998
		    words add:w
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  5999
		].
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  6000
		words size < 3 ifTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  6001
		    'Smalltalk [warning]: bad abbrev entry' errorPrint.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  6002
		    anAbbrevFileStream isFileStream ifTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  6003
			' (in ''' errorPrint.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  6004
			anAbbrevFileStream pathName errorPrint.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  6005
			''')' errorPrint
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  6006
		    ].
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  6007
		    ': ' errorPrint. l errorPrintCR
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  6008
		] ifFalse:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  6009
		    clsName := (words at:1) asSymbol.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  6010
		    abbrev := (words at:2).
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  6011
		    package := (words at:3) asSymbol.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  6012
		    cat := words at:4 ifAbsent:nil.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  6013
		    numClassInstVars := words at:5 ifAbsent:'0'.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  6014
		    numClassInstVars := Integer readFrom:numClassInstVars onError:[0].
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  6015
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  6016
		    (cat size == 0) ifTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  6017
			cat := 'autoloaded'
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  6018
		    ].
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  6019
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  6020
		    "/ on the fly, update the abbreviations
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  6021
		    self setFilename:abbrev forClass:clsName package:package.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  6022
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  6023
		    "/ '  autoloaded: ' print. clsName print. ' in ' print. cat printCR.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  6024
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  6025
		    cls := self
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  6026
			installAutoloadedClassNamed:clsName
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  6027
			category:cat
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  6028
			package:package
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  6029
			revision:nil
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  6030
			numClassInstVars:numClassInstVars.
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6031
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6032
"/                    info notNil ifTrue:[
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6033
"/                        cls setComment:info.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6034
"/                    ].
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  6035
		]
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  6036
	    ]
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  6037
	]
4458
6f46b35f787c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4431
diff changeset
  6038
    ]
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  6039
!
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  6040
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6041
loadBinaries
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6042
    "return true, if binaries should be loaded into the system,
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6043
     false if this should be suppressed. The default is false (for now)."
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  6044
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  6045
    ^ LoadBinaries
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  6046
!
3044
a0bbac91639b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3033
diff changeset
  6047
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6048
loadBinaries:aBoolean
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6049
    "{ Pragma: +optSpace }"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6050
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6051
    "turn on/off loading of binary objects"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6052
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6053
    aBoolean ifTrue:[
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  6054
	(ObjectFileLoader notNil and:[ObjectFileLoader canLoadObjectFiles]) ifTrue:[
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  6055
	    LoadBinaries := true.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  6056
	    ^ self
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  6057
	].
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  6058
	'Smalltalk [info]: this system does not support binary loading' infoPrintCR.
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6059
    ].
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6060
    LoadBinaries := false
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6061
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6062
    "Modified: 10.1.1997 / 15:11:00 / cg"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6063
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6064
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6065
logDoits
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6066
    "return true if doits should go into the changes file
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6067
     as well as changes - by default, this is off, since
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6068
     it can blow up the changes file enormously ...
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6069
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6070
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6071
    ^ LogDoits
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6072
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6073
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6074
     LogDoits := false
3044
a0bbac91639b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3033
diff changeset
  6075
     LogDoits := true
a0bbac91639b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3033
diff changeset
  6076
    "
a0bbac91639b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3033
diff changeset
  6077
!
a0bbac91639b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3033
diff changeset
  6078
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6079
logDoits:aBoolean
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6080
    "{ Pragma: +optSpace }"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6081
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6082
    "turn on/off logging of doits in the changes file.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6083
     By default, this is off, since it can blow up the
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6084
     changes file enormously ...
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  6085
    "
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  6086
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  6087
    LogDoits := aBoolean
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  6088
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  6089
!
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  6090
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6091
makeBytecodeMethods
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6092
    "{ Pragma: +optSpace }"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6093
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6094
    "walk over all methods and make each a bytecode method
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6095
     iff it does not contain primitive C code.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6096
     Experimental and not yet used."
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6097
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6098
    Method allSubInstancesDo:[:aMethod |
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  6099
	|newMethod|
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  6100
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  6101
	aMethod hasPrimitiveCode ifFalse:[
18707
05a44da3c940 class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 18669
diff changeset
  6102
"/            aMethod errorPrintCR.
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  6103
	    newMethod := aMethod asByteCodeMethod.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  6104
	    newMethod ~~ aMethod ifTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  6105
		newMethod isNil ifTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  6106
		    'Smalltalk>>makeBytecodeMethods could nor recompile: ' errorPrint. aMethod errorPrintCR.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  6107
		] ifFalse:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  6108
		    aMethod becomeSameAs:newMethod
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  6109
		].
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  6110
	    ]
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  6111
	].
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6112
    ].
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6113
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6114
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6115
     Smalltalk makeBytecodeMethods
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6116
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6117
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6118
    "Modified: 16.1.1997 / 01:25:58 / cg"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6119
    "Created: 17.10.1997 / 13:52:19 / cg"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6120
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6121
14269
b540d11186f4 added: #recursiveInstallAutoloadedClassesFrom:
Claus Gittinger <cg@exept.de>
parents: 14210
diff changeset
  6122
recursiveInstallAutoloadedClassesFrom:aTopDirectory
b540d11186f4 added: #recursiveInstallAutoloadedClassesFrom:
Claus Gittinger <cg@exept.de>
parents: 14210
diff changeset
  6123
    "scan all packages and install all classes found there as
b540d11186f4 added: #recursiveInstallAutoloadedClassesFrom:
Claus Gittinger <cg@exept.de>
parents: 14210
diff changeset
  6124
     autoloaded. This takes some time ..."
b540d11186f4 added: #recursiveInstallAutoloadedClassesFrom:
Claus Gittinger <cg@exept.de>
parents: 14210
diff changeset
  6125
23408
559e80ba680d #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23177
diff changeset
  6126
    self recursiveInstallAutoloadedClassesFrom:aTopDirectory maxLevels:15
14269
b540d11186f4 added: #recursiveInstallAutoloadedClassesFrom:
Claus Gittinger <cg@exept.de>
parents: 14210
diff changeset
  6127
b540d11186f4 added: #recursiveInstallAutoloadedClassesFrom:
Claus Gittinger <cg@exept.de>
parents: 14210
diff changeset
  6128
    "
b540d11186f4 added: #recursiveInstallAutoloadedClassesFrom:
Claus Gittinger <cg@exept.de>
parents: 14210
diff changeset
  6129
     Smalltalk recursiveInstallAutoloadedClassesFrom:'..\..\..\cg\private\euler'
b540d11186f4 added: #recursiveInstallAutoloadedClassesFrom:
Claus Gittinger <cg@exept.de>
parents: 14210
diff changeset
  6130
    "
b540d11186f4 added: #recursiveInstallAutoloadedClassesFrom:
Claus Gittinger <cg@exept.de>
parents: 14210
diff changeset
  6131
b540d11186f4 added: #recursiveInstallAutoloadedClassesFrom:
Claus Gittinger <cg@exept.de>
parents: 14210
diff changeset
  6132
    "Created: / 31-07-2012 / 15:27:40 / cg"
23408
559e80ba680d #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23177
diff changeset
  6133
    "Modified: / 09-10-2018 / 11:10:25 / Claus Gittinger"
559e80ba680d #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23177
diff changeset
  6134
!
559e80ba680d #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23177
diff changeset
  6135
559e80ba680d #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23177
diff changeset
  6136
recursiveInstallAutoloadedClassesFrom:aTopDirectory maxLevels:maxLevels
559e80ba680d #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23177
diff changeset
  6137
    "scan all packages and install all classes found there as
559e80ba680d #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23177
diff changeset
  6138
     autoloaded. This takes some time ..."
559e80ba680d #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23177
diff changeset
  6139
559e80ba680d #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23177
diff changeset
  6140
    |dirsConsulted|
559e80ba680d #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23177
diff changeset
  6141
559e80ba680d #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23177
diff changeset
  6142
    dirsConsulted := Set new.
559e80ba680d #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23177
diff changeset
  6143
559e80ba680d #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23177
diff changeset
  6144
    self
559e80ba680d #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23177
diff changeset
  6145
        recursiveInstallAutoloadedClassesFrom:aTopDirectory
559e80ba680d #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23177
diff changeset
  6146
        rememberIn:dirsConsulted
559e80ba680d #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23177
diff changeset
  6147
        maxLevels:maxLevels
559e80ba680d #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23177
diff changeset
  6148
        noAutoload:false
559e80ba680d #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23177
diff changeset
  6149
        packageTop:nil
559e80ba680d #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23177
diff changeset
  6150
        showSplashInLevels:-1.
559e80ba680d #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23177
diff changeset
  6151
559e80ba680d #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23177
diff changeset
  6152
    "
559e80ba680d #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23177
diff changeset
  6153
     Smalltalk recursiveInstallAutoloadedClassesFrom:'..\..\..\cg\private\euler'
559e80ba680d #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23177
diff changeset
  6154
    "
559e80ba680d #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23177
diff changeset
  6155
559e80ba680d #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23177
diff changeset
  6156
    "Created: / 09-10-2018 / 11:10:06 / Claus Gittinger"
14269
b540d11186f4 added: #recursiveInstallAutoloadedClassesFrom:
Claus Gittinger <cg@exept.de>
parents: 14210
diff changeset
  6157
!
b540d11186f4 added: #recursiveInstallAutoloadedClassesFrom:
Claus Gittinger <cg@exept.de>
parents: 14210
diff changeset
  6158
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6159
recursiveInstallAutoloadedClassesFrom:aDirectory rememberIn:dirsConsulted maxLevels:maxLevels noAutoload:noAutoloadIn packageTop:packageTopPath
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6160
    "read all abbrev.stc files from and under aDirectory
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6161
     and install autoloaded classes.
15783
647ea33569b6 class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 15781
diff changeset
  6162
     If a file called NOAUTOLOAD is found, no classes there are installed as autoloaded,
647ea33569b6 class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 15781
diff changeset
  6163
     but classes in subdirectories are installed, if the subdirectory contains a file
647ea33569b6 class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 15781
diff changeset
  6164
     named AUTOLOAD.
647ea33569b6 class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 15781
diff changeset
  6165
     If a file called NOSUBAUTOLOAD is found, no classes there and below are installed as autoloaded.
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6166
     If a file called NOPACKAGES is found, no further searching is done in that directory or below."
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6167
11391
529c3e286e9c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11389
diff changeset
  6168
    self
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  6169
	recursiveInstallAutoloadedClassesFrom:aDirectory rememberIn:dirsConsulted
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  6170
	maxLevels:maxLevels noAutoload:noAutoloadIn packageTop:packageTopPath
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  6171
	showSplashInLevels:0.
11391
529c3e286e9c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11389
diff changeset
  6172
529c3e286e9c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11389
diff changeset
  6173
    "
529c3e286e9c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11389
diff changeset
  6174
     Smalltalk installAutoloadedClasses
529c3e286e9c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11389
diff changeset
  6175
    "
529c3e286e9c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11389
diff changeset
  6176
529c3e286e9c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11389
diff changeset
  6177
    "Modified: / 17-08-2006 / 16:48:43 / cg"
529c3e286e9c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11389
diff changeset
  6178
!
529c3e286e9c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11389
diff changeset
  6179
12022
205ac90337cc oops- fileNameForClass
Claus Gittinger <cg@exept.de>
parents: 12019
diff changeset
  6180
recursiveInstallAutoloadedClassesFrom:aDirectory rememberIn:dirsConsulted
11391
529c3e286e9c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11389
diff changeset
  6181
maxLevels:maxLevels noAutoload:noAutoloadIn packageTop:packageTopPath
529c3e286e9c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11389
diff changeset
  6182
showSplashInLevels:showSplashInLevels
529c3e286e9c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11389
diff changeset
  6183
    "read all abbrev.stc files from and under aDirectory
529c3e286e9c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11389
diff changeset
  6184
     and install autoloaded classes.
15783
647ea33569b6 class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 15781
diff changeset
  6185
     If a file called NOAUTOLOAD is found, no classes there are installed as autoloaded,
647ea33569b6 class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 15781
diff changeset
  6186
     but classes in subdirectories are installed, if the subdirectory contains a file
647ea33569b6 class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 15781
diff changeset
  6187
     named AUTOLOAD.
647ea33569b6 class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 15781
diff changeset
  6188
     If a file called NOSUBAUTOLOAD is found, no classes there and below are installed as autoloaded.
11391
529c3e286e9c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11389
diff changeset
  6189
     If a file called NOPACKAGES is found, no further searching is done in that directory or below."
529c3e286e9c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11389
diff changeset
  6190
15783
647ea33569b6 class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 15781
diff changeset
  6191
    |dir noAutoloadHere dirName directoryContents haveAbbrevDotSTC|
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6192
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6193
    dir := aDirectory asFilename.
15958
fd69e4694d91 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15872
diff changeset
  6194
fd69e4694d91 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15872
diff changeset
  6195
    "/ Care for non-existent directories"
fd69e4694d91 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15872
diff changeset
  6196
    dir exists ifFalse:[ ^ self ].
fd69e4694d91 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15872
diff changeset
  6197
15783
647ea33569b6 class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 15781
diff changeset
  6198
    dirName := dir physicalPathName.            "take care of symbolic links"
11392
8c606db1cd2f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11391
diff changeset
  6199
8c606db1cd2f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11391
diff changeset
  6200
    (dirsConsulted includes:dirName) ifTrue:[
24417
03b083548da2 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24414
diff changeset
  6201
        ^ self
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6202
    ].
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6203
12377
f9a9aea7ba0f changed:13 methods
Claus Gittinger <cg@exept.de>
parents: 12376
diff changeset
  6204
    (dir / 'NOPACKAGES') exists ifTrue:[
24417
03b083548da2 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24414
diff changeset
  6205
        ^ self.
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6206
    ].
12377
f9a9aea7ba0f changed:13 methods
Claus Gittinger <cg@exept.de>
parents: 12376
diff changeset
  6207
    (dir / 'NOSUBAUTOLOAD') exists ifTrue:[
24417
03b083548da2 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24414
diff changeset
  6208
        ^ self.
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6209
    ].
11392
8c606db1cd2f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11391
diff changeset
  6210
15783
647ea33569b6 class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 15781
diff changeset
  6211
    maxLevels == 0 ifTrue:[
24417
03b083548da2 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24414
diff changeset
  6212
        Transcript showCR:'Autoload: max directory nesting reached in %1' with:dir pathName.
03b083548da2 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24414
diff changeset
  6213
        ^ self
15783
647ea33569b6 class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 15781
diff changeset
  6214
    ].
647ea33569b6 class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 15781
diff changeset
  6215
647ea33569b6 class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 15781
diff changeset
  6216
    dirsConsulted add:dirName.
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6217
    noAutoloadHere := noAutoloadIn.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6218
    noAutoloadHere ifFalse:[
24417
03b083548da2 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24414
diff changeset
  6219
        (dir / 'NOAUTOLOAD') exists ifTrue:[
03b083548da2 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24414
diff changeset
  6220
            noAutoloadHere := true.
03b083548da2 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24414
diff changeset
  6221
        ].
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6222
    ] ifTrue:[
24417
03b083548da2 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24414
diff changeset
  6223
        (dir / 'AUTOLOAD') exists ifTrue:[
03b083548da2 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24414
diff changeset
  6224
            noAutoloadHere := false.
03b083548da2 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24414
diff changeset
  6225
        ].
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6226
    ].
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6227
11393
5964970e515c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11392
diff changeset
  6228
    showSplashInLevels >= 0 ifTrue:[
24417
03b083548da2 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24414
diff changeset
  6229
        self showSplashMessage:('Smalltalk [info]: installing autoloaded classes found under "%1"...'
03b083548da2 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24414
diff changeset
  6230
                                bindWith:(dirName contractAtBeginningTo:35)).
11392
8c606db1cd2f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11391
diff changeset
  6231
    ].
8c606db1cd2f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11391
diff changeset
  6232
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6233
    "/
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6234
    "/ suppress installation as autoloaded in this and everything
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6235
    "/ below; however, still traverse the directories to find packages ...
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6236
    "/
15596
6e05c159e789 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15594
diff changeset
  6237
    haveAbbrevDotSTC := false.
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6238
    noAutoloadHere ifFalse:[
24417
03b083548da2 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24414
diff changeset
  6239
        [
03b083548da2 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24414
diff changeset
  6240
            self installAutoloadedClassesFromAbbrevFile:(dir / 'abbrev.stc').
03b083548da2 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24414
diff changeset
  6241
            haveAbbrevDotSTC := true.
03b083548da2 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24414
diff changeset
  6242
        ] on:FileStream openErrorSignal
03b083548da2 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24414
diff changeset
  6243
        do:[:ex|
03b083548da2 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24414
diff changeset
  6244
            "ignore this file"
03b083548da2 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24414
diff changeset
  6245
        ].
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6246
    ].
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6247
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6248
    [
24417
03b083548da2 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24414
diff changeset
  6249
        directoryContents := dir directoryContents.
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6250
    ] on:FileStream openErrorSignal do:[:ex|
24417
03b083548da2 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24414
diff changeset
  6251
        "non-accessible directory: we are done"
03b083548da2 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24414
diff changeset
  6252
        ^ self
16199
86aeff99ebb4 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16180
diff changeset
  6253
    ].
86aeff99ebb4 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16180
diff changeset
  6254
86aeff99ebb4 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16180
diff changeset
  6255
    directoryContents := directoryContents select:[:fn | (fn startsWith:'.') not] as:Set.
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6256
12911
0822e257daeb comment/format in: #installAutoloadedClasses
Stefan Vogel <sv@exept.de>
parents: 12883
diff changeset
  6257
    directoryContents removeAllFoundIn:#(
24417
03b083548da2 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24414
diff changeset
  6258
                            'objbc' 'objvc' 'objmingw'
03b083548da2 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24414
diff changeset
  6259
                            'doc'
03b083548da2 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24414
diff changeset
  6260
                            'CVS'
03b083548da2 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24414
diff changeset
  6261
                            'bitmaps'
03b083548da2 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24414
diff changeset
  6262
                            'resources'
03b083548da2 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24414
diff changeset
  6263
                            'source'
03b083548da2 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24414
diff changeset
  6264
                            'not_delivered'
03b083548da2 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24414
diff changeset
  6265
                            'not_ported'
03b083548da2 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24414
diff changeset
  6266
                        ).
12911
0822e257daeb comment/format in: #installAutoloadedClasses
Stefan Vogel <sv@exept.de>
parents: 12883
diff changeset
  6267
    dir baseName = 'stx' ifTrue:[
24417
03b083548da2 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24414
diff changeset
  6268
        directoryContents removeAllFoundIn:#(
03b083548da2 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24414
diff changeset
  6269
                            'configurations'
03b083548da2 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24414
diff changeset
  6270
                            'include'
03b083548da2 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24414
diff changeset
  6271
                            'rules'
03b083548da2 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24414
diff changeset
  6272
                            'stc'
03b083548da2 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24414
diff changeset
  6273
                            'support'
03b083548da2 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24414
diff changeset
  6274
                        ).
12911
0822e257daeb comment/format in: #installAutoloadedClasses
Stefan Vogel <sv@exept.de>
parents: 12883
diff changeset
  6275
    ].
0822e257daeb comment/format in: #installAutoloadedClasses
Stefan Vogel <sv@exept.de>
parents: 12883
diff changeset
  6276
0822e257daeb comment/format in: #installAutoloadedClasses
Stefan Vogel <sv@exept.de>
parents: 12883
diff changeset
  6277
    directoryContents do:[:eachFilenameString |
24417
03b083548da2 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24414
diff changeset
  6278
        |f|
03b083548da2 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24414
diff changeset
  6279
03b083548da2 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24414
diff changeset
  6280
        f := dir / eachFilenameString.
03b083548da2 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24414
diff changeset
  6281
        f isDirectory ifTrue:[
03b083548da2 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24414
diff changeset
  6282
             self
03b083548da2 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24414
diff changeset
  6283
                recursiveInstallAutoloadedClassesFrom:f
03b083548da2 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24414
diff changeset
  6284
                rememberIn:dirsConsulted
03b083548da2 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24414
diff changeset
  6285
                maxLevels:maxLevels-1
03b083548da2 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24414
diff changeset
  6286
                noAutoload:noAutoloadHere
03b083548da2 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24414
diff changeset
  6287
                packageTop:packageTopPath
03b083548da2 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24414
diff changeset
  6288
                showSplashInLevels:showSplashInLevels - 1.
03b083548da2 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24414
diff changeset
  6289
        ] ifFalse:[
03b083548da2 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24414
diff changeset
  6290
            (noAutoloadHere not and:[haveAbbrevDotSTC not]) ifTrue:[
03b083548da2 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24414
diff changeset
  6291
                f suffix = 'st' ifTrue:[
03b083548da2 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24414
diff changeset
  6292
                    [
03b083548da2 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24414
diff changeset
  6293
                        self installAutoloadedClassFromSourceFile:f.
03b083548da2 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24414
diff changeset
  6294
                        f directory baseName = 'libbasic' ifTrue:[self halt].
03b083548da2 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24414
diff changeset
  6295
                    ] on:FileStream openErrorSignal do:[:ex|
03b083548da2 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24414
diff changeset
  6296
                        "ignore this file, but write a warning"
03b083548da2 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24414
diff changeset
  6297
                        Transcript showCR:('Autoload: cannot install %1. (%2)' bindWith:f pathName with:ex description).
03b083548da2 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24414
diff changeset
  6298
                    ].
03b083548da2 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24414
diff changeset
  6299
                ]
03b083548da2 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24414
diff changeset
  6300
            ].
03b083548da2 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24414
diff changeset
  6301
        ]
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6302
    ].
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6303
11393
5964970e515c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11392
diff changeset
  6304
    showSplashInLevels >= 0 ifTrue:[
24417
03b083548da2 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24414
diff changeset
  6305
        self showSplashMessage:('Smalltalk [info]: installing autoloaded classes from "%1"...'
03b083548da2 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24414
diff changeset
  6306
                                bindWith:(dirName contractAtBeginningTo:35)).
11392
8c606db1cd2f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11391
diff changeset
  6307
    ].
8c606db1cd2f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11391
diff changeset
  6308
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6309
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6310
     Smalltalk installAutoloadedClasses
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6311
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6312
15596
6e05c159e789 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15594
diff changeset
  6313
    "Modified: / 01-08-2013 / 16:57:49 / cg"
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6314
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6315
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6316
replaceReferencesTo:anObject with:newRef
12194
208afdcf182b comment/format in: #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 12172
diff changeset
  6317
    "if the receiver refers to the argument, anObject, replace this reference with newRef.
208afdcf182b comment/format in: #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 12172
diff changeset
  6318
     Return true, if any reference was changed.
208afdcf182b comment/format in: #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 12172
diff changeset
  6319
     Notice: this does not change the class-reference."
208afdcf182b comment/format in: #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 12172
diff changeset
  6320
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6321
    |toAdd|
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6322
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6323
    toAdd := OrderedCollection new.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6324
    self keysAndValuesDo:[:key :val |
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  6325
	(key == anObject) ifTrue:[
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  6326
	    self shouldImplement.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  6327
	].
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  6328
	(val == anObject ) ifTrue:[
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  6329
	    toAdd add:(key -> newRef)
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  6330
	].
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6331
    ].
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6332
    toAdd do:[:each |
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  6333
	self at:(each key) put:(each value)
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6334
    ].
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6335
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6336
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6337
saveEmergencyImage:aBoolean
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6338
    "set/clear the flag which controls if ST/X should save an
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6339
     emergency image in case of a broken display connection.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6340
     The default is true.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6341
     This may be useful, if you work with an unsecure display
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6342
     (serial line), and want to have a chance of proceeding after
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6343
     a crash. In multiheaded applications, this only affects
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6344
     crashes of the master Display connection (the initial connection);
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6345
     errors on other displays are reported to the views and treated
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6346
     like window destroy from the windowManager."
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6347
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6348
    SaveEmergencyImage := aBoolean
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6349
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6350
    "Modified: / 24.10.1997 / 18:22:26 / cg"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6351
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6352
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6353
systemOrganization
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6354
    "for partial ST80 compatibility;
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6355
     In ST80, Smalltalk organization returns a systemOrganizer, which
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6356
     keeps track of class-categories, while all classes return a classOrganizer
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6357
     from #organization, which keeps track of method categories of that class.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6358
     Since in ST/X, Smalltalk is a class, there is now a conflict.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6359
     To make a workaround possible, use #systemOrganization when porting
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6360
     VW apps to ST/X to get the class-categories.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6361
     Read the documentation in SystemOrganizer for more info."
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6362
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6363
    ^ SystemOrganizer for:nil
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6364
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6365
    "Created: / 20.6.1998 / 12:24:02 / cg"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6366
    "Modified: / 20.6.1998 / 12:41:34 / cg"
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  6367
! !
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  6368
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  6369
!Smalltalk class methodsFor:'system management-fileIn'!
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  6370
23419
90b6b18e27de #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 23414
diff changeset
  6371
fileIn:aFileNameOrString
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6372
    "read in the named file - look for it in some standard places;
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6373
     return true if ok, false if failed.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6374
     This method can load almost anything which makes sense:
23419
90b6b18e27de #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 23414
diff changeset
  6375
        .st    - source files
90b6b18e27de #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 23414
diff changeset
  6376
        .cls   - binary smalltalk bytecode files
90b6b18e27de #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 23414
diff changeset
  6377
        .so    - binary compiled machine code class libraries
90b6b18e27de #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 23414
diff changeset
  6378
        [.class - java bytecode -- soon to come]"
90b6b18e27de #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 23414
diff changeset
  6379
90b6b18e27de #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 23414
diff changeset
  6380
    ^ self fileIn:aFileNameOrString lazy:nil silent:nil logged:false
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6381
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6382
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6383
     Smalltalk fileIn:'source/TicTacToe.st'
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6384
     Smalltalk fileIn:'binary/TicTacToe.cls'
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6385
     Smalltalk fileIn:'binary/TicTacToe.so'
24405
1cd295707fd7 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24376
diff changeset
  6386
     Smalltalk fileIn:'foo.st'
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6387
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6388
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6389
    "Created: 28.10.1995 / 17:06:28 / cg"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6390
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6391
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6392
fileIn:aFileName inPackage:aPackageID
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6393
    "read in the named file in a packages directory."
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6394
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6395
    |dir|
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6396
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6397
    dir := self getPackageDirectoryForPackage:aPackageID.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6398
    dir isNil ifTrue:[^ false].
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6399
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6400
    dir := dir asFilename.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6401
    ^ (self fileIn:(dir construct:aFileName))
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6402
      or:[ self fileIn:((dir construct:'source') construct:aFileName) ]
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6403
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6404
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6405
fileIn:aFileName lazy:lazy
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6406
    "read in the named file - look for it in some standard places;
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6407
     return true if ok, false if failed.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6408
     If lazy is true, no code is generated for methods, instead stubs
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6409
     are created which compile themself when first executed. This allows
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6410
     for much faster fileIn (but slows down the first execution later).
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6411
     Since no syntax checks are done when doing lazy fileIn, use this only for
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6412
     code which is known to be syntactically correct."
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6413
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6414
    ^ self fileIn:aFileName lazy:lazy silent:nil logged:false
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6415
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6416
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6417
     Smalltalk fileIn:'source/TicTacToe.st' lazy:true
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6418
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6419
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6420
    "Created: 28.10.1995 / 17:06:36 / cg"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6421
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6422
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6423
fileIn:aFileName lazy:lazy silent:silent
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6424
    "read in the named file - look for it in some standard places;
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6425
     return true if ok, false if failed.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6426
     If lazy is true, no code is generated for methods, instead stubs
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6427
     are created which compile themself when first executed. This allows
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6428
     for much faster fileIn (but slows down the first execution later).
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6429
     Since no syntax checks are done when doing lazy fileIn, use this only for
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6430
     code which is known to be syntactically correct.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6431
     If silent is true, no compiler messages are output to the transcript.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6432
     Giving nil for silent/lazy will use the current settings."
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6433
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6434
    ^ self fileIn:aFileName lazy:lazy silent:silent logged:false
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6435
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6436
    "Created: 28.10.1995 / 17:06:41 / cg"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6437
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6438
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6439
fileIn:aFileNameOrString lazy:lazy silent:silent logged:logged
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6440
    "read in the named file - look for it in some standard places;
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6441
     return true if ok, false if failed.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6442
     If lazy is true, no code is generated for methods, instead stubs
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6443
     are created which compile themself when first executed. This allows
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6444
     for much faster fileIn (but slows down the first execution later).
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6445
     Since no syntax checks are done when doing lazy fileIn, use this only for
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6446
     code which is known to be syntactically correct.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6447
     If silent is true, no compiler messages are output to the transcript.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6448
     Giving nil for silent/lazy will use the current settings.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6449
     This method can load almost anything which makes sense:
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  6450
	.st    - source files
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  6451
	.cls   - binary smalltalk bytecode files
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  6452
	.so    - binary compiled machine code class libraries
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  6453
	[.class - java bytecode -- soon to come]"
15594
0bddb6eb353b class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15565
diff changeset
  6454
15665
eb289b107887 class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 15616
diff changeset
  6455
    |fileNameString inStream path morePath bos|
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6456
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6457
    fileNameString := aFileNameOrString asString.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6458
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6459
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6460
     an object or shared object ?
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6461
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6462
    (ObjectFileLoader notNil
22691
df53ad43691d #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 22679
diff changeset
  6463
     and:[ObjectFileLoader hasValidBinaryExtension:fileNameString]) ifTrue:[
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  6464
	"/ LoadBinaries ifFalse:[^ false].
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  6465
	path := self getBinaryFileName:fileNameString.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  6466
	path isNil ifTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  6467
	    path := self getSystemFileName:fileNameString.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  6468
	    path isNil ifTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  6469
		^ false
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  6470
	    ].
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  6471
	].
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  6472
	^ (ObjectFileLoader loadObjectFile:path) notNil
15594
0bddb6eb353b class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15565
diff changeset
  6473
    ].
0bddb6eb353b class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15565
diff changeset
  6474
0bddb6eb353b class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15565
diff changeset
  6475
    inStream := self systemFileStreamFor:fileNameString.
0bddb6eb353b class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15565
diff changeset
  6476
    inStream isNil ifTrue:[^ false].
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6477
22691
df53ad43691d #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 22679
diff changeset
  6478
    (aFileNameOrString asFilename hasSuffix:'cls') ifTrue:[
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  6479
	BinaryObjectStorage isNil ifTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  6480
	    ^ false.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  6481
	].
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  6482
	[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  6483
	    inStream binary.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  6484
	    bos := BinaryObjectStorage onOld:inStream.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  6485
	    bos next.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  6486
	] ensure:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  6487
	    bos close.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  6488
	].
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  6489
	^ true
15594
0bddb6eb353b class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15565
diff changeset
  6490
    ].
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6491
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6492
    (fileNameString includes:$/) ifTrue:[
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  6493
	"/ temporarily prepend the file's directory
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  6494
	"/ to the searchPath.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  6495
	"/ This allows fileIn-driver files to refer to local
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  6496
	"/ files via a relative path, and drivers to fileIn other
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  6497
	"/ drivers ...
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  6498
	morePath := inStream fileName directoryName.
15594
0bddb6eb353b class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15565
diff changeset
  6499
    ].
15665
eb289b107887 class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 15616
diff changeset
  6500
    ^ self fileInStream:inStream lazy:lazy silent:silent logged:logged addPath:morePath
15594
0bddb6eb353b class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15565
diff changeset
  6501
0bddb6eb353b class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15565
diff changeset
  6502
    "
0bddb6eb353b class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15565
diff changeset
  6503
     Smalltalk fileIn:'clients/TicTacToe/TicTacToe.st' lazy:true silent:true
0bddb6eb353b class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15565
diff changeset
  6504
     Smalltalk fileIn:'keyboard.rc'
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6505
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6506
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6507
    "Modified: / 08-09-2006 / 19:21:16 / cg"
22691
df53ad43691d #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 22679
diff changeset
  6508
    "Modified: / 23-04-2018 / 17:05:33 / stefan"
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6509
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6510
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6511
fileIn:aFileName logged:logged
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6512
    "read in the named file - look for it in some standard places;
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6513
     return true if ok, false if failed.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6514
     The argument logged controls, if the changefile is to be updated."
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6515
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6516
    ^ self fileIn:aFileName lazy:nil silent:nil logged:logged
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6517
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6518
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6519
     Smalltalk fileIn:'source/TicTacToe.st' logged:false
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6520
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6521
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6522
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6523
fileIn:aFileName silent:silent
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6524
    "read in the named file - look for it in some standard places;
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6525
     return true if ok, false if failed.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6526
     If silent is true, no compiler messages are output to the transcript."
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6527
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6528
    ^ self fileIn:aFileName lazy:nil silent:silent logged:false
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6529
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6530
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6531
     Smalltalk fileIn:'source/TicTacToe.st' silent:true
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6532
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6533
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6534
    "Created: 28.10.1995 / 17:06:36 / cg"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6535
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6536
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6537
fileInChanges
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6538
    "read in the last changes file - bringing the system to the state it
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6539
     had when left the last time.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6540
     WARNING: this method is rubbish: it should only read things after the
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  6541
	      last '**snapshot**' - entry
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  6542
	      (instead of the complete changes file)."
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6543
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6544
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6545
     do NOT update the changes file now ...
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6546
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6547
    self fileIn:ChangeFileName logged:false
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6548
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6549
    "
10071
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
  6550
     Smalltalk fileInChanges
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  6551
    "
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  6552
!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  6553
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6554
fileInClass:aClassName
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6555
    "find a source/object file for aClassName and -if found - load it.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6556
     search is in some standard places trying driver-file (.ld), object-file (.o) and
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6557
     finally source file (.st) in that order.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6558
     The file is first searched for using the class name, then the abbreviated name."
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6559
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6560
    ^ self
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  6561
	fileInClass:aClassName
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  6562
	package:nil
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  6563
	initialize:true
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  6564
	lazy:false
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  6565
	silent:nil
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6566
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6567
    "Modified: / 9.1.1998 / 14:41:46 / cg"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6568
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6569
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6570
fileInClass:aClassName fromObject:aFileName
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6571
    "read in the named object file and dynamic-link it into the system
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6572
     - look for it in some standard places.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6573
     Only install the named class from this object file.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6574
     Return true if ok, false if failed."
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6575
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6576
    |path ok|
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6577
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6578
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6579
     check if the dynamic loader class is in
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6580
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6581
    (LoadBinaries not or:[ObjectFileLoader isNil]) ifTrue:[^ false].
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6582
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6583
    (path := self getBinaryFileName:aFileName) isNil ifTrue:[^ false].
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6584
    ok := (ObjectFileLoader loadClass:aClassName fromObjectFile:path) notNil.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6585
    ok ifTrue:[
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  6586
	VerboseLoading ifTrue:[
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  6587
	    Transcript show:'  loaded ' , aClassName , ' from ' ; showCR:aFileName.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  6588
	]
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6589
    ].
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6590
    ^ ok
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6591
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6592
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6593
     Smalltalk fileInClass:'AbstractPath' fromObject:'../../goodies/Paths/AbstrPath.so'
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6594
     Smalltalk fileInClass:'ClockView' fromObject:'../../libwidg3/libwidg3.so'
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6595
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6596
13814
3d547c0d4634 changed:5 methods
Claus Gittinger <cg@exept.de>
parents: 13787
diff changeset
  6597
    "Modified: / 04-11-2011 / 13:42:24 / cg"
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6598
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6599
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6600
fileInClass:aClassName initialize:doInit
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6601
    "find a source/object file for aClassName and -if found - load it.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6602
     search is in some standard places trying driver-file (.ld), object-file (.o) and
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6603
     finally source file (.st) in that order.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6604
     The file is first searched for using the class name, then the abbreviated name."
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6605
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6606
    ^ self
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  6607
	fileInClass:aClassName
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  6608
	package:nil
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  6609
	initialize:doInit
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  6610
	lazy:false
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  6611
	silent:nil
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6612
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6613
    "Modified: / 9.1.1998 / 14:42:02 / cg"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6614
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6615
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6616
fileInClass:aClassName initialize:doInit lazy:loadLazy
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6617
    "find a source/object file for aClassName and -if found - load it.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6618
     search is in some standard places trying driver-file (.ld), object-file (.o) and
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6619
     finally source file (.st) in that order.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6620
     The file is first searched for using the class name, then the abbreviated name."
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6621
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6622
     ^ self
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  6623
	fileInClass:aClassName
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  6624
	package:nil
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  6625
	initialize:doInit
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  6626
	lazy:loadLazy
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  6627
	silent:nil
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6628
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6629
    "Modified: / 9.1.1998 / 14:42:19 / cg"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6630
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6631
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6632
fileInClass:aClassName initialize:doInit lazy:loadLazy silent:beSilent
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6633
    "find a source/object file for aClassName and -if found - load it.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6634
     Search is in some standard places, trying driver-file (.ld), object-file (.so / .o) and
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6635
     finally source file (.st), in that order.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6636
     The file is first searched for using the class name, then the abbreviated name.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6637
     The argument doInit controlls if the class should be sent a #initialize after the
19867
4671f92c1f8c #OTHER by mawalch
mawalch
parents: 19856
diff changeset
  6638
     load; loadLazy tells if it should be loaded lazily. beSilent tells if the compiler
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6639
     should not send notes to the transcript; it can be true, false or nil, where
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6640
     nil uses the value from SilentLoading."
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6642
    ^ self
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  6643
	fileInClass:aClassName
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  6644
	package:nil
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  6645
	initialize:doInit
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  6646
	lazy:loadLazy
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  6647
	silent:beSilent
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6648
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6649
    "Modified: / 9.1.1998 / 14:42:28 / cg"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6650
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6651
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6652
fileInClass:aClassName package:package
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6653
    "find a source/object file for aClassName and -if found - load it.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6654
     search is in some standard places trying driver-file (.ld), object-file (.o) and
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6655
     finally source file (.st) in that order.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6656
     The file is first searched for using the class name, then the abbreviated name."
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6657
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6658
    ^ self
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  6659
	fileInClass:aClassName
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  6660
	package:package
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  6661
	initialize:true
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  6662
	lazy:false
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  6663
	silent:nil
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6664
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6665
    "Created: / 08-01-2007 / 10:06:09 / cg"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6666
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6667
10999
e5cfd06920ca *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10998
diff changeset
  6668
fileInClass:aClassName package:package initialize:doInit lazy:loadLazy silent:beSilent
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6669
    "find a source/object file for aClassName and -if found - load it.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6670
     This is the workhorse for autoloading.
10999
e5cfd06920ca *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10998
diff changeset
  6671
     Search is in some standard places, trying driver-file (.ld), object-file (.so / .o) and
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6672
     finally source file (.st), in that order.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6673
     The file is first searched for using the class name, then the abbreviated name.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6674
     The argument doInit controlls if the class should be sent a #initialize after the
19867
4671f92c1f8c #OTHER by mawalch
mawalch
parents: 19856
diff changeset
  6675
     load; loadLazy tells if it should be loaded lazily. beSilent tells if the compiler
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6676
     should not send notes to the transcript; it can be true, false or nil, where
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6677
     nil uses the value from SilentLoading."
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6678
22955
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6679
    |classFileName alternativeClassFileName libName newClass ok wasLazy wasSilent sharedLibSuffix inStream mgr
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6680
     filenameToSet packageDir packageFile bos|
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6681
17588
05b944f08b13 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17582
diff changeset
  6682
    ClassLoadInProgressQuery answerNotifyLoading:aClassName do:[
17582
4d4475b60428 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 17576
diff changeset
  6683
22955
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6684
        wasLazy := Compiler compileLazy:loadLazy.
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6685
        beSilent notNil ifTrue:[
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6686
            wasSilent := self silentLoading:beSilent.
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6687
        ].
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6688
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6689
        classFileName := Smalltalk fileNameForClass:aClassName.
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6690
        (classFileName = aClassName) ifTrue:[
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6691
            "/ no abbrev.stc translation for className
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6692
            (aClassName includes:$:) ifTrue:[
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6693
                "/ a nameSpace name
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6694
                alternativeClassFileName := classFileName copyFrom:(classFileName lastIndexOf:$:)+1
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6695
            ].
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6696
        ].
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6697
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6698
        classFileName asFilename isAbsolute ifTrue:[
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6699
            classFileName asFilename suffix notEmptyOrNil ifTrue:[
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6700
                ok := self fileIn:classFileName lazy:loadLazy silent:beSilent.
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6701
            ] ifFalse:[
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6702
                ok := self fileInSourceFile:classFileName lazy:loadLazy silent:beSilent.
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6703
            ]
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6704
        ] ifFalse:[
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6705
            classFileName := classFileName copyReplaceAll:$: with:$_ ifNone:classFileName.
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6706
            [
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6707
                Class withoutUpdatingChangesDo:[
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6708
                    |zarFn zar entry|
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6709
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6710
                    ok := false.
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6711
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6712
                    package notNil ifTrue:[
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6713
                        packageDir := package asPackageId packageDirectory.
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6714
                        "/ packageDir := package asString.
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6715
                        "/ packageDir := packageDir copyReplaceAll:$: with:$/.
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6716
                        packageDir isNil ifTrue:[
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6717
                            packageDir := self packageDirectoryForPackageId:package
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6718
                        ].
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6719
                        packageDir notNil ifTrue:[
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6720
                            packageDir := packageDir asFilename.
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6721
                        ].
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6722
                    ].
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6723
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6724
                    Class packageQuerySignal answer:package do:[
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6725
                        "
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6726
                         then, if dynamic linking is available,
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6727
                        "
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6728
                        (LoadBinaries and:[ObjectFileLoader notNil]) ifTrue:[
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6729
                            sharedLibSuffix := ObjectFileLoader sharedLibrarySuffix.
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6730
                            "
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6731
                             first look for a class packages shared binary in binary/xxx.o
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6732
                            "
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6733
                            libName := self libraryFileNameOfClass:aClassName.
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6734
                            libName notNil ifTrue:[
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6735
                                (ok := self fileInClass:aClassName fromObject:(libName asFilename withSuffix:sharedLibSuffix) name)
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6736
                                ifFalse:[
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6737
                                    sharedLibSuffix ~= 'o' ifTrue:[
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6738
                                        ok := self fileInClass:aClassName fromObject:(libName, '.o')
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6739
                                    ]
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6740
                                ].
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6741
                            ].
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6742
                            "
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6743
                             then, look for a shared binary in binary/xxx.o
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6744
                            "
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6745
                            ok ifFalse:[
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6746
                                (ok := self fileInClass:aClassName fromObject:(classFileName asFilename withSuffix:sharedLibSuffix) name)
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6747
                                ifFalse:[
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6748
                                    sharedLibSuffix ~= 'o' ifTrue:[
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6749
                                        ok := self fileInClass:aClassName fromObject:(classFileName, '.o')
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6750
                                    ].
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6751
                                    ok ifFalse:[
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6752
                                        alternativeClassFileName notNil ifTrue:[
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6753
                                            (ok := self fileInClass:aClassName fromObject:(alternativeClassFileName asFilename withSuffix:sharedLibSuffix) name)
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6754
                                            ifFalse:[
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6755
                                                sharedLibSuffix ~= 'o' ifTrue:[
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6756
                                                    ok := self fileInClass:aClassName fromObject:(alternativeClassFileName, '.o')
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6757
                                                ]
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6758
                                            ]
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6759
                                        ].
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6760
                                    ].
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6761
                                ].
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6762
                            ].
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6763
                        ].
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6764
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6765
                        "
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6766
                         if that did not work, look for a compiled-bytecode file ...
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6767
                        "
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6768
                        ok ifFalse:[
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6769
                            (ok := self fileIn:(classFileName , '.cls') lazy:loadLazy silent:beSilent)
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6770
                            ifFalse:[
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6771
                                alternativeClassFileName notNil ifTrue:[
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6772
                                    ok := self fileIn:(alternativeClassFileName , '.cls') lazy:loadLazy silent:beSilent
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6773
                                ]
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6774
                            ]
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6775
                        ].
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6776
                        "
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6777
                         if that did not work, and the classes package is known,
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6778
                         look for an st-cls file
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6779
                         in a package subdir of the source-directory ...
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6780
                        "
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6781
                        ok ifFalse:[
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6782
                            (packageDir notNil and:[BinaryObjectStorage notNil]) ifTrue:[
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6783
                                packageFile := self getPackageFileName:((packageDir / 'classes' / classFileName) addSuffix:'cls').
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6784
                                packageFile isNil ifTrue:[
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6785
                                    packageFile := (packageDir / 'classes' / classFileName) addSuffix:'cls'.
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6786
                                ].
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6787
                                (ok := self fileIn:packageFile lazy:loadLazy silent:beSilent)
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6788
                                ifFalse:[
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6789
                                    alternativeClassFileName notNil ifTrue:[
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6790
                                        packageFile := self getPackageFileName:((packageDir / 'classes' / alternativeClassFileName) addSuffix:'cls').
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6791
                                        packageFile isNil ifTrue:[
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6792
                                            packageFile := ((packageDir / 'classes' / alternativeClassFileName) addSuffix:'cls').
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6793
                                        ].
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6794
                                        ok := self fileIn:packageFile lazy:loadLazy silent:beSilent
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6795
                                    ]
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6796
                                ].
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6797
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6798
                                zarFn := self getPackageFileName:(packageDir / 'classes.zip').
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6799
                                zarFn notNil ifTrue:[
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6800
                                    zar := ZipArchive oldFileNamed:zarFn.
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6801
                                    zar notNil ifTrue:[
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6802
                                        entry := zar extract:(classFileName , '.cls').
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6803
                                        (entry isNil and:[alternativeClassFileName notNil]) ifTrue:[
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6804
                                            entry := zar extract:(alternativeClassFileName , '.cls').
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6805
                                        ].
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6806
                                        entry notNil ifTrue:[
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6807
                                            bos := BinaryObjectStorage onOld:(entry asByteArray readStream).
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6808
                                            bos next.
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6809
                                            bos close.
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6810
                                            ok := true
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6811
                                        ].
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6812
                                    ]
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6813
                                ]
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6814
                            ]
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6815
                        ].
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6816
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6817
                        "
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6818
                         if that did not work, look for an st-source file ...
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6819
                        "
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6820
                        ok ifFalse:[
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6821
                            filenameToSet := classFileName.
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6822
                            (ok := self fileInSourceFile:filenameToSet lazy:loadLazy silent:beSilent)
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6823
                            ifFalse:[
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6824
                                alternativeClassFileName notNil ifTrue:[
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6825
                                    filenameToSet := alternativeClassFileName.
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6826
                                    ok := self fileInSourceFile:filenameToSet lazy:loadLazy silent:beSilent
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6827
                                ].
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6828
                                ok ifFalse:[
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6829
                                    "
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6830
                                     ... and in the standard source-directory
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6831
                                    "
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6832
                                    filenameToSet := 'source' asFilename / classFileName.
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6833
                                    (ok := self fileInSourceFile:filenameToSet lazy:loadLazy silent:beSilent)
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6834
                                    ifFalse:[
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6835
                                        alternativeClassFileName notNil ifTrue:[
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6836
                                            filenameToSet := 'source' asFilename / alternativeClassFileName.
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6837
                                            ok := self fileInSourceFile:filenameToSet lazy:loadLazy silent:beSilent
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6838
                                        ]
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6839
                                    ]
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6840
                                ]
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6841
                            ].
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6842
                            "
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6843
                             if that did not work, and the classes package is known,
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6844
                             look for an st-source file
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6845
                             in a package subdir of the source-directory ...
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6846
                            "
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6847
                            ok ifFalse:[
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6848
                                packageDir notNil ifTrue:[
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6849
                                    packageFile := self getPackageSourceFileName:(packageDir / 'source' / classFileName).
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6850
                                    packageFile isNil ifTrue:[
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6851
                                        packageFile := (packageDir / 'source' / classFileName).
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6852
                                    ].
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6853
                                    filenameToSet := packageFile.
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6854
                                    (ok := self fileInSourceFile:packageFile lazy:loadLazy silent:beSilent)
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6855
                                    ifFalse:[
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6856
                                        alternativeClassFileName notNil ifTrue:[
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6857
                                            packageFile := self getPackageSourceFileName:(packageDir / 'source' / alternativeClassFileName).
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6858
                                            packageFile isNil ifTrue:[
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6859
                                                packageFile := (packageDir / 'source' / alternativeClassFileName).
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6860
                                            ].
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6861
                                            filenameToSet := packageFile.
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6862
                                            ok := self fileInSourceFile:packageFile lazy:loadLazy silent:beSilent
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6863
                                        ].
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6864
                                        ok ifFalse:[
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6865
                                            packageFile := self getPackageSourceFileName:(packageDir / classFileName).
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6866
                                            packageFile isNil ifTrue:[
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6867
                                                packageFile := (packageDir / classFileName).
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6868
                                            ].
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6869
                                            filenameToSet := packageFile.
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6870
                                            (ok := self fileInSourceFile:packageFile lazy:loadLazy silent:beSilent)
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6871
                                            ifFalse:[
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6872
                                                alternativeClassFileName notNil ifTrue:[
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6873
                                                    packageFile := self getPackageFileName:(packageDir / alternativeClassFileName).
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6874
                                                    packageFile isNil ifTrue:[
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6875
                                                        packageFile := packageDir / alternativeClassFileName.
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6876
                                                    ].
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6877
                                                    filenameToSet := packageFile.
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6878
                                                    ok := self fileInSourceFile:packageFile lazy:loadLazy silent:beSilent
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6879
                                                ].
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6880
                                                ok ifFalse:[
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6881
                                                    "
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6882
                                                     ... and in the standard source-directory
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6883
                                                    "
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6884
                                                    filenameToSet := 'source' asFilename / packageDir / classFileName.
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6885
                                                    (ok := self fileInSourceFile:filenameToSet lazy:loadLazy silent:beSilent)
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6886
                                                    ifFalse:[
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6887
                                                        alternativeClassFileName notNil ifTrue:[
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6888
                                                            filenameToSet := 'source' asFilename / packageDir / alternativeClassFileName.
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6889
                                                            ok := self fileInSourceFile:filenameToSet lazy:loadLazy silent:beSilent
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6890
                                                        ]
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6891
                                                    ]
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6892
                                                ]
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6893
                                            ].
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6894
                                        ].
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6895
                                    ].
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6896
                                ]
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6897
                            ].
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6898
                            "
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6899
                             if that did not work, and the classes package is known,
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6900
                             look for a zipArchive containing a class entry.
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6901
                            "
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6902
                            ok ifFalse:[
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6903
                                packageDir notNil ifTrue:[
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6904
                                    zarFn := self getPackageFileName:(packageDir / 'source.zip').
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6905
                                    zarFn isNil ifTrue:[
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6906
                                        zarFn := packageDir withSuffix:'zip'.
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6907
                                        zarFn := self getSourceFileName:zarFn.
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6908
                                    ].
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6909
                                    (zarFn notNil and:[zarFn asFilename exists]) ifTrue:[
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6910
                                        zar := ZipArchive oldFileNamed:zarFn.
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6911
                                        zar notNil ifTrue:[
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6912
                                            entry := zar extract:(classFileName , '.st').
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6913
                                            (entry isNil and:[alternativeClassFileName notNil]) ifTrue:[
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6914
                                                entry := zar extract:(alternativeClassFileName , '.st').
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6915
                                            ].
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6916
                                            entry notNil ifTrue:[
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6917
                                                filenameToSet := zarFn.
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6918
                                                ok := self
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6919
                                                        fileInStream:(entry asString readStream)
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6920
                                                        lazy:loadLazy
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6921
                                                        silent:beSilent
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6922
                                                        logged:false
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6923
                                                        addPath:nil
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6924
                                            ].
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6925
                                        ]
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6926
                                    ]
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6927
                                ]
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6928
                            ].
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6929
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6930
                            "
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6931
                             if that did not work,
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6932
                             look for a zipArchive containing a class entry.
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6933
                            "
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6934
                            ok ifFalse:[
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6935
                                zarFn := self getSourceFileName:'source.zip'.
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6936
                                zarFn notNil ifTrue:[
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6937
                                    zar := ZipArchive oldFileNamed:zarFn.
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6938
                                    zar notNil ifTrue:[
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6939
                                        entry := zar extract:(zarFn := classFileName , '.st').
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6940
                                        (entry isNil and:[alternativeClassFileName notNil]) ifTrue:[
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6941
                                            entry := zar extract:(zarFn := alternativeClassFileName , '.st').
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6942
                                        ].
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6943
                                        entry notNil ifTrue:[
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6944
                                            filenameToSet := zarFn.
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6945
                                            ok := self
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6946
                                                    fileInStream:(entry asString readStream)
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6947
                                                    lazy:loadLazy
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6948
                                                    silent:beSilent
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6949
                                                    logged:false
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6950
                                                    addPath:nil
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6951
                                        ].
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6952
                                    ]
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6953
                                ]
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6954
                            ].
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6955
                            ok ifFalse:[
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6956
                                "
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6957
                                 if there is a sourceCodeManager, ask it for the classes sourceCode
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6958
                                "
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6959
                                (mgr := Smalltalk at:#SourceCodeManager) notNil ifTrue:[
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6960
                                    inStream := mgr getMostRecentSourceStreamForClassNamed:aClassName inPackage:package.
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6961
                                    inStream notNil ifTrue:[
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6962
                                        filenameToSet := nil.
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6963
                                        ok := self fileInStream:inStream lazy:loadLazy silent:beSilent logged:false addPath:nil.
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6964
                                    ]
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6965
                                ].
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6966
                            ].
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6967
                        ].
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6968
                    ]
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6969
                ].
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6970
            ] ensure:[
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6971
                Compiler compileLazy:wasLazy.
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6972
                wasSilent notNil ifTrue:[
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6973
                    self silentLoading:wasSilent
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6974
                ]
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6975
            ].
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6976
        ].
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6977
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6978
        ok ifTrue:[
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6979
            newClass := self at:(aClassName asSymbol).
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6980
            newClass notNil ifTrue:[
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6981
                "set the classes name - but do not change if already set"
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6982
                filenameToSet notNil ifTrue:[
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6983
                    newClass getClassFilename isNil ifTrue:[
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6984
                        newClass setClassFilename:(filenameToSet asFilename baseName)
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6985
                    ].
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6986
                ].
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6987
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6988
                doInit ifTrue:[
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6989
                    newClass initialize
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6990
                ]
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6991
            ]
641df14854e2 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 22900
diff changeset
  6992
        ].
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6993
    ].
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6994
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6995
    ^ newClass
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  6996
13415
ba3e5e6dd910 Jan's changes
vrany
parents: 13385
diff changeset
  6997
    "Created: / 09-01-1998 / 14:40:32 / cg"
ba3e5e6dd910 Jan's changes
vrany
parents: 13385
diff changeset
  6998
    "Modified: / 05-06-1999 / 14:53:01 / cg"
ba3e5e6dd910 Jan's changes
vrany
parents: 13385
diff changeset
  6999
    "Modified: / 16-08-2009 / 14:52:53 / Jan Vrany <vranyj1@fel.cvut.cz>"
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7000
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7001
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7002
fileInClassLibrary:aClassLibraryName
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7003
    "find an object file containing a binary class library in some standard places
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7004
     and load it. This install all of its contained classes.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7005
     Return true if ok, false if not.
24405
1cd295707fd7 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24376
diff changeset
  7006
     Changed to raise an error if not OK (i.e. only returns false if the error is proceeded)
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7007
     Notice: the argument may not have an extension (by purpose);
24405
1cd295707fd7 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24376
diff changeset
  7008
             the sharedLib extension (.dll / .so / .sl) is added here, to
1cd295707fd7 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24376
diff changeset
  7009
             make the caller independent of the underlying operatingSystem."
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7010
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7011
    |path fn|
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7012
16144
3bde1ed36852 class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 16132
diff changeset
  7013
    ObjectFileLoader isNil ifTrue:[
24405
1cd295707fd7 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24376
diff changeset
  7014
        ^ (PackageLoadError raiseRequestWith:aClassLibraryName errorString:' - no ObjectFileLoader') ? false.
16144
3bde1ed36852 class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 16132
diff changeset
  7015
    ].
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7016
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7017
    fn := aClassLibraryName asFilename withSuffix:(ObjectFileLoader sharedLibrarySuffix).
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7018
    fn := fn pathName.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7019
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7020
    path := self getBinaryFileName:fn.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7021
    path isNil ifTrue:[
24405
1cd295707fd7 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24376
diff changeset
  7022
        path := self getSystemFileName:fn.
16144
3bde1ed36852 class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 16132
diff changeset
  7023
    ].
3bde1ed36852 class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 16132
diff changeset
  7024
    path isNil ifTrue:[
24405
1cd295707fd7 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24376
diff changeset
  7025
        ^ (PackageNotFoundError raiseRequestWith:aClassLibraryName) ? false.
16144
3bde1ed36852 class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 16132
diff changeset
  7026
    ].
3bde1ed36852 class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 16132
diff changeset
  7027
3bde1ed36852 class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 16132
diff changeset
  7028
    (ObjectFileLoader loadObjectFile:path) isNil ifTrue:[
24405
1cd295707fd7 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24376
diff changeset
  7029
        ^ (PackageLoadError raiseRequestWith:aClassLibraryName) ? false.
16144
3bde1ed36852 class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 16132
diff changeset
  7030
    ].
3bde1ed36852 class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 16132
diff changeset
  7031
    ^ true.
3bde1ed36852 class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 16132
diff changeset
  7032
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7033
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7034
     Smalltalk fileInClassLibrary:'libtable'
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7035
     Smalltalk fileInClassLibrary:'binary/libwidg3'
24405
1cd295707fd7 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24376
diff changeset
  7036
     Smalltalk fileInClassLibrary:'foo'
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7037
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7038
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7039
    "Modified: 8.1.1997 / 17:58:56 / cg"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7040
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7041
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7042
fileInClassLibrary:aClassLibraryName inPackage:packageID
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7043
    "find an object file containing a binary class library in some standard places
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7044
     and load it. This installs all of its contained classes.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7045
     Return true if ok, false if not.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7046
     Notice: the argument may not have an extension (by purpose);
23177
1f49ca31ecc8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 22955
diff changeset
  7047
             the sharedLib extension (.dll / .so / .sl) is added here, to
1f49ca31ecc8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 22955
diff changeset
  7048
             make the caller independent of the underlying operatingSystem."
11689
d08d5db473c5 Find windows DLLs under package\objbc in development environment
Stefan Vogel <sv@exept.de>
parents: 11681
diff changeset
  7049
11690
b48d486944fc fix for previous revision
Stefan Vogel <sv@exept.de>
parents: 11689
diff changeset
  7050
    |baseName handle libraryFilename packagePath|
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7051
16144
3bde1ed36852 class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 16132
diff changeset
  7052
    ObjectFileLoader isNil ifTrue:[
23177
1f49ca31ecc8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 22955
diff changeset
  7053
        ^ PackageLoadError raiseRequestWith:packageID errorString:' - no ObjectFileLoader'
16144
3bde1ed36852 class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 16132
diff changeset
  7054
    ].
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7055
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7056
    baseName := aClassLibraryName asFilename withSuffix:(ObjectFileLoader sharedLibrarySuffix).
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7057
    baseName exists ifTrue:[
23177
1f49ca31ecc8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 22955
diff changeset
  7058
        "/ load local file first...
1f49ca31ecc8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 22955
diff changeset
  7059
        handle := ObjectFileLoader loadObjectFile:baseName.
12744
80f6da0fee57 changed: #fileInClassLibrary:inPackage:
Claus Gittinger <cg@exept.de>
parents: 12700
diff changeset
  7060
    ].
80f6da0fee57 changed: #fileInClassLibrary:inPackage:
Claus Gittinger <cg@exept.de>
parents: 12700
diff changeset
  7061
    handle isNil ifTrue:[
23177
1f49ca31ecc8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 22955
diff changeset
  7062
        packagePath := self getPackageDirectoryForPackage:packageID.
1f49ca31ecc8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 22955
diff changeset
  7063
        packagePath isNil ifTrue:[
1f49ca31ecc8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 22955
diff changeset
  7064
            ^ PackageNotFoundError raiseRequestWith:packageID.
1f49ca31ecc8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 22955
diff changeset
  7065
        ].
1f49ca31ecc8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 22955
diff changeset
  7066
        libraryFilename := ObjectFileLoader binaryClassFilenameForPackage:packageID inDirectory:packagePath.    
1f49ca31ecc8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 22955
diff changeset
  7067
        (libraryFilename notNil and:[libraryFilename exists]) ifTrue:[
1f49ca31ecc8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 22955
diff changeset
  7068
            handle := ObjectFileLoader loadObjectFile:libraryFilename pathName.
1f49ca31ecc8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 22955
diff changeset
  7069
        ].
16144
3bde1ed36852 class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 16132
diff changeset
  7070
    ].
3bde1ed36852 class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 16132
diff changeset
  7071
3bde1ed36852 class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 16132
diff changeset
  7072
    handle isNil ifTrue:[
23177
1f49ca31ecc8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 22955
diff changeset
  7073
        ^ PackageNotFoundError raiseRequestWith:packageID.
16144
3bde1ed36852 class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 16132
diff changeset
  7074
    ].
12744
80f6da0fee57 changed: #fileInClassLibrary:inPackage:
Claus Gittinger <cg@exept.de>
parents: 12700
diff changeset
  7075
"/    handle notNil ifTrue:[
80f6da0fee57 changed: #fileInClassLibrary:inPackage:
Claus Gittinger <cg@exept.de>
parents: 12700
diff changeset
  7076
"/        Transcript showCR:('    Smalltalk: loaded %1.' bindWith:libraryFilename pathName).
80f6da0fee57 changed: #fileInClassLibrary:inPackage:
Claus Gittinger <cg@exept.de>
parents: 12700
diff changeset
  7077
"/    ].
16144
3bde1ed36852 class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 16132
diff changeset
  7078
    ^ true.
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7079
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7080
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7081
     Smalltalk fileInClassLibrary:'libtable'
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7082
     Smalltalk fileInClassLibrary:'binary/libwidg3'
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7083
     Smalltalk fileInClassLibrary:'refactoryBrowser' inPackage:'stx:goodies/refactoryBrowser'
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7084
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7085
13787
1695a24d0fa7 changed: #fileInClassLibrary:inPackage:
Claus Gittinger <cg@exept.de>
parents: 13785
diff changeset
  7086
    "Modified: / 08-10-2011 / 00:08:51 / cg"
23177
1f49ca31ecc8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 22955
diff changeset
  7087
    "Modified: / 02-07-2018 / 14:19:16 / Stefan Vogel"
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7088
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7089
15073
e243aaa87bdf class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 15068
diff changeset
  7090
fileInSourceFile:filenameArg lazy:loadLazy silent:beSilent
18560
a37464a68e70 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 18385
diff changeset
  7091
    "Try all available programming languages for a matching suffix"
13415
ba3e5e6dd910 Jan's changes
vrany
parents: 13385
diff changeset
  7092
15073
e243aaa87bdf class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 15068
diff changeset
  7093
    |filename|
e243aaa87bdf class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 15068
diff changeset
  7094
e243aaa87bdf class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 15068
diff changeset
  7095
    filename := filenameArg asFilename.
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  7096
"/    ProgrammingLanguage allDo:[:lang|
18572
b088a44b9681 \"/ revert to old code to get stuff running again- please review - (autoload problems)
Michael Beyl <mb@exept.de>
parents: 18560
diff changeset
  7097
"/        | f |
b088a44b9681 \"/ revert to old code to get stuff running again- please review - (autoload problems)
Michael Beyl <mb@exept.de>
parents: 18560
diff changeset
  7098
"/
21338
82931ca66d88 #OTHER by mawalch
mawalch
parents: 21265
diff changeset
  7099
"/        "/ cg: changed: did try all languages to load (eg. whether suffix matched or not.
18572
b088a44b9681 \"/ revert to old code to get stuff running again- please review - (autoload problems)
Michael Beyl <mb@exept.de>
parents: 18560
diff changeset
  7100
"/        "/ I don't think, that is a good idea, as all of them languages might start parsing...
b088a44b9681 \"/ revert to old code to get stuff running again- please review - (autoload problems)
Michael Beyl <mb@exept.de>
parents: 18560
diff changeset
  7101
"/        (filename hasSuffix:lang sourceFileSuffix) ifTrue:[
b088a44b9681 \"/ revert to old code to get stuff running again- please review - (autoload problems)
Michael Beyl <mb@exept.de>
parents: 18560
diff changeset
  7102
"/            (self fileIn:f lazy:loadLazy silent:beSilent) ifTrue:[
b088a44b9681 \"/ revert to old code to get stuff running again- please review - (autoload problems)
Michael Beyl <mb@exept.de>
parents: 18560
diff changeset
  7103
"/                ^ true
b088a44b9681 \"/ revert to old code to get stuff running again- please review - (autoload problems)
Michael Beyl <mb@exept.de>
parents: 18560
diff changeset
  7104
"/            ].
b088a44b9681 \"/ revert to old code to get stuff running again- please review - (autoload problems)
Michael Beyl <mb@exept.de>
parents: 18560
diff changeset
  7105
"/        ]
b088a44b9681 \"/ revert to old code to get stuff running again- please review - (autoload problems)
Michael Beyl <mb@exept.de>
parents: 18560
diff changeset
  7106
"/    ].
b088a44b9681 \"/ revert to old code to get stuff running again- please review - (autoload problems)
Michael Beyl <mb@exept.de>
parents: 18560
diff changeset
  7107
"/ revert to old code to get stuff running again- please review - (autoload problems)
b088a44b9681 \"/ revert to old code to get stuff running again- please review - (autoload problems)
Michael Beyl <mb@exept.de>
parents: 18560
diff changeset
  7108
    ProgrammingLanguage allDo:[:lang| | f |
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7109
	f := (filename hasSuffix:lang sourceFileSuffix)
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7110
		    ifTrue:[filename]
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7111
		    ifFalse:[filename addSuffix:lang sourceFileSuffix].
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7112
	(self fileIn:f lazy:loadLazy silent:beSilent)
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7113
		ifTrue:[^ true]
18572
b088a44b9681 \"/ revert to old code to get stuff running again- please review - (autoload problems)
Michael Beyl <mb@exept.de>
parents: 18560
diff changeset
  7114
    ].
b088a44b9681 \"/ revert to old code to get stuff running again- please review - (autoload problems)
Michael Beyl <mb@exept.de>
parents: 18560
diff changeset
  7115
15073
e243aaa87bdf class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 15068
diff changeset
  7116
    ^ false
13415
ba3e5e6dd910 Jan's changes
vrany
parents: 13385
diff changeset
  7117
ba3e5e6dd910 Jan's changes
vrany
parents: 13385
diff changeset
  7118
    "Created: / 16-08-2009 / 14:45:41 / Jan Vrany <vranyj1@fel.cvut.cz>"
ba3e5e6dd910 Jan's changes
vrany
parents: 13385
diff changeset
  7119
!
ba3e5e6dd910 Jan's changes
vrany
parents: 13385
diff changeset
  7120
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7121
fileInStream:streamArg
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7122
    ^ self fileInStream:streamArg lazy:nil silent:nil logged:false addPath:nil
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7123
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7124
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7125
fileInStream:streamArg lazy:lazy silent:silent logged:logged addPath:morePath
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7126
    "read sourceCode from aStream;
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7127
     return true if ok, false if failed.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7128
     If lazy is true, no code is generated for methods, instead stubs
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7129
     are created which compile themself when first executed. This allows
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7130
     for much faster fileIn (but slows down the first execution later).
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7131
     Since no syntax checks are done when doing lazy fileIn, use this only for
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7132
     code which is known to be syntactically correct.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7133
     If silent is true, no compiler messages are output to the transcript.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7134
     Giving nil for silent/lazy will use the current settings.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7135
     If morePath is nonNil, it is prepended to the systemPath temporarily during the
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7136
     fileIn. This allows for st-expressions to refer to more files (i.e. fileIn more)
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7137
     using a relative path."
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7138
11427
ac373ee02301 refactored
Claus Gittinger <cg@exept.de>
parents: 11400
diff changeset
  7139
    |inStream wasLazy wasSilent oldSystemPath oldRealPath|
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7140
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7141
    inStream := streamArg.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7142
    inStream isNil ifTrue:[^ false].
19385
0c655478e4bd #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19187
diff changeset
  7143
    inStream isLineNumberReadStream ifFalse:[
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7144
	LineNumberReadStream notNil ifTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7145
	    "/ sigh - is in libbasic2, which is not always present
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7146
	    inStream := LineNumberReadStream on:inStream.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7147
	].
19385
0c655478e4bd #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19187
diff changeset
  7148
    ].
21458
f9ff2c1811fd #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 21443
diff changeset
  7149
    inStream := EncodedStream decodedStreamFor:inStream.
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7150
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7151
    lazy notNil ifTrue:[wasLazy := Compiler compileLazy:lazy].
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7152
    silent notNil ifTrue:[wasSilent := self silentLoading:silent].
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7153
    morePath notNil ifTrue:[
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7154
	oldSystemPath := SystemPath copy.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7155
	SystemPath addFirst:morePath.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7156
	oldRealPath := RealSystemPath.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7157
	RealSystemPath := nil.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7158
    ].
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7159
22703
d4218cffd69d #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 22691
diff changeset
  7160
    ^ [
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7161
	(Class updateChangeFileQuerySignal , Class updateChangeListQuerySignal) answer:logged do:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7162
	    "JV: Changed to give ProgrammingLanguage to choose
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7163
	     proper reader"
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7164
	    ((ProgrammingLanguage forStream: inStream) fileInStream: inStream) ~~ #Error
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7165
	]
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7166
    ] ensure:[
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7167
	morePath notNil ifTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7168
	    "take care, someone could have changed SystemPath during fileIn!!"
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7169
	    (SystemPath copyFrom:2) = oldSystemPath ifTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7170
		SystemPath := oldSystemPath.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7171
		RealSystemPath := oldRealPath.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7172
	    ] ifFalse:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7173
		(oldSystemPath includes:morePath) ifFalse:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7174
		    SystemPath remove:morePath ifAbsent:[].
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7175
		].
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7176
		RealSystemPath := nil.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7177
	    ].
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7178
	].
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7179
	lazy notNil ifTrue:[Compiler compileLazy:wasLazy].
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7180
	silent notNil ifTrue:[self silentLoading:wasSilent].
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7181
	inStream close
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7182
    ].
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7183
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7184
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7185
     Smalltalk fileInStream:('source/TicTacToe.st' asFilename readStream) lazy:true silent:true
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7186
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7187
13415
ba3e5e6dd910 Jan's changes
vrany
parents: 13385
diff changeset
  7188
    "Modified: / 05-11-1996 / 20:03:35 / cg"
ba3e5e6dd910 Jan's changes
vrany
parents: 13385
diff changeset
  7189
    "Modified: / 16-08-2009 / 11:06:05 / Jan Vrany <vranyj1@fel.cvut.cz>"
22706
5f1633e2dde7 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 22705
diff changeset
  7190
    "Modified: / 24-04-2018 / 23:50:22 / stefan"
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7191
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7192
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7193
isClassLibraryLoaded:name
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7194
    "return true, if a particular class library is already loaded"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7195
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7196
    ObjectMemory
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  7197
	binaryModuleInfo
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  7198
	    do:[:entry |
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  7199
		   entry type == #classLibrary ifTrue:[
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  7200
		       entry libraryName = name ifTrue:[
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  7201
			  ^ true        "/ already loaded
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  7202
		       ]
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  7203
		   ].
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  7204
	       ].
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7205
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7206
    ^ false
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7207
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7208
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7209
     Smalltalk isClassLibraryLoaded:'libstx_libbasic'
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7210
     Smalltalk isClassLibraryLoaded:'libstx_libwidg3'
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7211
     Smalltalk isClassLibraryLoaded:'libstx_libboss'
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7212
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7213
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7214
    "Modified: / 23-08-2006 / 15:54:46 / cg"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7215
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7216
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7217
loadClassLibraryIfAbsent:name
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7218
    "dynamically load a classLibrary, if not already loaded
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7219
     and the system supports dynamic loading.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7220
     Return true, if the library is loaded, false if not.
24405
1cd295707fd7 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24376
diff changeset
  7221
     Changed to raise an error if not ok (i.e. only returns false if the error is proceeded)
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7222
     This entry is called without system specific filename
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7223
     extensions - it is portable among different architectures
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7224
     as long as corresponding files (x.so / x.dll / x.sl / x.o)
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7225
     are be present ..."
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7226
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7227
    (self isClassLibraryLoaded:name) ifTrue:[ ^ true ].  "/ already loaded
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7228
    ^ self fileInClassLibrary:name
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7229
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7230
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7231
     Smalltalk loadClassLibraryIfAbsent:'libbasic'
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7232
     Smalltalk loadClassLibraryIfAbsent:'libwidg3'
24405
1cd295707fd7 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24376
diff changeset
  7233
     Smalltalk loadClassLibraryIfAbsent:'foo'
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7234
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7235
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7236
    "Modified: 31.10.1996 / 16:57:24 / cg"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7237
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7238
13323
68e5bb82f5f7 changed: #loadPackage:fromClassLibrary:
Stefan Vogel <sv@exept.de>
parents: 13303
diff changeset
  7239
secureFileIn:aFileName
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7240
    "read in the named file, looking for it at standard places.
13323
68e5bb82f5f7 changed: #loadPackage:fromClassLibrary:
Stefan Vogel <sv@exept.de>
parents: 13303
diff changeset
  7241
     Catch various errors during fileIn.
13000
28bd279e2574 changed: #secureFileIn:
Stefan Vogel <sv@exept.de>
parents: 12919
diff changeset
  7242
     Return true if ok, false if failed"
13323
68e5bb82f5f7 changed: #loadPackage:fromClassLibrary:
Stefan Vogel <sv@exept.de>
parents: 13303
diff changeset
  7243
22691
df53ad43691d #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 22679
diff changeset
  7244
    Parser isNil ifTrue:[
23588
3d22aa7327b0 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 23470
diff changeset
  7245
        ^ false         "/ for small stand alone apps.
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7246
    ].
22691
df53ad43691d #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 22679
diff changeset
  7247
df53ad43691d #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 22679
diff changeset
  7248
    ^ (SignalSet
23588
3d22aa7327b0 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 23470
diff changeset
  7249
        with:AbortOperationRequest
3d22aa7327b0 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 23470
diff changeset
  7250
        with:TerminateProcessRequest
3d22aa7327b0 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 23470
diff changeset
  7251
        with:ParseError)
3d22aa7327b0 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 23470
diff changeset
  7252
            handle:[:ex | 
3d22aa7327b0 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 23470
diff changeset
  7253
                ex creator == ParseError ifTrue:[
3d22aa7327b0 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 23470
diff changeset
  7254
                    Logger info:'ParseError in line %1: %2' with:ex lineNumber with:ex description.
3d22aa7327b0 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 23470
diff changeset
  7255
                ].
3d22aa7327b0 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 23470
diff changeset
  7256
                ex return:false 
3d22aa7327b0 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 23470
diff changeset
  7257
            ]
3d22aa7327b0 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 23470
diff changeset
  7258
            do:[ self fileIn:aFileName ].
22691
df53ad43691d #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 22679
diff changeset
  7259
df53ad43691d #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 22679
diff changeset
  7260
    "Modified: / 23-04-2018 / 16:53:29 / stefan"
23588
3d22aa7327b0 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 23470
diff changeset
  7261
    "Modified: / 25-12-2018 / 10:23:40 / Claus Gittinger"
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7262
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7263
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7264
silentFileIn:aFilename
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7265
    "same as fileIn:, but do not output 'compiled...'-messages on Transcript.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7266
     Main use is during startup."
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7267
22691
df53ad43691d #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 22679
diff changeset
  7268
    ^ self silentlyLoadingDo:[
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7269
	self fileIn:aFilename
22691
df53ad43691d #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 22679
diff changeset
  7270
    ].
df53ad43691d #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 22679
diff changeset
  7271
df53ad43691d #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 22679
diff changeset
  7272
    "Modified: / 23-04-2018 / 16:57:17 / stefan"
3044
a0bbac91639b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3033
diff changeset
  7273
! !
a0bbac91639b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3033
diff changeset
  7274
a0bbac91639b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3033
diff changeset
  7275
!Smalltalk class methodsFor:'system management-files'!
a0bbac91639b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3033
diff changeset
  7276
20663
0c2ac3c3937e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 20640
diff changeset
  7277
addIdeTopDirectoryToPackagePath
0c2ac3c3937e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 20640
diff changeset
  7278
    "{ Pragma: +optSpace }"
0c2ac3c3937e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 20640
diff changeset
  7279
0c2ac3c3937e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 20640
diff changeset
  7280
    |topDirectory|
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7281
20663
0c2ac3c3937e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 20640
diff changeset
  7282
    (topDirectory := OperatingSystem pathOfSTXExecutable) notNil ifTrue:[
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7283
	topDirectory := topDirectory asFilename.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7284
	(topDirectory directory / 'stc') exists ifTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7285
	    topDirectory := topDirectory directory.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7286
	] ifFalse:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7287
	    (topDirectory directory directory / 'stc') exists ifTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7288
		topDirectory := topDirectory directory directory.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7289
	    ] ifFalse:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7290
		(topDirectory directory directory directory / 'stc') exists ifTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7291
		    topDirectory := topDirectory directory directory directory.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7292
		] ifFalse:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7293
		    topDirectory := nil
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7294
		].
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7295
	    ].
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7296
	].
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7297
	topDirectory notNil ifTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7298
	    "/ one above "stx"
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7299
	    topDirectory := topDirectory directory pathName.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7300
	    (PackagePath includes:topDirectory) ifFalse:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7301
		PackagePath add:topDirectory
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7302
	    ]
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7303
	]
20663
0c2ac3c3937e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 20640
diff changeset
  7304
    ].
0c2ac3c3937e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 20640
diff changeset
  7305
!
0c2ac3c3937e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 20640
diff changeset
  7306
18868
0856cde0eaa4 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18794
diff changeset
  7307
addWorkspaceDirectoryToPackagePath
0856cde0eaa4 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18794
diff changeset
  7308
    "{ Pragma: +optSpace }"
0856cde0eaa4 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18794
diff changeset
  7309
0856cde0eaa4 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18794
diff changeset
  7310
    |workspaceDirectory|
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7311
18868
0856cde0eaa4 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18794
diff changeset
  7312
    (workspaceDirectory := UserPreferences current workspaceDirectory) notNil ifTrue:[
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7313
	(workspaceDirectory := workspaceDirectory asFilename) exists ifTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7314
	    workspaceDirectory := workspaceDirectory pathName.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7315
	    (PackagePath includes:workspaceDirectory) ifFalse:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7316
		PackagePath addFirst:workspaceDirectory
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7317
	    ]
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7318
	]
18868
0856cde0eaa4 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18794
diff changeset
  7319
    ].
0856cde0eaa4 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18794
diff changeset
  7320
!
0856cde0eaa4 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18794
diff changeset
  7321
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7322
bitmapFileStreamFor:aFileName
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7323
    "search aFileName in some standard places;
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7324
     return a readonly fileStream or nil if not found.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7325
     Searches in subdirectories named 'bitmaps' in the SystemPath.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7326
     Notice: this does not look in the package-specific bitmaps directories."
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7327
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7328
    |aString|
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7329
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7330
    aString := self getBitmapFileName:aFileName.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7331
    aString notNil ifTrue:[
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  7332
	^ aString asFilename readStreamOrNil
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7333
    ].
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7334
    ^ nil
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7335
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7336
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7337
bitmapFromFileNamed:aFileName forClass:aClass
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7338
    "backward compatibility:
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7339
     search aFileName in some standard places:
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7340
     first in the redefinable bitmaps path,
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7341
     then in the classes own package directory if existing.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7342
     Return an image or nil."
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7343
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7344
    ^ self imageFromFileNamed:aFileName forClass:aClass
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7345
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7346
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7347
     Smalltalk bitmapFromFileNamed:'SmalltalkX.xbm' forClass:View
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7348
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7349
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7350
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7351
bitmapFromFileNamed:aFileName inPackage:aPackage
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7352
    "backward compatibility:
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7353
     search aFileName in some standard places:
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7354
     first in the redefinable bitmaps path,
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7355
     then in the package directory if existing.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7356
     Return an image or nil."
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7357
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7358
    ^ self imageFromFileNamed:aFileName inPackage:aPackage
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7359
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7360
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7361
     Smalltalk bitmapFromFileNamed:'SmalltalkX.xbm' inPackage:'stx:libview'
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7362
     Smalltalk bitmapFromFileNamed:'SmalltalkX.xbm' inPackage:'stx:libtool'
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7363
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7364
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7365
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7366
classNameForFile:aFileName
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7367
    "return the className which corresponds to an abbreviated fileName,
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7368
     or nil if no special translation applies. The given filename arg may
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7369
     include a '.st' suffix (but no other)."
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7370
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7371
    |fn|
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7372
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7373
    (aFileName asFilename hasSuffix:'st') ifTrue:[
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  7374
	fn := aFileName copyButLast:3
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7375
    ] ifFalse:[
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  7376
	fn := aFileName
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7377
    ].
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7378
    ^ self filenameAbbreviations keyAtEqualValue:fn ifAbsent:[fn].
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7379
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7380
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7381
     Smalltalk classNameForFile:'DrawObj'
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7382
     Smalltalk classNameForFile:'DrawObj.st'
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7383
     Smalltalk classNameForFile:'ArrColl.st'
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7384
     Smalltalk classNameForFile:'ArrColl.chg'
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7385
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7386
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7387
    "Modified: 11.12.1995 / 14:51:10 / cg"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7388
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7389
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7390
constructPathFor:aDirectoryName
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7391
    "search for aDirectory in SystemPath;
20294
dc408807328e #OTHER by mawalch
mawalch
parents: 20207
diff changeset
  7392
     return a collection of paths which include that directory."
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7393
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7394
    ^ self realSystemPath select:[:dirName |
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7395
	|fullPath|
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7396
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7397
	fullPath := dirName asFilename construct:aDirectoryName.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7398
	"/ fullPath exists and:[fullPath isDirectory and:[fullPath isReadable]]
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7399
	fullPath isDirectory and:[fullPath isReadable]
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7400
    ].
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7401
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7402
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7403
fileInFileStreamFor:aFileName
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7404
    "obsolete
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7405
     search aFileName in some standard places;
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7406
     return a readonly fileStream or nil if not found.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7407
     Searches in subdirectories named 'fileIn' in SystemPath"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7408
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7409
    |aString|
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7410
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7411
    aString := self getFileInFileName:aFileName.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7412
    aString notNil ifTrue:[
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  7413
	^ aString asFilename readStreamOrNil
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  7414
    ].
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  7415
    ^ nil
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  7416
!
7758
526f0a3a74a4 *** empty log message ***
penk
parents: 7757
diff changeset
  7417
12022
205ac90337cc oops- fileNameForClass
Claus Gittinger <cg@exept.de>
parents: 12019
diff changeset
  7418
fileNameForClass:aClassOrClassName
205ac90337cc oops- fileNameForClass
Claus Gittinger <cg@exept.de>
parents: 12019
diff changeset
  7419
    "return a actual or expected (or most wanted) filename for aClassOrClassName
205ac90337cc oops- fileNameForClass
Claus Gittinger <cg@exept.de>
parents: 12019
diff changeset
  7420
     - only the base name (without directory part) and without suffix."
205ac90337cc oops- fileNameForClass
Claus Gittinger <cg@exept.de>
parents: 12019
diff changeset
  7421
15958
fd69e4694d91 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15872
diff changeset
  7422
    |cls nonMetaclass nm nameWithPrefix nameWithoutPrefix compatQuery compatPkg |
12022
205ac90337cc oops- fileNameForClass
Claus Gittinger <cg@exept.de>
parents: 12019
diff changeset
  7423
12301
5d077b04f6f0 changed: #fileNameForClass:
fm
parents: 12300
diff changeset
  7424
"/  This was added as an extension of libsvn - should be no longer needed
15958
fd69e4694d91 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15872
diff changeset
  7425
"/  JV@2012-09-25: but it actually is. The problem is that class filename
fd69e4694d91 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15872
diff changeset
  7426
"/  is stored in the class itself and used to generate abbrev.stc and
fd69e4694d91 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15872
diff changeset
  7427
"/  prerequisites in makefiles. But if you renamed such a stc-compiled class,
fd69e4694d91 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15872
diff changeset
  7428
"/  the filename remains the same, but SVN __ALWAYS__ keep container name
fd69e4694d91 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15872
diff changeset
  7429
"/  and class name in sync. Therefore build files gets messed up. Indeed, this
fd69e4694d91 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15872
diff changeset
  7430
"/  should be fixed in code that files-out the package and generates build files.
fd69e4694d91 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15872
diff changeset
  7431
"/  Certainly a hack, but do not remove this until fixed elsewhere
fd69e4694d91 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15872
diff changeset
  7432
23414
c10ead3a5a86 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23408
diff changeset
  7433
    compatQuery := #'SVN::CompatModeQuery' asClassIfAbsent:nil.
15958
fd69e4694d91 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15872
diff changeset
  7434
    (compatQuery notNil
fd69e4694d91 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15872
diff changeset
  7435
      and:[compatQuery isLoaded
23414
c10ead3a5a86 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23408
diff changeset
  7436
        and:[compatQuery query not]]) ifTrue:[
c10ead3a5a86 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23408
diff changeset
  7437
            nm := aClassOrClassName isBehavior
c10ead3a5a86 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23408
diff changeset
  7438
                ifTrue:[aClassOrClassName name]
c10ead3a5a86 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23408
diff changeset
  7439
                ifFalse:[aClassOrClassName].
c10ead3a5a86 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23408
diff changeset
  7440
            nm := nm copyReplaceAll:$: with:$_ ifNone:nm.
c10ead3a5a86 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23408
diff changeset
  7441
            ^nm
15958
fd69e4694d91 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15872
diff changeset
  7442
    ].
fd69e4694d91 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15872
diff changeset
  7443
16122
18c865388947 Fix in Smalltalk>>#fileNameForClass: - required by libscm to support nested packages.
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 16117
diff changeset
  7444
    "/ Same for another query for new libscm. Here we have to do
18c865388947 Fix in Smalltalk>>#fileNameForClass: - required by libscm to support nested packages.
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 16117
diff changeset
  7445
    "/ this only for packages that are being filed out and NOT for others.
18c865388947 Fix in Smalltalk>>#fileNameForClass: - required by libscm to support nested packages.
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 16117
diff changeset
  7446
    "/ The problem is that this method is also used for getting filenames
18c865388947 Fix in Smalltalk>>#fileNameForClass: - required by libscm to support nested packages.
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 16117
diff changeset
  7447
    "/ of classes OUTSIDE filed-out package when generating makefile dependencies.
23414
c10ead3a5a86 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23408
diff changeset
  7448
    compatQuery := #'SCMCompatModeQuery' asClassIfAbsent:nil.
15958
fd69e4694d91 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15872
diff changeset
  7449
    (compatQuery notNil
fd69e4694d91 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15872
diff changeset
  7450
      and:[compatQuery isLoaded
23414
c10ead3a5a86 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23408
diff changeset
  7451
        and:[(compatPkg := compatQuery query) notNil]]) ifTrue:[
c10ead3a5a86 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23408
diff changeset
  7452
            | compatPkgs |
c10ead3a5a86 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23408
diff changeset
  7453
            "/ Originally libscm could only fileout one package at time so
c10ead3a5a86 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23408
diff changeset
  7454
            "/ the query answered one package name. However, to support nested
c10ead3a5a86 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23408
diff changeset
  7455
            "/ packages, libscm is being rewritten to commit multiple packages
c10ead3a5a86 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23408
diff changeset
  7456
            "/ at once, so query answers a collection of packages. The code below
c10ead3a5a86 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23408
diff changeset
  7457
            "/ makes sure it works for both.
c10ead3a5a86 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23408
diff changeset
  7458
            compatPkgs := compatPkg isString ifTrue:[ Array with: compatPkg] ifFalse:[ compatPkg ].
c10ead3a5a86 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23408
diff changeset
  7459
            nm := aClassOrClassName isBehavior
c10ead3a5a86 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23408
diff changeset
  7460
                ifTrue:[aClassOrClassName name]
c10ead3a5a86 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23408
diff changeset
  7461
                ifFalse:[aClassOrClassName].
c10ead3a5a86 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23408
diff changeset
  7462
            cls := Smalltalk at: nm asSymbol.
c10ead3a5a86 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23408
diff changeset
  7463
            (cls notNil and:[compatPkgs includes: cls package]) ifTrue:[
c10ead3a5a86 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23408
diff changeset
  7464
                nm := nm copyReplaceAll:$: with:$_.
c10ead3a5a86 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23408
diff changeset
  7465
                ^nm
c10ead3a5a86 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23408
diff changeset
  7466
            ].
15958
fd69e4694d91 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15872
diff changeset
  7467
    ].
12301
5d077b04f6f0 changed: #fileNameForClass:
fm
parents: 12300
diff changeset
  7468
12022
205ac90337cc oops- fileNameForClass
Claus Gittinger <cg@exept.de>
parents: 12019
diff changeset
  7469
    aClassOrClassName isBehavior ifTrue:[
23414
c10ead3a5a86 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23408
diff changeset
  7470
        cls := aClassOrClassName.
12022
205ac90337cc oops- fileNameForClass
Claus Gittinger <cg@exept.de>
parents: 12019
diff changeset
  7471
    ] ifFalse:[
23414
c10ead3a5a86 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23408
diff changeset
  7472
        cls := Smalltalk classNamed:aClassOrClassName.
c10ead3a5a86 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23408
diff changeset
  7473
        cls isNil ifTrue:[
c10ead3a5a86 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23408
diff changeset
  7474
            nameWithPrefix := aClassOrClassName.
c10ead3a5a86 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23408
diff changeset
  7475
            nameWithoutPrefix := (aClassOrClassName copyFrom:(aClassOrClassName lastIndexOf:$:)+1).
c10ead3a5a86 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23408
diff changeset
  7476
        ].
12022
205ac90337cc oops- fileNameForClass
Claus Gittinger <cg@exept.de>
parents: 12019
diff changeset
  7477
    ].
205ac90337cc oops- fileNameForClass
Claus Gittinger <cg@exept.de>
parents: 12019
diff changeset
  7478
205ac90337cc oops- fileNameForClass
Claus Gittinger <cg@exept.de>
parents: 12019
diff changeset
  7479
    cls notNil ifTrue:[
23414
c10ead3a5a86 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23408
diff changeset
  7480
        nonMetaclass := cls theNonMetaclass.
c10ead3a5a86 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23408
diff changeset
  7481
        nm := nonMetaclass getClassFilename.
c10ead3a5a86 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23408
diff changeset
  7482
        nm isNil ifTrue:[
c10ead3a5a86 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23408
diff changeset
  7483
            |revisionInfo|
c10ead3a5a86 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23408
diff changeset
  7484
c10ead3a5a86 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23408
diff changeset
  7485
            (revisionInfo := cls revisionInfo) notNil ifTrue:[
c10ead3a5a86 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23408
diff changeset
  7486
                nm := revisionInfo fileName.
c10ead3a5a86 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23408
diff changeset
  7487
            ].
c10ead3a5a86 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23408
diff changeset
  7488
        ].
c10ead3a5a86 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23408
diff changeset
  7489
        nm notNil ifTrue:[
c10ead3a5a86 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23408
diff changeset
  7490
            ^ nm asFilename withoutSuffix baseName
c10ead3a5a86 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23408
diff changeset
  7491
        ].
c10ead3a5a86 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23408
diff changeset
  7492
        nameWithPrefix := nonMetaclass name.
c10ead3a5a86 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23408
diff changeset
  7493
        nameWithoutPrefix := nonMetaclass nameWithoutPrefix.
12022
205ac90337cc oops- fileNameForClass
Claus Gittinger <cg@exept.de>
parents: 12019
diff changeset
  7494
    ].
205ac90337cc oops- fileNameForClass
Claus Gittinger <cg@exept.de>
parents: 12019
diff changeset
  7495
205ac90337cc oops- fileNameForClass
Claus Gittinger <cg@exept.de>
parents: 12019
diff changeset
  7496
    CachedAbbreviations notNil ifTrue:[
23414
c10ead3a5a86 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23408
diff changeset
  7497
        nameWithPrefix := nameWithPrefix asSymbol.
c10ead3a5a86 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23408
diff changeset
  7498
        (CachedAbbreviations includesKey:nameWithPrefix) ifTrue:[
c10ead3a5a86 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23408
diff changeset
  7499
            ^ (CachedAbbreviations at:nameWithPrefix) asFilename baseName
c10ead3a5a86 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23408
diff changeset
  7500
        ].
c10ead3a5a86 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23408
diff changeset
  7501
        nameWithoutPrefix := nameWithoutPrefix asSymbol.
c10ead3a5a86 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23408
diff changeset
  7502
        (CachedAbbreviations includesKey:nameWithoutPrefix) ifTrue:[
c10ead3a5a86 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23408
diff changeset
  7503
            ^ (CachedAbbreviations at:nameWithoutPrefix) asFilename baseName
c10ead3a5a86 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23408
diff changeset
  7504
        ].
12022
205ac90337cc oops- fileNameForClass
Claus Gittinger <cg@exept.de>
parents: 12019
diff changeset
  7505
    ].
205ac90337cc oops- fileNameForClass
Claus Gittinger <cg@exept.de>
parents: 12019
diff changeset
  7506
205ac90337cc oops- fileNameForClass
Claus Gittinger <cg@exept.de>
parents: 12019
diff changeset
  7507
    ^ nameWithPrefix copyReplaceAll:$: with:$_
205ac90337cc oops- fileNameForClass
Claus Gittinger <cg@exept.de>
parents: 12019
diff changeset
  7508
205ac90337cc oops- fileNameForClass
Claus Gittinger <cg@exept.de>
parents: 12019
diff changeset
  7509
    "
205ac90337cc oops- fileNameForClass
Claus Gittinger <cg@exept.de>
parents: 12019
diff changeset
  7510
     Smalltalk fileNameForClass:#Complex
205ac90337cc oops- fileNameForClass
Claus Gittinger <cg@exept.de>
parents: 12019
diff changeset
  7511
     Smalltalk fileNameForClass:'SmallInteger'
205ac90337cc oops- fileNameForClass
Claus Gittinger <cg@exept.de>
parents: 12019
diff changeset
  7512
     Smalltalk fileNameForClass:'UnixOperatingSystem'
205ac90337cc oops- fileNameForClass
Claus Gittinger <cg@exept.de>
parents: 12019
diff changeset
  7513
     Smalltalk fileNameForClass:'Launcher'
205ac90337cc oops- fileNameForClass
Claus Gittinger <cg@exept.de>
parents: 12019
diff changeset
  7514
     Smalltalk fileNameForClass:'SomeUnknownClass'
205ac90337cc oops- fileNameForClass
Claus Gittinger <cg@exept.de>
parents: 12019
diff changeset
  7515
205ac90337cc oops- fileNameForClass
Claus Gittinger <cg@exept.de>
parents: 12019
diff changeset
  7516
     Smalltalk fileNameForClass:HTML::Encoder
205ac90337cc oops- fileNameForClass
Claus Gittinger <cg@exept.de>
parents: 12019
diff changeset
  7517
     Smalltalk fileNameForClass:OSI::FTAMOperation
205ac90337cc oops- fileNameForClass
Claus Gittinger <cg@exept.de>
parents: 12019
diff changeset
  7518
     Smalltalk fileNameForClass:'OSI::Foobar'
205ac90337cc oops- fileNameForClass
Claus Gittinger <cg@exept.de>
parents: 12019
diff changeset
  7519
     Smalltalk fileNameForClass:(Workflow::UnsuccessfulFinishReasons)
205ac90337cc oops- fileNameForClass
Claus Gittinger <cg@exept.de>
parents: 12019
diff changeset
  7520
     Workflow::UnsuccessfulFinishReasons classFilename
205ac90337cc oops- fileNameForClass
Claus Gittinger <cg@exept.de>
parents: 12019
diff changeset
  7521
    "
205ac90337cc oops- fileNameForClass
Claus Gittinger <cg@exept.de>
parents: 12019
diff changeset
  7522
205ac90337cc oops- fileNameForClass
Claus Gittinger <cg@exept.de>
parents: 12019
diff changeset
  7523
    "Modified: / 06-10-2006 / 16:16:01 / cg"
16122
18c865388947 Fix in Smalltalk>>#fileNameForClass: - required by libscm to support nested packages.
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 16117
diff changeset
  7524
    "Modified: / 23-02-2014 / 10:39:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
18c865388947 Fix in Smalltalk>>#fileNameForClass: - required by libscm to support nested packages.
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 16117
diff changeset
  7525
    "Modified (comment): / 23-02-2014 / 12:39:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
23414
c10ead3a5a86 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23408
diff changeset
  7526
    "Modified: / 10-10-2018 / 00:44:07 / Claus Gittinger"
12022
205ac90337cc oops- fileNameForClass
Claus Gittinger <cg@exept.de>
parents: 12019
diff changeset
  7527
!
205ac90337cc oops- fileNameForClass
Claus Gittinger <cg@exept.de>
parents: 12019
diff changeset
  7528
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7529
filenameAbbreviations
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7530
    "return a dictionary containing the classname-to-filename
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7531
     mappings. (needed for sys5.3 users, where filenames are limited
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7532
     to 14 chars)"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7533
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7534
    CachedAbbreviations isNil ifTrue:[
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  7535
	self readAbbreviations
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7536
    ].
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7537
    ^ CachedAbbreviations
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7538
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7539
    "flush with:
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7540
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7541
     CachedAbbreviations := nil
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7542
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7543
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7544
     Smalltalk filenameAbbreviations
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7545
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7546
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7547
13368
00d9e3385e76 class definition
Claus Gittinger <cg@exept.de>
parents: 13353
diff changeset
  7548
findPackageDirectoryForPackage:aPackage
00d9e3385e76 class definition
Claus Gittinger <cg@exept.de>
parents: 13353
diff changeset
  7549
    "find a packages directory along a number of standard places"
00d9e3385e76 class definition
Claus Gittinger <cg@exept.de>
parents: 13353
diff changeset
  7550
00d9e3385e76 class definition
Claus Gittinger <cg@exept.de>
parents: 13353
diff changeset
  7551
    |relDir|
00d9e3385e76 class definition
Claus Gittinger <cg@exept.de>
parents: 13353
diff changeset
  7552
00d9e3385e76 class definition
Claus Gittinger <cg@exept.de>
parents: 13353
diff changeset
  7553
    relDir := Smalltalk relativePackagePathForPackage:aPackage.
00d9e3385e76 class definition
Claus Gittinger <cg@exept.de>
parents: 13353
diff changeset
  7554
    relDir asFilename isAbsolute ifTrue:[^ relDir].
00d9e3385e76 class definition
Claus Gittinger <cg@exept.de>
parents: 13353
diff changeset
  7555
00d9e3385e76 class definition
Claus Gittinger <cg@exept.de>
parents: 13353
diff changeset
  7556
    ^ Smalltalk getPackageFileName:relDir.
00d9e3385e76 class definition
Claus Gittinger <cg@exept.de>
parents: 13353
diff changeset
  7557
00d9e3385e76 class definition
Claus Gittinger <cg@exept.de>
parents: 13353
diff changeset
  7558
    "
00d9e3385e76 class definition
Claus Gittinger <cg@exept.de>
parents: 13353
diff changeset
  7559
     Smalltalk findPackageDirectoryForPackage:'stx:libview/resources'
00d9e3385e76 class definition
Claus Gittinger <cg@exept.de>
parents: 13353
diff changeset
  7560
     Smalltalk findPackageDirectoryForPackage:'stx:libview'
00d9e3385e76 class definition
Claus Gittinger <cg@exept.de>
parents: 13353
diff changeset
  7561
    "
00d9e3385e76 class definition
Claus Gittinger <cg@exept.de>
parents: 13353
diff changeset
  7562
!
00d9e3385e76 class definition
Claus Gittinger <cg@exept.de>
parents: 13353
diff changeset
  7563
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7564
flushPathCaches
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7565
    "{ Pragma: +optSpace }"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7566
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7567
    "forget pathCaches - these are collections containing valid directory names,
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7568
     where system files (resource, bitmaps etc.) are found.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7569
     A flush is only required, if a new system directory has been created while
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7570
     the system is active, and those files should override the others
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7571
     (for example, if you created a private resource directory)"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7572
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7573
    RealSystemPath := ResourcePath := SourcePath :=
15332
cc2fb912d04c class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15315
diff changeset
  7574
    BinaryPath := FileInPath := nil.
cc2fb912d04c class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15315
diff changeset
  7575
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7576
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7577
     Smalltalk flushPathCaches
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7578
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7579
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7580
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7581
getBinaryFileName:aFileName
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7582
    "obsolete
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7583
     search aFileName in some standard places
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7584
     (subdirectories named 'binary' in SystemPath);
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7585
     return the absolute filename or nil if none is found."
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7586
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7587
    BinaryPath isNil ifTrue:[
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  7588
	BinaryPath := self constructPathFor:BinaryDirName
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7589
    ].
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7590
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7591
    ^ self searchPath:BinaryPath for:aFileName in:BinaryDirName
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7592
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7593
    "Modified: 18.7.1996 / 15:53:49 / cg"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7594
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7595
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7596
getBitmapFileName:aFileName
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7597
    "for backward compatibility:
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7598
     search aFileName in some standard places
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7599
     (subdirectories named 'bitmaps' in SystemPath);
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7600
     Return the pathName or nil if none is found."
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7601
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7602
    ^ self getBitmapFileName:aFileName forPackage:nil
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7603
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7604
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7605
     Smalltalk getBitmapFileName:'SBrowser.xbm'
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7606
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7607
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7608
    "Modified: 18.7.1996 / 15:53:55 / cg"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7609
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7610
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7611
getBitmapFileName:aFileName forPackage:aPackageIDOrNil
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7612
    "for backward compatibility.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7613
     search aFileName in some standard places:
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7614
     first in the redefinable bitmaps path,
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7615
     then in the package directory if existing.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7616
     Return a path or nil.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7617
     Search order is:
23433
247788b989f6 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23419
diff changeset
  7618
        bitmaps/<pkg>/file
247788b989f6 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23419
diff changeset
  7619
        resources/<pkg>/bitmaps/file
247788b989f6 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23419
diff changeset
  7620
        <pkg>/bitmaps/file
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7621
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7622
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7623
    |f dir packageDir pF|
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7624
15225
80d7f00bfcc0 refactored
Claus Gittinger <cg@exept.de>
parents: 15170
diff changeset
  7625
    f := aFileName asString withoutPrefix:'bitmaps/'.
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7626
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7627
    aPackageIDOrNil isNil ifTrue:[
23433
247788b989f6 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23419
diff changeset
  7628
        "/ this will be an error in the future
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7629
"/        'Smalltalk [warning]: bitmap file access without package: ' infoPrint. aFileName infoPrintCR.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7630
"/        self halt.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7631
23433
247788b989f6 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23419
diff changeset
  7632
        pF := self searchPath:(self realSystemPath) for:aFileName in:('bitmaps').
247788b989f6 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23419
diff changeset
  7633
        pF notNil ifTrue:[
247788b989f6 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23419
diff changeset
  7634
            ^ pF.
247788b989f6 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23419
diff changeset
  7635
        ].
247788b989f6 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23419
diff changeset
  7636
        f ~= aFileName ifTrue:[
247788b989f6 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23419
diff changeset
  7637
            pF := self searchPath:(self realSystemPath) for:f in:('bitmaps').
247788b989f6 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23419
diff changeset
  7638
            pF notNil ifTrue:[
247788b989f6 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23419
diff changeset
  7639
                ^ pF.
247788b989f6 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23419
diff changeset
  7640
            ].
247788b989f6 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23419
diff changeset
  7641
        ].
247788b989f6 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23419
diff changeset
  7642
        ^ nil
11077
14df4640ed89 image by package and filename access fixed
Claus Gittinger <cg@exept.de>
parents: 11057
diff changeset
  7643
    ].
14df4640ed89 image by package and filename access fixed
Claus Gittinger <cg@exept.de>
parents: 11057
diff changeset
  7644
14df4640ed89 image by package and filename access fixed
Claus Gittinger <cg@exept.de>
parents: 11057
diff changeset
  7645
    dir := self projectDirectoryForPackage:aPackageIDOrNil.
14df4640ed89 image by package and filename access fixed
Claus Gittinger <cg@exept.de>
parents: 11057
diff changeset
  7646
    dir notNil ifTrue:[
23433
247788b989f6 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23419
diff changeset
  7647
        pF := dir asFilename / f.
247788b989f6 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23419
diff changeset
  7648
        pF exists ifTrue:[
247788b989f6 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23419
diff changeset
  7649
            ^ pF.
247788b989f6 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23419
diff changeset
  7650
        ].
247788b989f6 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23419
diff changeset
  7651
        pF := dir asFilename / 'bitmaps' /f.
247788b989f6 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23419
diff changeset
  7652
        pF exists ifTrue:[
247788b989f6 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23419
diff changeset
  7653
            ^ pF.
247788b989f6 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23419
diff changeset
  7654
        ].
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7655
    ].
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7656
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7657
    packageDir := aPackageIDOrNil copyReplaceAll:$: with:$/.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7658
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7659
    pF := self searchPath:(self realSystemPath) for:aFileName in:('bitmaps/',packageDir).
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7660
    pF notNil ifTrue:[
23433
247788b989f6 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23419
diff changeset
  7661
        ^ pF.
247788b989f6 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23419
diff changeset
  7662
    ].
23446
994a3426acdb #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23445
diff changeset
  7663
    #('../Resources' '.resources' 'resources') do:[:eachPossibleRsrcDir |
994a3426acdb #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23445
diff changeset
  7664
        pF := self searchPath:(self realSystemPath) 
994a3426acdb #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23445
diff changeset
  7665
                   for:aFileName 
994a3426acdb #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23445
diff changeset
  7666
                   in:(eachPossibleRsrcDir,'/',packageDir,'/bitmaps').
994a3426acdb #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23445
diff changeset
  7667
        pF notNil ifTrue:[
994a3426acdb #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23445
diff changeset
  7668
            ^ pF.
994a3426acdb #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23445
diff changeset
  7669
        ].
994a3426acdb #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23445
diff changeset
  7670
    ].
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7671
    ^ nil
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7672
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7673
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7674
     Smalltalk imageFromFileNamed:'SmalltalkX.xbm' inPackage:'stx:libview'
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7675
     Smalltalk imageFromFileNamed:'SmalltalkX.xbm' inPackage:'stx:libtool'
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7676
     Smalltalk imageFromFileNamed:'bitmaps/gifImages/garfield.gif' inPackage:'stx:goodies'
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7677
     Smalltalk imageFromFileNamed:'CheckOn10_xp.xpm' inPackage:'stx:libwidg'
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7678
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7679
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7680
    "Modified: / 11-10-2006 / 13:53:18 / cg"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7681
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7682
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7683
getFileInFileName:aFileName
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7684
    "obsolete
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7685
     search aFileName in some standard places
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7686
     (subdirectories named 'fileIn' in SystemPath);
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7687
     return the absolute filename or nil if none is found."
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7688
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7689
    FileInPath isNil ifTrue:[
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  7690
	FileInPath := self constructPathFor:FileInDirName
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7691
    ].
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7692
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7693
    ^ self searchPath:FileInPath for:aFileName in:FileInDirName
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7694
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7695
    "Modified: 18.7.1996 / 15:53:59 / cg"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7696
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7697
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7698
getPackageDirectoryForPackage:aPackageID
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7699
    "search for a particular package; return its directory, or nil.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7700
     Stand alone applications might get nil, if there are only binaries installed."
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7701
19121
4b8d83dceb98 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19117
diff changeset
  7702
    |packageId checkForPackageDirectory module packageSubDirectory|
4b8d83dceb98 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19117
diff changeset
  7703
4b8d83dceb98 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19117
diff changeset
  7704
    packageId := aPackageID asPackageId.
4b8d83dceb98 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19117
diff changeset
  7705
    module := packageId module.
4b8d83dceb98 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19117
diff changeset
  7706
    packageSubDirectory := packageId directory.
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7707
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7708
    checkForPackageDirectory :=
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7709
	[:moduleDir |
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7710
	    |packageDir|
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7711
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7712
	    moduleDir isDirectory ifTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7713
		packageDir := moduleDir / packageSubDirectory.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7714
		packageDir isDirectory ifTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7715
		    ^ packageDir
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7716
		]
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7717
	    ].
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7718
	].
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7719
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7720
    self packagePath do:[:aPath |
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7721
	|moduleDir|
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7722
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7723
	moduleDir := aPath asFilename / module.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7724
	checkForPackageDirectory value:moduleDir.
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7725
    ].
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7726
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7727
    ^ nil
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7728
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7729
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7730
     Smalltalk getPackageDirectoryForPackage:(Array package)
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7731
     Smalltalk getPackageDirectoryForPackage:'stx:goodies/bitmaps'
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7732
     Smalltalk getPackageDirectoryForPackage:'stx:libview'
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7733
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7734
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7735
    "Modified: / 06-10-2006 / 11:49:27 / cg"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7736
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7737
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7738
getPackageFileName:aFileName
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7739
    "search aFileName in some standard places
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7740
     (packagePath and subdirectories named 'packages' in SystemPath);
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7741
     return the absolute filename or nil if none is found."
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7742
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7743
    |f|
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7744
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7745
    "/ search along packagePath ...
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7746
    f := self searchPath:self packagePath for:aFileName in:nil.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7747
    f isNil ifTrue:[
23450
704f8e20673d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23449
diff changeset
  7748
        "/ search under packages-directory along systemPath ...
704f8e20673d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23449
diff changeset
  7749
        f := self searchPath:self realSystemPath for:aFileName in:PackageDirName.
704f8e20673d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23449
diff changeset
  7750
        "/ kludge - allow for stx-directory to be named differently
704f8e20673d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23449
diff changeset
  7751
        f isNil ifTrue:[
704f8e20673d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23449
diff changeset
  7752
            (aFileName asString startsWith:('stx' , Filename separator)) ifTrue:[
704f8e20673d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23449
diff changeset
  7753
                f := '..' asFilename / '..' / (aFileName copyFrom:5).
704f8e20673d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23449
diff changeset
  7754
            ]
704f8e20673d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23449
diff changeset
  7755
        ].
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7756
    ].
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7757
    (f notNil and:[(f := f asFilename) exists]) ifTrue:[
23450
704f8e20673d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23449
diff changeset
  7758
        ^ f pathName
7758
526f0a3a74a4 *** empty log message ***
penk
parents: 7757
diff changeset
  7759
    ].
526f0a3a74a4 *** empty log message ***
penk
parents: 7757
diff changeset
  7760
    ^ nil
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7761
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7762
    "
16668
b88318df967d flush cached class resources AFTER reading the user preferences
Claus Gittinger <cg@exept.de>
parents: 16666
diff changeset
  7763
     Smalltalk getPackageFileName:'stx/libview/resources/normal.style'
b88318df967d flush cached class resources AFTER reading the user preferences
Claus Gittinger <cg@exept.de>
parents: 16666
diff changeset
  7764
     Smalltalk getPackageFileName:'stx/libview/styles/normal.style'
b88318df967d flush cached class resources AFTER reading the user preferences
Claus Gittinger <cg@exept.de>
parents: 16666
diff changeset
  7765
     Smalltalk getPackageFileName:'stx/libview/source.zip'
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7766
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7767
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7768
15074
32e78cd1a8af class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 15073
diff changeset
  7769
getPackageSourceFileName:filenameWithoutSuffixArg
13415
ba3e5e6dd910 Jan's changes
vrany
parents: 13385
diff changeset
  7770
    "search aFileName in some standard places and try all available languages"
ba3e5e6dd910 Jan's changes
vrany
parents: 13385
diff changeset
  7771
15074
32e78cd1a8af class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 15073
diff changeset
  7772
    |filenameWithoutSuffix|
32e78cd1a8af class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 15073
diff changeset
  7773
32e78cd1a8af class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 15073
diff changeset
  7774
    filenameWithoutSuffix:= filenameWithoutSuffixArg asFilename.
32e78cd1a8af class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 15073
diff changeset
  7775
16170
ca4d03def070 endOfDipatch if running scripts
Claus Gittinger <cg@exept.de>
parents: 16164
diff changeset
  7776
    ProgrammingLanguage
24376
746ce8c19ac4 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24136
diff changeset
  7777
        allDo:[:lang |
746ce8c19ac4 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24136
diff changeset
  7778
            |file|
746ce8c19ac4 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24136
diff changeset
  7779
746ce8c19ac4 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24136
diff changeset
  7780
            file := self getPackageFileName:(filenameWithoutSuffix addSuffix:lang sourceFileSuffix).
746ce8c19ac4 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24136
diff changeset
  7781
            file notNil ifTrue:[ ^ file ]
746ce8c19ac4 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24136
diff changeset
  7782
        ].
15074
32e78cd1a8af class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 15073
diff changeset
  7783
    ^ nil
13415
ba3e5e6dd910 Jan's changes
vrany
parents: 13385
diff changeset
  7784
ba3e5e6dd910 Jan's changes
vrany
parents: 13385
diff changeset
  7785
    "Created: / 16-08-2009 / 14:44:58 / Jan Vrany <vranyj1@fel.cvut.cz>"
24376
746ce8c19ac4 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24136
diff changeset
  7786
    "Modified (format): / 27-06-2019 / 12:32:39 / Claus Gittinger"
13415
ba3e5e6dd910 Jan's changes
vrany
parents: 13385
diff changeset
  7787
!
ba3e5e6dd910 Jan's changes
vrany
parents: 13385
diff changeset
  7788
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7789
getResourceFileName:aFileName
12547
30fda24cebb5 comment/format in: #getResourceFileName:forClass:
Claus Gittinger <cg@exept.de>
parents: 12539
diff changeset
  7790
    <resource: #obsolete>
30fda24cebb5 comment/format in: #getResourceFileName:forClass:
Claus Gittinger <cg@exept.de>
parents: 12539
diff changeset
  7791
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7792
    "search aFileName in some standard places
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7793
     (subdirectories named 'resources' in SystemPath);
12547
30fda24cebb5 comment/format in: #getResourceFileName:forClass:
Claus Gittinger <cg@exept.de>
parents: 12539
diff changeset
  7794
     return the absolute filename or nil if none is found.
30fda24cebb5 comment/format in: #getResourceFileName:forClass:
Claus Gittinger <cg@exept.de>
parents: 12539
diff changeset
  7795
     Obsolete: you must now provide a package argument."
30fda24cebb5 comment/format in: #getResourceFileName:forClass:
Claus Gittinger <cg@exept.de>
parents: 12539
diff changeset
  7796
30fda24cebb5 comment/format in: #getResourceFileName:forClass:
Claus Gittinger <cg@exept.de>
parents: 12539
diff changeset
  7797
    self obsoleteMethodWarning:'use getResourceFileName:forPackage:'.
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7798
    ^ self getResourceFileName:aFileName forPackage:nil
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7799
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7800
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7801
     Smalltalk getResourceFileName:'SystemBrowser.rs'
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7802
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7803
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7804
    "Modified: 18.7.1996 / 15:54:03 / cg"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7805
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7806
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7807
getResourceFileName:aFileName forClass:aClassOrNil
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7808
    "search aFileName in some standard places
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7809
     (subdirectories named 'resource' in SystemPath);
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7810
     and in aClasses package directory.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7811
     Return the absolute filename or nil if none is found."
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7812
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7813
    |pkgOrNil|
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7814
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7815
    aClassOrNil notNil ifTrue:[
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  7816
	pkgOrNil := aClassOrNil package.
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7817
    ].
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7818
    ^ self getResourceFileName:aFileName forPackage:pkgOrNil.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7819
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7820
    "
13323
68e5bb82f5f7 changed: #loadPackage:fromClassLibrary:
Stefan Vogel <sv@exept.de>
parents: 13303
diff changeset
  7821
     Smalltalk getResourceFileName:'de.rs' forClass:SystemBrowser
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7822
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7823
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7824
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7825
getResourceFileName:aFileName forPackage:aPackageIDOrNil
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7826
    "search aFileName in some standard places
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7827
     (subdirectories named 'resource' in SystemPath);
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7828
     and in a packages directory.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7829
     Return the absolute filename or nil if none is found.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7830
     Search order is:
23433
247788b989f6 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23419
diff changeset
  7831
        resources/<pkg>/file
247788b989f6 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23419
diff changeset
  7832
        <pkg>/resources/file
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7833
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7834
23467
f145dcf0e5e8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23462
diff changeset
  7835
    |pF f dir packageDir possibleResourceDirs|
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7836
15225
80d7f00bfcc0 refactored
Claus Gittinger <cg@exept.de>
parents: 15170
diff changeset
  7837
    f := aFileName asString withoutPrefix:'resources/'.
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7838
23467
f145dcf0e5e8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23462
diff changeset
  7839
    OperatingSystem isOSXlike ifTrue:[
f145dcf0e5e8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23462
diff changeset
  7840
        possibleResourceDirs := #('../Resources' '.resources' 'resources').
f145dcf0e5e8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23462
diff changeset
  7841
    ] ifFalse:[
f145dcf0e5e8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23462
diff changeset
  7842
        OperatingSystem isMSWINDOWSlike ifTrue:[
f145dcf0e5e8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23462
diff changeset
  7843
            possibleResourceDirs := #('resources').
f145dcf0e5e8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23462
diff changeset
  7844
        ] ifFalse:[
f145dcf0e5e8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23462
diff changeset
  7845
            possibleResourceDirs := #('.resources' 'resources').
f145dcf0e5e8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23462
diff changeset
  7846
        ].
f145dcf0e5e8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23462
diff changeset
  7847
    ].
f145dcf0e5e8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23462
diff changeset
  7848
    
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7849
    aPackageIDOrNil isNil ifTrue:[
23433
247788b989f6 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23419
diff changeset
  7850
        "/ this will be an error in the future
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7851
"/        'Smalltalk [warning]: resource file access without package: ' infoPrint. aFileName infoPrintCR.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7852
"/        self halt.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7853
23467
f145dcf0e5e8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23462
diff changeset
  7854
        possibleResourceDirs do:[:eachPossibleRsrcDir |
23446
994a3426acdb #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23445
diff changeset
  7855
            pF := self searchPath:(self realSystemPath) 
994a3426acdb #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23445
diff changeset
  7856
                       for:aFileName 
994a3426acdb #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23445
diff changeset
  7857
                       in:(eachPossibleRsrcDir).
994a3426acdb #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23445
diff changeset
  7858
            pF notNil ifTrue:[
994a3426acdb #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23445
diff changeset
  7859
                ^ pF.
994a3426acdb #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23445
diff changeset
  7860
            ].
23449
a03c056447f2 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23448
diff changeset
  7861
            f ~= aFileName ifTrue:[
23446
994a3426acdb #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23445
diff changeset
  7862
                pF := self searchPath:(self realSystemPath) 
994a3426acdb #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23445
diff changeset
  7863
                           for:f 
994a3426acdb #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23445
diff changeset
  7864
                           in:(eachPossibleRsrcDir).
994a3426acdb #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23445
diff changeset
  7865
                pF notNil ifTrue:[
994a3426acdb #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23445
diff changeset
  7866
                    ^ pF.
994a3426acdb #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23445
diff changeset
  7867
                ].
23433
247788b989f6 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23419
diff changeset
  7868
            ].
247788b989f6 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23419
diff changeset
  7869
        ].
247788b989f6 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23419
diff changeset
  7870
        ^ nil
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7871
    ].
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7872
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7873
    packageDir := aPackageIDOrNil copyReplaceAll:$: with:$/.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7874
23450
704f8e20673d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23449
diff changeset
  7875
    "/ search under resources-directory along systemPath ...
704f8e20673d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23449
diff changeset
  7876
    pF := self 
704f8e20673d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23449
diff changeset
  7877
            searchPath:(self realSystemPath) 
704f8e20673d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23449
diff changeset
  7878
            for:(packageDir asFilename / 'resources' / f) 
704f8e20673d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23449
diff changeset
  7879
            in:ResourceDirName.
704f8e20673d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23449
diff changeset
  7880
    pF notNil ifTrue:[
704f8e20673d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23449
diff changeset
  7881
        ^ pF.
704f8e20673d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23449
diff changeset
  7882
    ].
704f8e20673d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23449
diff changeset
  7883
    
23467
f145dcf0e5e8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23462
diff changeset
  7884
    possibleResourceDirs do:[:eachPossibleRsrcDir |
23446
994a3426acdb #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23445
diff changeset
  7885
        pF := self searchPath:(self realSystemPath) 
994a3426acdb #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23445
diff changeset
  7886
                   for:aFileName 
994a3426acdb #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23445
diff changeset
  7887
                   in:(eachPossibleRsrcDir,'/',packageDir).
994a3426acdb #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23445
diff changeset
  7888
        pF notNil ifTrue:[
994a3426acdb #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23445
diff changeset
  7889
            ^ pF.
994a3426acdb #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23445
diff changeset
  7890
        ].
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7891
    ].
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7892
12547
30fda24cebb5 comment/format in: #getResourceFileName:forClass:
Claus Gittinger <cg@exept.de>
parents: 12539
diff changeset
  7893
    "/ the following code finds the file within the IDE's own hierarchy
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7894
    dir := self projectDirectoryForPackage:aPackageIDOrNil.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7895
    dir notNil ifTrue:[
23433
247788b989f6 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23419
diff changeset
  7896
        dir := dir asFilename.
247788b989f6 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23419
diff changeset
  7897
247788b989f6 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23419
diff changeset
  7898
        (pF := dir / 'resources' / f) exists ifTrue:[ ^ pF name ].
12547
30fda24cebb5 comment/format in: #getResourceFileName:forClass:
Claus Gittinger <cg@exept.de>
parents: 12539
diff changeset
  7899
"/        (pF := dir / 'styles' / f) exists ifTrue:[ ^ pF name ].
12377
f9a9aea7ba0f changed:13 methods
Claus Gittinger <cg@exept.de>
parents: 12376
diff changeset
  7900
23433
247788b989f6 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23419
diff changeset
  7901
        "resolve something like: 'ASN/definition.asn1'"
247788b989f6 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23419
diff changeset
  7902
        (pF := dir / f) exists ifTrue:[ ^ pF name ].
12377
f9a9aea7ba0f changed:13 methods
Claus Gittinger <cg@exept.de>
parents: 12376
diff changeset
  7903
    ].
f9a9aea7ba0f changed:13 methods
Claus Gittinger <cg@exept.de>
parents: 12376
diff changeset
  7904
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7905
    ^ nil
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7906
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7907
    "
23449
a03c056447f2 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23448
diff changeset
  7908
     Smalltalk projectDirectoryForPackage:'stx:libtool'
a03c056447f2 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23448
diff changeset
  7909
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7910
     Smalltalk getResourceFileName:'SystemBrowser.rs' forPackage:'stx:libtool'
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7911
     Smalltalk getResourceFileName:'normal.style' forPackage:'stx:libview'
12547
30fda24cebb5 comment/format in: #getResourceFileName:forClass:
Claus Gittinger <cg@exept.de>
parents: 12539
diff changeset
  7912
     Smalltalk getResourceFileName:'styles/normal.style' forPackage:'stx:libview'
13323
68e5bb82f5f7 changed: #loadPackage:fromClassLibrary:
Stefan Vogel <sv@exept.de>
parents: 13303
diff changeset
  7913
     Smalltalk getResourceFileName:'styles/mswindowsXP.style' forPackage:'stx:libview'
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7914
     Smalltalk getResourceFileName:'Foo.rs' forPackage:'stx:libview'
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7915
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7916
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7917
    "Modified: / 11-10-2006 / 13:53:43 / cg"
23467
f145dcf0e5e8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23462
diff changeset
  7918
    "Modified: / 25-10-2018 / 10:00:30 / Claus Gittinger"
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7919
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7920
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7921
getSourceFileName:aFileName
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7922
    "search aFileName in some standard places
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7923
     (subdirectories named 'source' in SystemPath);
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7924
     return the absolute filename or nil if none is found.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7925
     This is used to find a sourceFile for a methods source,
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7926
     if no sourceCodeManager is available."
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7927
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7928
    |f|
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7929
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7930
    SourcePath isNil ifTrue:[
23470
bd1dde092c48 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23467
diff changeset
  7931
        SourcePath := self constructPathFor:SourceDirName
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7932
    ].
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7933
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7934
    "/ first, try a source subdir along the path.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7935
    SourcePath notNil ifTrue:[
23470
bd1dde092c48 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23467
diff changeset
  7936
        f := self searchPath:SourcePath for:aFileName in:SourceDirName.
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7937
    ].
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7938
    f isNil ifTrue:[
23470
bd1dde092c48 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23467
diff changeset
  7939
        "/ then, try it itself along the path.
bd1dde092c48 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23467
diff changeset
  7940
        f := self searchPath:self realSystemPath for:aFileName in:nil
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7941
    ].
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7942
    ^ f
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7943
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7944
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7945
     Smalltalk getSourceFileName:'Smalltalk.st'
23470
bd1dde092c48 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23467
diff changeset
  7946
     Smalltalk getSourceFileName:'stx/libbasic/ArrayedCollection.st'
bd1dde092c48 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23467
diff changeset
  7947
    "
bd1dde092c48 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23467
diff changeset
  7948
bd1dde092c48 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23467
diff changeset
  7949
    "Modified: / 18-07-1996 / 15:54:07 / cg"
bd1dde092c48 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23467
diff changeset
  7950
    "Modified (comment): / 25-10-2018 / 23:29:01 / Claus Gittinger"
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7951
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7952
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7953
getSystemFileName:aFileNameOrString
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7954
    "search aFileNameOrString in some standard places;
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7955
     return the absolute filename or nil if none is found.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7956
     see comment in Smalltalk>>initSystemPath.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7957
     This should be used to access resources such as bitmaps, doc-files,
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7958
     and other help files.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7959
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7960
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7961
    "credits for this method go to Markus ...."
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7962
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7963
    |fn nameString|
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7964
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7965
    fn := aFileNameOrString asFilename.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7966
    nameString := fn name.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7967
    fn isAbsolute ifTrue:[
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7968
	"don't use path for absolute file names"
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7969
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7970
	^ nameString
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7971
    ].
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7972
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7973
    self realSystemPath do:[:dirName |
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7974
	|realName|
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7975
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7976
	realName := dirName asFilename / nameString.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7977
	"/
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7978
	"/ here, we also return true if it's a directory
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7979
	"/ (Even if unreadable).
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7980
	"/ It could be that the file itself is still readable.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7981
	"/
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7982
	(realName isDirectory or:[realName isReadable]) ifTrue: [
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7983
	    ^ realName name
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  7984
	]
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7985
    ].
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7986
    ^ nil
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7987
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7988
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7989
     Smalltalk getSystemFileName:'doc/online/english/TOP.html'
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7990
     Smalltalk getSystemFileName:'bitmaps/SBrowser.xbm'
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7991
     Smalltalk getSystemFileName:'bitmaps/foo'
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7992
     Smalltalk getSystemFileName:'resources/View.rs'
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7993
     Smalltalk getSystemFileName:'resources/iris.style'
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7994
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7995
21443
e34ee2e79763 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 21365
diff changeset
  7996
    "Modified: / 06-05-1999 / 10:40:37 / cg"
e34ee2e79763 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 21365
diff changeset
  7997
    "Modified (comment): / 13-02-2017 / 20:30:51 / cg"
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7998
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  7999
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8000
imageFromFileNamed:aFileName forClass:aClass
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8001
    "search aFileName in some standard places:
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8002
     first in the redefinable bitmaps path, then in the classes
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8003
     own package directory if existing.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8004
     Return an image or nil."
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8005
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8006
    |classPackage img|
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8007
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8008
    classPackage := aClass package.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8009
    img := self imageFromFileNamed:aFileName inPackage:classPackage.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8010
    img isNil ifTrue:[
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8011
	"/ try under the goodies package ...
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8012
	classPackage ~= 'stx:goodies' ifTrue:[
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8013
	    img := self imageFromFileNamed:aFileName inPackage:'stx:goodies'.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8014
	]
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8015
    ].
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8016
    ^ img
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8017
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8018
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8019
     Smalltalk imageFromFileNamed:'SmalltalkX.xbm' forClass:View
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8020
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8021
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8022
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8023
imageFromFileNamed:aFileName inPackage:aPackage
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8024
    "search aFileName in some standard places:
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8025
     first in the redefinable bitmaps path,
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8026
     then in the package directory if existing.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8027
     Return an image or nil.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8028
     Search order is:
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8029
	bitmaps/<pkg>/file
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8030
	resources/<pkg>/bitmaps/file
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8031
	<pkg>/bitmaps/file
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8032
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8033
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8034
    |path|
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8035
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8036
    path := self getBitmapFileName:aFileName forPackage:aPackage.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8037
    path notNil ifTrue:[
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8038
	^ Image fromFile:path.
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8039
    ].
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8040
    ^ nil
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8041
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8042
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8043
     Smalltalk imageFromFileNamed:'SmalltalkX.xbm' inPackage:'stx:libview'
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8044
     Smalltalk imageFromFileNamed:'SmalltalkX.xbm' inPackage:'stx:libtool'
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8045
     Smalltalk imageFromFileNamed:'bitmaps/gifImages/garfield.gif' inPackage:'stx:goodies'
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8046
     Smalltalk imageFromFileNamed:'CheckOn10_xp.xpm' inPackage:'stx:libwidg'
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8047
     Smalltalk imageFromFileNamed:'ComboDn_xp.xpm' inPackage:'stx:libwidg'
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8048
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8049
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8050
    "Modified: / 08-09-2006 / 18:02:04 / cg"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8051
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8052
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8053
libraryFileNameOfClass:aClassOrClassName
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8054
    "for a given class, return the name of a classLibrary which contains
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8055
     binary code for it.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8056
     Read the libinfo file 'liblist.stc' (which is created during the compilation process)
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8057
     for an entry for aClassOrClassName.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8058
     Search for the className in the first col, and return the value found in
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8059
     the 2nd col.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8060
     Return nil if no entry is found.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8061
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8062
     A nil returns means that this class is either built-in or not present
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8063
     in a package-class library (i.e. either as separate .o or separate .st file).
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8064
     Otherwise, the returned name is the classLibrary object of that class.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8065
     The classes code can be loaded from that file if binary loading is supported."
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8066
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8067
    |aStream line words n aClassName|
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8068
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8069
    aClassOrClassName isBehavior ifTrue:[
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8070
	aClassName := aClassOrClassName name
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8071
    ] ifFalse:[
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8072
	aClassName := aClassOrClassName
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8073
    ].
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8074
    aClassName := aClassName asString.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8075
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8076
    #('include/liblist.stc')    "/ filenames
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8077
    with:#(2)                   "/ column
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8078
    do:[:fileName :col |
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8079
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8080
	aStream := self systemFileStreamFor:fileName.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8081
	aStream notNil ifTrue:[
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8082
	    [aStream atEnd] whileFalse:[
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8083
		line := aStream nextLine.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8084
		line notNil ifTrue:[
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8085
		    (line startsWith:'#') ifFalse:[
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8086
			words := line asCollectionOfWords.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8087
			(n := words size) > 1 ifTrue:[
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8088
			    (words at:1) = aClassName ifTrue:[
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8089
				n >= col ifTrue:[
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8090
				    aStream close.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8091
				    ^ (words at:col) withoutSeparators
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8092
				]
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8093
			    ]
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8094
			]
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8095
		    ]
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8096
		]
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8097
	    ].
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8098
	    aStream close
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8099
	].
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8100
    ].
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8101
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8102
    ^ nil
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8103
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8104
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8105
     Smalltalk libraryFileNameOfClass:'ClockView'
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8106
     Smalltalk libraryFileNameOfClass:'Bag'
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8107
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8108
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8109
    "Modified: 6.11.1995 / 15:41:39 / cg"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8110
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8111
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8112
packagePath
15781
3185deb3a8d2 class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 15766
diff changeset
  8113
    "return a collection of additional directory names, where smalltalk
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8114
     looks for package directories.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8115
     Notice, that directories named 'packages' under the systemPath are
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8116
     always consulted - even if not in the packagePath"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8117
20640
751b68301857 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 20615
diff changeset
  8118
    ^ PackagePath ? #()
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8119
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8120
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8121
     Smalltalk packagePath
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8122
     Smalltalk packagePath addLast:'/opt/smalltalk'
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8123
     Smalltalk packagePath addFirst:'/usr/local/otherPackages'
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8124
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8125
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8126
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8127
packagePath:aPath
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8128
    "set the packagePath;
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8129
     a collection of additional directorynames, where smalltalk
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8130
     looks for package directories.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8131
     Notice, that directories named 'packages' under the systemPath are
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8132
     always consulted - even if not in the packagePath"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8133
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8134
    PackagePath := aPath asOrderedCollection
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8135
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8136
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8137
     Smalltalk packagePath:#( '.' '/opt/stx' '/opt/smalltalk' '/usr/local/otherPackages')
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8138
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8139
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8140
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8141
projectDirectoryForClass:aClass
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8142
    "given a class, return the path to its package directory;
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8143
     nil if not found."
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8144
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8145
    |pkg|
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8146
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8147
    pkg := aClass package.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8148
    pkg isNil ifTrue:[^ nil].
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8149
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8150
    ^ self projectDirectoryForPackage:pkg.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8151
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8152
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8153
     Smalltalk projectDirectoryForClass:Array
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8154
     Smalltalk projectDirectoryForClass:View
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8155
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8156
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8157
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8158
projectDirectoryForPackage:aPackage
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8159
    "given a packageID, return the path to its package directory;
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8160
     nil if not found."
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8161
16642
f98a00a58e5a class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16593
diff changeset
  8162
    ^ aPackage asPackageId packageDirectory.
f98a00a58e5a class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16593
diff changeset
  8163
23449
a03c056447f2 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23448
diff changeset
  8164
"/    |prj prjDir|
a03c056447f2 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23448
diff changeset
  8165
"/
23448
c3a10c2e07a4 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23446
diff changeset
  8166
"/    "/ there might be a package specific resource directory ...
c3a10c2e07a4 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23446
diff changeset
  8167
"/    "/ in the directory, from which the project was loaded
c3a10c2e07a4 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23446
diff changeset
  8168
"/    prj := Project projectWithId:aPackage.
c3a10c2e07a4 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23446
diff changeset
  8169
"/    prj notNil ifTrue:[
c3a10c2e07a4 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23446
diff changeset
  8170
"/        prjDir := prj directory.
c3a10c2e07a4 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23446
diff changeset
  8171
"/    ].
c3a10c2e07a4 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23446
diff changeset
  8172
"/    (prjDir notNil and:[prjDir asFilename exists]) ifFalse:[
c3a10c2e07a4 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23446
diff changeset
  8173
"/        prjDir := Smalltalk getPackageFileName:(aPackage copyReplaceAll:$: with:$/).
c3a10c2e07a4 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23446
diff changeset
  8174
"/    ].
c3a10c2e07a4 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23446
diff changeset
  8175
"/    ^ prjDir
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8176
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8177
    "
16668
b88318df967d flush cached class resources AFTER reading the user preferences
Claus Gittinger <cg@exept.de>
parents: 16666
diff changeset
  8178
     Smalltalk projectDirectoryForPackage:'stx:libbasic'
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8179
     Smalltalk projectDirectoryForPackage:'exept:smartcard'
16668
b88318df967d flush cached class resources AFTER reading the user preferences
Claus Gittinger <cg@exept.de>
parents: 16666
diff changeset
  8180
     Smalltalk projectDirectoryForPackage:'stx'
b88318df967d flush cached class resources AFTER reading the user preferences
Claus Gittinger <cg@exept.de>
parents: 16666
diff changeset
  8181
     Smalltalk projectDirectoryForPackage:'bosch'
b88318df967d flush cached class resources AFTER reading the user preferences
Claus Gittinger <cg@exept.de>
parents: 16666
diff changeset
  8182
     Smalltalk projectDirectoryForPackage:'bosch:foo'
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8183
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8184
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8185
    "Modified: / 07-10-2006 / 17:45:58 / cg"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8186
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8187
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8188
readAbbreviations
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8189
    "read classname to filename mappings from include/abbrev.stc.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8190
     sigh - all for those poor sys5.3 or MSDOS people with short filenames ..."
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8191
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8192
    "since installAutoloadedClasses also reads all abbreviations, use it"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8193
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8194
    CachedAbbreviations := IdentityDictionary new.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8195
    self installAutoloadedClasses.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8196
    ^ CachedAbbreviations.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8197
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8198
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8199
     Smalltalk readAbbreviations
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8200
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8201
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8202
    "Modified: / 10.12.1999 / 17:48:53 / cg"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8203
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8204
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8205
readAbbreviationsFromStream:aStream
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8206
    "read classname to filename mappings from aStream.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8207
     sigh - all for those poor sys5.3 or MSDOS people with short filenames ..."
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8208
11375
bcdaeec8353c splash support
Claus Gittinger <cg@exept.de>
parents: 11367
diff changeset
  8209
    self
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8210
	withAbbreviationsFromStream:aStream
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8211
	do:[:className :abbrev :pkg |
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8212
	    self setFilename:abbrev forClass:className package:pkg.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8213
	].
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8214
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8215
    "Modified: / 13.12.1999 / 11:54:17 / cg"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8216
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8217
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8218
realSystemPath
16642
f98a00a58e5a class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16593
diff changeset
  8219
    "return the realSystemPath - that's the directory names from
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8220
     SystemPath which exist and are readable"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8221
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8222
    |nP|
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8223
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8224
    RealSystemPath isNil ifTrue:[
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8225
	OperatingSystem isVMSlike ifTrue:[
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8226
	    "/ temporary kludge: since we cannot currently
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8227
	    "/ check for existence of a name like 'volume:',
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8228
	    "/ leave those in the Path without a check.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8229
	    RealSystemPath := SystemPath select:[:dirName |  |f|
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8230
		f := dirName asFilename.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8231
		f isVolumeOnly or:[(f isDirectory) and:[f isReadable]]
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8232
	    ]
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8233
	] ifFalse:[
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8234
	    RealSystemPath := SystemPath
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8235
		select:[:eachDirectoryName |  |f|
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8236
		    f := eachDirectoryName asFilename.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8237
		    (f isDirectory) and:[f isReadable]
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8238
		] thenCollect:[:eachDirectoryName|
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8239
		    eachDirectoryName asFilename pathName.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8240
		].
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8241
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8242
	    "/ remove duplicates (but keep order)
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8243
	    nP := OrderedCollection new.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8244
	    RealSystemPath do:[:p |
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8245
		(nP includes:p) ifFalse:[
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8246
		    nP add:p
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8247
		]
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8248
	    ].
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8249
	    (nP includes:'.') ifFalse:[
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8250
		nP add:'.'
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8251
	    ].
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8252
	    RealSystemPath := nP.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8253
	].
617
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  8254
    ].
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  8255
    ^ RealSystemPath
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  8256
!
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  8257
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8258
recursiveReadAllAbbreviationsFrom:aDirectory
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8259
    self recursiveReadAllAbbreviationsFrom:aDirectory maxLevels:15
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8260
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8261
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8262
recursiveReadAllAbbreviationsFrom:aDirectory maxLevels:maxLevels
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8263
    "read all abbreviations from and under aDirectory."
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8264
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8265
    |abbrevStream dir directoryContents|
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8266
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8267
    maxLevels == 0 ifTrue:[
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8268
"/        'Smalltalk [warning]: max directory nesting reached.' infoPrintCR.
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8269
	^ self
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8270
    ].
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8271
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8272
    dir := aDirectory asFilename.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8273
    dir exists ifFalse:[^ self].
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8274
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8275
    [
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8276
	abbrevStream := (dir / 'abbrev.stc') asFilename readStream.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8277
	self readAbbreviationsFromStream:abbrevStream.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8278
	abbrevStream close.
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8279
    ] on:FileStream openErrorSignal do:[:ex| "ignore this file"].
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8280
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8281
    [
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8282
	directoryContents := dir directoryContents.
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8283
    ] on:FileStream openErrorSignal do:[:ex|
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8284
	"non-accessible directory: we are done"
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8285
	^ self
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8286
    ].
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8287
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8288
    directoryContents do:[:aFilename |
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8289
	|f|
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8290
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8291
	(#(
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8292
	    'doc'
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8293
	    'CVS'
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8294
	    'bitmaps'
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8295
	    'resources'
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8296
	    'source'
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8297
	) includes:aFilename) ifFalse:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8298
	    f := dir / aFilename.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8299
	    f isDirectory ifTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8300
		self recursiveReadAllAbbreviationsFrom:f maxLevels:maxLevels-1
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8301
	    ]
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8302
	].
4458
6f46b35f787c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4431
diff changeset
  8303
    ].
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  8304
!
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  8305
15334
aead0a7a558a class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15333
diff changeset
  8306
reinitializePackagePath
aead0a7a558a class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15333
diff changeset
  8307
    "{ Pragma: +optSpace }"
20207
17e32d469ac6 #OTHER by mawalch
mawalch
parents: 20161
diff changeset
  8308
15334
aead0a7a558a class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15333
diff changeset
  8309
    PackagePath notNil ifTrue:[
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8310
	PackagePath := PackagePath select:[:p | p asFilename exists].
15334
aead0a7a558a class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15333
diff changeset
  8311
    ].
aead0a7a558a class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15333
diff changeset
  8312
    PackagePath isEmptyOrNil ifTrue:[
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8313
	PackagePath := OperatingSystem defaultPackagePath
18868
0856cde0eaa4 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18794
diff changeset
  8314
    ].
0856cde0eaa4 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18794
diff changeset
  8315
    self addWorkspaceDirectoryToPackagePath.
15334
aead0a7a558a class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15333
diff changeset
  8316
!
aead0a7a558a class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 15333
diff changeset
  8317
13368
00d9e3385e76 class definition
Claus Gittinger <cg@exept.de>
parents: 13353
diff changeset
  8318
relativePackagePathForPackage:aPackage
00d9e3385e76 class definition
Claus Gittinger <cg@exept.de>
parents: 13353
diff changeset
  8319
    |path|
00d9e3385e76 class definition
Claus Gittinger <cg@exept.de>
parents: 13353
diff changeset
  8320
00d9e3385e76 class definition
Claus Gittinger <cg@exept.de>
parents: 13353
diff changeset
  8321
    PackageToPathMapping notNil ifTrue:[
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8322
	path := PackageToPathMapping at:aPackage ifAbsent:nil.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8323
	PackageToPathMapping notNil ifTrue:[^ path].
13370
Claus Gittinger <cg@exept.de>
parents: 13368
diff changeset
  8324
    ].
Claus Gittinger <cg@exept.de>
parents: 13368
diff changeset
  8325
    ^ aPackage copyReplaceAll:$: with:$/.
13368
00d9e3385e76 class definition
Claus Gittinger <cg@exept.de>
parents: 13353
diff changeset
  8326
00d9e3385e76 class definition
Claus Gittinger <cg@exept.de>
parents: 13353
diff changeset
  8327
    "
00d9e3385e76 class definition
Claus Gittinger <cg@exept.de>
parents: 13353
diff changeset
  8328
     PackageToPathMapping := Dictionary new.
00d9e3385e76 class definition
Claus Gittinger <cg@exept.de>
parents: 13353
diff changeset
  8329
     PackageToPathMapping at:'expeccoNET:server' put:'expeccoNET_oldVersion/server'.
00d9e3385e76 class definition
Claus Gittinger <cg@exept.de>
parents: 13353
diff changeset
  8330
     PackageToPathMapping at:'expeccoNET:server/ui' put:'expeccoNET_oldVersion/server/ui'.
00d9e3385e76 class definition
Claus Gittinger <cg@exept.de>
parents: 13353
diff changeset
  8331
00d9e3385e76 class definition
Claus Gittinger <cg@exept.de>
parents: 13353
diff changeset
  8332
     Smalltalk relativePackagePathForPackage:'stx:libview/resources'
00d9e3385e76 class definition
Claus Gittinger <cg@exept.de>
parents: 13353
diff changeset
  8333
     Smalltalk relativePackagePathForPackage:'stx:libview'
00d9e3385e76 class definition
Claus Gittinger <cg@exept.de>
parents: 13353
diff changeset
  8334
    "
00d9e3385e76 class definition
Claus Gittinger <cg@exept.de>
parents: 13353
diff changeset
  8335
!
00d9e3385e76 class definition
Claus Gittinger <cg@exept.de>
parents: 13353
diff changeset
  8336
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8337
resourceDirectoryForPackage:aPackage
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8338
    "given a packageID, return the path to its resource directory;
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8339
     nil if not found."
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8340
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8341
    |prjDir rsrcDir|
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8342
11183
9a4e7475a655 care for nil project when asked for a resource directory
Claus Gittinger <cg@exept.de>
parents: 11174
diff changeset
  8343
    aPackage notNil ifTrue:[
23433
247788b989f6 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23419
diff changeset
  8344
        prjDir := self projectDirectoryForPackage:aPackage.
247788b989f6 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23419
diff changeset
  8345
        (prjDir notNil
247788b989f6 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23419
diff changeset
  8346
        and:[(prjDir := prjDir asFilename) exists
247788b989f6 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23419
diff changeset
  8347
        and:[(rsrcDir := prjDir / 'resources') exists]]) ifTrue:[
247788b989f6 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23419
diff changeset
  8348
            ^ rsrcDir
247788b989f6 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23419
diff changeset
  8349
        ].
23445
2f2ca1a7aaac #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23433
diff changeset
  8350
        
2f2ca1a7aaac #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23433
diff changeset
  8351
        #( '../Resources' '.resources' 'resources' ) do:[:eachPossibleRsrcDir |
2f2ca1a7aaac #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23433
diff changeset
  8352
            rsrcDir := self getSystemFileName:(eachPossibleRsrcDir,'/',(aPackage copyReplaceAll:$: with:$/)).
2f2ca1a7aaac #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23433
diff changeset
  8353
            rsrcDir notNil ifTrue:[
2f2ca1a7aaac #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23433
diff changeset
  8354
                ^ rsrcDir asFilename
2f2ca1a7aaac #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23433
diff changeset
  8355
            ].
23433
247788b989f6 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23419
diff changeset
  8356
        ].
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8357
    ].
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8358
    ^ nil
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8359
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8360
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8361
     Smalltalk resourceDirectoryForPackage:'stx:libbasic'
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8362
     Smalltalk resourceDirectoryForPackage:'exept:expecco'
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8363
     Smalltalk resourceDirectoryForPackage:'exept:smartcard'
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8364
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8365
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8366
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8367
resourceFileStreamFor:aFileName
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8368
    "search aFileName in some standard places;
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8369
     return a readonly fileStream or nil if not found.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8370
     Searches in subdirectories named 'resource' in SystemPath"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8371
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8372
    ^ self resourceFileStreamFor:aFileName forClass:nil
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8373
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8374
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8375
resourceFileStreamFor:aFileName forClass:aClassOrNil
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8376
    "search aFileName in some standard places and in the classes
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8377
     package-resource directory.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8378
     Return a readonly fileStream or nil if not found.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8379
     Searches in subdirectories named 'resource' in SystemPath"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8380
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8381
    |aString|
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8382
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8383
    aString := self getResourceFileName:aFileName forClass:aClassOrNil.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8384
    aString notNil ifTrue:[
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8385
	^ aString asFilename readStreamOrNil
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  8386
    ].
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  8387
    ^ nil
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  8388
!
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  8389
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8390
searchPath:aPath for:aFileName in:aDirName
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8391
    "search aPath for a subdirectory named aDirectory with a file
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8392
     named aFileName"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8393
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8394
    |f|
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8395
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8396
    ((f := aFileName asFilename) isAbsolute
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8397
    or:[f isExplicitRelative]) ifTrue:[
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8398
	"/
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8399
	"/ don't use path for absolute or explicit .-relative file names
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8400
	"/
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8401
	^ aFileName
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8402
    ].
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8403
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8404
    aPath notNil ifTrue:[
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8405
	aPath do:[:dirName |
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8406
	    |realName dir|
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8407
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8408
	    dir := dirName asFilename.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8409
	    aDirName notNil ifTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8410
		realName := dir / aDirName / aFileName.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8411
	    ] ifFalse:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8412
		realName := dir / aFileName.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8413
	    ].
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8414
	    (realName isReadable) ifTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8415
		^ realName name
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8416
	    ]
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8417
	].
11108
a803fa13937a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11093
diff changeset
  8418
    ].
a803fa13937a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11093
diff changeset
  8419
a803fa13937a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11093
diff changeset
  8420
"/ not needed - executing dir is always in SearchPath
12377
f9a9aea7ba0f changed:13 methods
Claus Gittinger <cg@exept.de>
parents: 12376
diff changeset
  8421
"/    realName := Filename currentDirectory / aFileName.
11108
a803fa13937a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11093
diff changeset
  8422
"/    (realName isReadable) ifTrue:[
a803fa13937a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11093
diff changeset
  8423
"/        ^ realName name
a803fa13937a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11093
diff changeset
  8424
"/    ].
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8425
    ^ nil.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8426
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8427
    "Modified: / 29.4.1999 / 15:06:43 / cg"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8428
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8429
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8430
setFilename:aFileNameString forClass:aClassNameString package:aPackageNameString
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8431
    |classNameSymbol oldAbbrev oldPath newPath cls abbrevs|
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8432
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8433
    CachedAbbreviations isNil ifTrue:[
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8434
	CachedAbbreviations := IdentityDictionary new.
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8435
    ].
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8436
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8437
    abbrevs := CachedAbbreviations.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8438
    aClassNameString ~= aFileNameString ifTrue:[
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8439
	classNameSymbol := aClassNameString asSymbol.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8440
	oldAbbrev := abbrevs at:classNameSymbol ifAbsent:nil.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8441
	oldAbbrev notNil ifTrue:[
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8442
	    oldAbbrev ~= aFileNameString ifTrue:[
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8443
		oldAbbrev asFilename isAbsolute
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8444
		    ifTrue:[ oldPath := oldAbbrev ]
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8445
		    ifFalse:[ oldPath := (self projectDirectoryForPackage:aPackageNameString) asFilename constructString: oldAbbrev ].
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8446
		aFileNameString asFilename isAbsolute
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8447
		    ifTrue:[ newPath := aFileNameString ]
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8448
		    ifFalse:[ newPath := (self projectDirectoryForPackage:aPackageNameString) asFilename constructString: aFileNameString ].
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8449
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8450
		oldPath ~= newPath ifTrue:[
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8451
		    StandAlone ifFalse:[
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8452
			('Smalltalk [warning]: autoload path change for: ',aClassNameString,' in package ',aPackageNameString) infoPrintCR.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8453
			('Smalltalk [info]: old: ',oldPath) infoPrintCR.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8454
			('Smalltalk [info]: new: ',newPath) infoPrintCR.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8455
		    ]
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8456
		]
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8457
	    ].
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8458
	    "overwrite old abbreviation with new one,
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8459
	     to allow fixing of bad abbrev files"
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8460
	].
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8461
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8462
	cls := self classNamed:aFileNameString.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8463
	cls notNil ifTrue:[
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8464
	    cls name ~= aClassNameString ifTrue:[
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8465
		"/ ok, there is a class named after this abbrev ...
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8466
		"/ this is only a conflict, if the other class has no
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8467
		"/ abbreviation (or the same).
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8468
		(abbrevs at:(cls name asSymbol) ifAbsent:cls name) = aFileNameString ifTrue:[
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8469
		    cls isNameSpace ifFalse:[
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8470
			aPackageNameString = cls package ifTrue:[
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8471
			    StandAlone ifFalse:[
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8472
				('Smalltalk [warning]: conflict for: ' , cls name ,
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8473
				    ' in package ' , aPackageNameString) infoPrintCR.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8474
				('Smalltalk [warning]: (' , aClassNameString , ' -> ' , aFileNameString
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8475
				    , ')') infoPrintCR
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8476
			    ]
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8477
			]
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8478
		    ]
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8479
		]
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8480
	    ]
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8481
	].
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8482
	abbrevs at:classNameSymbol put:aFileNameString.
8470
d79e917d4f36 Define #setFilename:forClass:package: to define an abbreviation.
Stefan Vogel <sv@exept.de>
parents: 8445
diff changeset
  8483
    ]
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  8484
!
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  8485
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8486
sourceDirectoryNameOfClass:aClassOrClassName
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8487
    "for a given class, return the pathname relative to TOP of the classes source code.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8488
     Read the files 'abbrev.stc' and 'liblist.stc' (which are created during the compilation process)
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8489
     for an entry for aClassOrClassName.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8490
     Search for the className in the first col, and return the value found in
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8491
     the 3rd col.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8492
     Return nil if no entry is found."
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8493
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8494
    |aStream line words n aClassName|
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8495
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8496
    aClassOrClassName isBehavior ifTrue:[
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8497
	aClassName := aClassOrClassName name
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8498
    ] ifFalse:[
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8499
	aClassName := aClassOrClassName
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8500
    ].
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8501
    aClassName := aClassName asString.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8502
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8503
    #('include/abbrev.stc' 'include/liblist.stc')    "/ filenames
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8504
    with:#(3 2)                   "/ column
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8505
    do:[:fileName :col |
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8506
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8507
	aStream := self systemFileStreamFor:fileName.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8508
	aStream notNil ifTrue:[
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8509
	    [aStream atEnd] whileFalse:[
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8510
		line := aStream nextLine.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8511
		line notNil ifTrue:[
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8512
		    (line startsWith:'#') ifFalse:[
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8513
			words := line asCollectionOfWords.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8514
			(n := words size) > 1 ifTrue:[
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8515
			    (words at:1) = aClassName ifTrue:[
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8516
				n >= col ifTrue:[
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8517
				    aStream close.
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8518
				    ^ (words at:col) withoutSeparators
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8519
				]
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8520
			    ]
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8521
			]
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8522
		    ]
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8523
		]
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8524
	    ].
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8525
	    aStream close
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8526
	].
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8527
    ].
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8528
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8529
    ^ nil
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8530
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8531
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8532
     Smalltalk sourceDirectoryNameOfClass:'ClockView'
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8533
     Smalltalk sourceDirectoryNameOfClass:'Bag'
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8534
     Smalltalk sourceDirectoryNameOfClass:'GLWireCubeDemoView'
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8535
     Smalltalk sourceDirectoryNameOfClass:'SomeNonExistingClass'
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8536
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8537
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8538
    "Created: 6.11.1995 / 15:43:30 / cg"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8539
    "Modified: 9.12.1995 / 23:54:14 / cg"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8540
    "Modified: 3.1.1997 / 11:26:44 / stefan"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8541
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8542
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8543
sourceFileStreamFor:aFileName
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8544
    "search aFileName in some standard places;
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8545
     return a readonly fileStream or nil if not found.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8546
     Searches in subdirectories named 'source' in SystemPath"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8547
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8548
    |aString|
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8549
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8550
    aString := self getSourceFileName:aFileName.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8551
    aString notNil ifTrue:[
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8552
	^ aString asFilename readStreamOrNil
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  8553
    ].
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  8554
    ^ nil
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  8555
!
7758
526f0a3a74a4 *** empty log message ***
penk
parents: 7757
diff changeset
  8556
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8557
systemFileStreamFor:aFileName
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8558
    "search aFileName in some standard places;
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8559
     return a readonly fileStream or nil if not found.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8560
     see comment in Smalltalk>>initSystemPath"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8561
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8562
    |aString|
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8563
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8564
    aString := self getSystemFileName:aFileName.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8565
    aString notNil ifTrue:[
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8566
	^ aString asFilename readStreamOrNil
617
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  8567
    ].
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  8568
    ^ nil
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  8569
!
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 597
diff changeset
  8570
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8571
systemPath
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8572
    "return a collection of directorynames, where smalltalk
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8573
     looks for system files
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8574
     (usually in subdirs such as resources, bitmaps, source etc.)
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8575
     see comment in Smalltalk>>initSystemPath."
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8576
20640
751b68301857 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 20615
diff changeset
  8577
    ^ SystemPath ? #()
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8578
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8579
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8580
     Smalltalk systemPath
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8581
     Smalltalk systemPath addLast:'someOtherDirectoryPath'
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8582
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8583
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8584
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8585
systemPath:aPath
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8586
    "set the collection of directorynames, where smalltalk
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8587
     looks for system files
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8588
     (usually in subdirs such as resources, bitmaps, source etc.)
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8589
     see comment in Smalltalk>>initSystemPath."
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8590
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8591
    SystemPath := aPath.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8592
    self flushPathCaches
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8593
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8594
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8595
     Smalltalk systemPath
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8596
     Smalltalk systemPath:(Smalltalk systemPath copy addLast:'someOtherDirectoryPath')
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  8597
    "
11301
f65ffb560925 refactored abbreviation-reading
Claus Gittinger <cg@exept.de>
parents: 11232
diff changeset
  8598
!
f65ffb560925 refactored abbreviation-reading
Claus Gittinger <cg@exept.de>
parents: 11232
diff changeset
  8599
f65ffb560925 refactored abbreviation-reading
Claus Gittinger <cg@exept.de>
parents: 11232
diff changeset
  8600
withAbbreviationsFromStream:aStream do:aBlock
f65ffb560925 refactored abbreviation-reading
Claus Gittinger <cg@exept.de>
parents: 11232
diff changeset
  8601
    "read classname to filename mappings from aStream.
f65ffb560925 refactored abbreviation-reading
Claus Gittinger <cg@exept.de>
parents: 11232
diff changeset
  8602
     Evaluate aBlock for each tuple:
24741
bdf7f00ee97b #TUNING by exept
Claus Gittinger <cg@exept.de>
parents: 24679
diff changeset
  8603
        class-name , abbrev-name, package
11301
f65ffb560925 refactored abbreviation-reading
Claus Gittinger <cg@exept.de>
parents: 11232
diff changeset
  8604
     Sigh - all for those poor sys5.3 or MSDOS people with short filenames..."
f65ffb560925 refactored abbreviation-reading
Claus Gittinger <cg@exept.de>
parents: 11232
diff changeset
  8605
13415
ba3e5e6dd910 Jan's changes
vrany
parents: 13385
diff changeset
  8606
    |line lineNo words nm abbrev pkg category size s w|
ba3e5e6dd910 Jan's changes
vrany
parents: 13385
diff changeset
  8607
ba3e5e6dd910 Jan's changes
vrany
parents: 13385
diff changeset
  8608
    lineNo := 0.
11301
f65ffb560925 refactored abbreviation-reading
Claus Gittinger <cg@exept.de>
parents: 11232
diff changeset
  8609
    [aStream atEnd] whileFalse:[
24741
bdf7f00ee97b #TUNING by exept
Claus Gittinger <cg@exept.de>
parents: 24679
diff changeset
  8610
        line := aStream nextLine.
bdf7f00ee97b #TUNING by exept
Claus Gittinger <cg@exept.de>
parents: 24679
diff changeset
  8611
        lineNo := lineNo + 1.
bdf7f00ee97b #TUNING by exept
Claus Gittinger <cg@exept.de>
parents: 24679
diff changeset
  8612
        line notEmptyOrNil ifTrue:[
bdf7f00ee97b #TUNING by exept
Claus Gittinger <cg@exept.de>
parents: 24679
diff changeset
  8613
            (line startsWith:'#') ifFalse:[
bdf7f00ee97b #TUNING by exept
Claus Gittinger <cg@exept.de>
parents: 24679
diff changeset
  8614
bdf7f00ee97b #TUNING by exept
Claus Gittinger <cg@exept.de>
parents: 24679
diff changeset
  8615
                "/ must do it manually, caring for quoted strings.
11301
f65ffb560925 refactored abbreviation-reading
Claus Gittinger <cg@exept.de>
parents: 11232
diff changeset
  8616
"/                words := line asCollectionOfWords.
f65ffb560925 refactored abbreviation-reading
Claus Gittinger <cg@exept.de>
parents: 11232
diff changeset
  8617
24741
bdf7f00ee97b #TUNING by exept
Claus Gittinger <cg@exept.de>
parents: 24679
diff changeset
  8618
                words := OrderedCollection new.
bdf7f00ee97b #TUNING by exept
Claus Gittinger <cg@exept.de>
parents: 24679
diff changeset
  8619
                s := line readStream.
bdf7f00ee97b #TUNING by exept
Claus Gittinger <cg@exept.de>
parents: 24679
diff changeset
  8620
                [s atEnd] whileFalse:[
bdf7f00ee97b #TUNING by exept
Claus Gittinger <cg@exept.de>
parents: 24679
diff changeset
  8621
                    s skipSeparators.
bdf7f00ee97b #TUNING by exept
Claus Gittinger <cg@exept.de>
parents: 24679
diff changeset
  8622
                    s peek == $' ifTrue:[
bdf7f00ee97b #TUNING by exept
Claus Gittinger <cg@exept.de>
parents: 24679
diff changeset
  8623
                        s next.
bdf7f00ee97b #TUNING by exept
Claus Gittinger <cg@exept.de>
parents: 24679
diff changeset
  8624
                        w := s upTo:$'.
bdf7f00ee97b #TUNING by exept
Claus Gittinger <cg@exept.de>
parents: 24679
diff changeset
  8625
                        s skipSeparators.
bdf7f00ee97b #TUNING by exept
Claus Gittinger <cg@exept.de>
parents: 24679
diff changeset
  8626
                    ] ifFalse:[
bdf7f00ee97b #TUNING by exept
Claus Gittinger <cg@exept.de>
parents: 24679
diff changeset
  8627
                        w := s upToSeparator
bdf7f00ee97b #TUNING by exept
Claus Gittinger <cg@exept.de>
parents: 24679
diff changeset
  8628
                    ].
bdf7f00ee97b #TUNING by exept
Claus Gittinger <cg@exept.de>
parents: 24679
diff changeset
  8629
                    words add:w
bdf7f00ee97b #TUNING by exept
Claus Gittinger <cg@exept.de>
parents: 24679
diff changeset
  8630
                ].
bdf7f00ee97b #TUNING by exept
Claus Gittinger <cg@exept.de>
parents: 24679
diff changeset
  8631
                words size >= 3 ifTrue:[
bdf7f00ee97b #TUNING by exept
Claus Gittinger <cg@exept.de>
parents: 24679
diff changeset
  8632
                    nm := (words at:1) withoutSeparators.
bdf7f00ee97b #TUNING by exept
Claus Gittinger <cg@exept.de>
parents: 24679
diff changeset
  8633
                    abbrev := (words at:2) withoutSeparators.
bdf7f00ee97b #TUNING by exept
Claus Gittinger <cg@exept.de>
parents: 24679
diff changeset
  8634
                    pkg := (words at:3) withoutSeparators.
bdf7f00ee97b #TUNING by exept
Claus Gittinger <cg@exept.de>
parents: 24679
diff changeset
  8635
                    aBlock argumentCount == 3 ifTrue:[
bdf7f00ee97b #TUNING by exept
Claus Gittinger <cg@exept.de>
parents: 24679
diff changeset
  8636
                        aBlock value:nm value:abbrev value:pkg.
bdf7f00ee97b #TUNING by exept
Claus Gittinger <cg@exept.de>
parents: 24679
diff changeset
  8637
                    ] ifFalse:[
bdf7f00ee97b #TUNING by exept
Claus Gittinger <cg@exept.de>
parents: 24679
diff changeset
  8638
                        words size >= 4 ifTrue:[
bdf7f00ee97b #TUNING by exept
Claus Gittinger <cg@exept.de>
parents: 24679
diff changeset
  8639
                            category := words at:4.
bdf7f00ee97b #TUNING by exept
Claus Gittinger <cg@exept.de>
parents: 24679
diff changeset
  8640
                        ].
bdf7f00ee97b #TUNING by exept
Claus Gittinger <cg@exept.de>
parents: 24679
diff changeset
  8641
                        words size == 5 ifTrue:[
bdf7f00ee97b #TUNING by exept
Claus Gittinger <cg@exept.de>
parents: 24679
diff changeset
  8642
                            size := (words at:5) asNumber
bdf7f00ee97b #TUNING by exept
Claus Gittinger <cg@exept.de>
parents: 24679
diff changeset
  8643
                        ].
bdf7f00ee97b #TUNING by exept
Claus Gittinger <cg@exept.de>
parents: 24679
diff changeset
  8644
                        aBlock value:nm value:abbrev value:pkg value: category value: size
bdf7f00ee97b #TUNING by exept
Claus Gittinger <cg@exept.de>
parents: 24679
diff changeset
  8645
                    ]
bdf7f00ee97b #TUNING by exept
Claus Gittinger <cg@exept.de>
parents: 24679
diff changeset
  8646
                ] ifFalse:[
bdf7f00ee97b #TUNING by exept
Claus Gittinger <cg@exept.de>
parents: 24679
diff changeset
  8647
                    ('Smalltalk [warning]: malformed line ', lineNo printString , ' in ' , (aStream pathName)) infoPrintCR.
bdf7f00ee97b #TUNING by exept
Claus Gittinger <cg@exept.de>
parents: 24679
diff changeset
  8648
                ]
bdf7f00ee97b #TUNING by exept
Claus Gittinger <cg@exept.de>
parents: 24679
diff changeset
  8649
            ]
bdf7f00ee97b #TUNING by exept
Claus Gittinger <cg@exept.de>
parents: 24679
diff changeset
  8650
        ]
13518
b81bc64782b1 not ifTrue -> ifFalse (trying the rewrite tool ;-)
Claus Gittinger <cg@exept.de>
parents: 13506
diff changeset
  8651
    ].
b81bc64782b1 not ifTrue -> ifFalse (trying the rewrite tool ;-)
Claus Gittinger <cg@exept.de>
parents: 13506
diff changeset
  8652
13415
ba3e5e6dd910 Jan's changes
vrany
parents: 13385
diff changeset
  8653
    "Modified: / 06-03-2011 / 18:17:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
13546
8993c10243a2 changed: #withAbbreviationsFromStream:do:
Claus Gittinger <cg@exept.de>
parents: 13540
diff changeset
  8654
    "Modified: / 04-08-2011 / 21:35:00 / cg"
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  8655
! !
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  8656
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  8657
!Smalltalk class methodsFor:'system management-packages'!
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  8658
16159
d66db46bd78f class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16144
diff changeset
  8659
isPackageLoaded:aPackageIdOrPackage
d66db46bd78f class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16144
diff changeset
  8660
    |projectDefinition|
d66db46bd78f class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16144
diff changeset
  8661
d66db46bd78f class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16144
diff changeset
  8662
    projectDefinition := aPackageIdOrPackage asPackageId projectDefinitionClass.
16161
195f2580fa6c class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16159
diff changeset
  8663
    ^ projectDefinition notNil and:[projectDefinition isLoaded and:[projectDefinition isFullyLoaded]]
16159
d66db46bd78f class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16144
diff changeset
  8664
d66db46bd78f class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16144
diff changeset
  8665
    "
d66db46bd78f class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16144
diff changeset
  8666
     Smalltalk isPackageLoaded:'stx:goodies/persistency'
16170
ca4d03def070 endOfDipatch if running scripts
Claus Gittinger <cg@exept.de>
parents: 16164
diff changeset
  8667
     Smalltalk isPackageLoaded:'stx:goodies/refactoryBrowser/lint'
ca4d03def070 endOfDipatch if running scripts
Claus Gittinger <cg@exept.de>
parents: 16164
diff changeset
  8668
     Smalltalk isPackageLoaded:'stx:goodies/refactoryBrowser/lint/spelling'
16159
d66db46bd78f class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16144
diff changeset
  8669
    "
d66db46bd78f class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16144
diff changeset
  8670
!
d66db46bd78f class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 16144
diff changeset
  8671
20898
d640780dabb0 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 20885
diff changeset
  8672
knownLoadablePackagesDo:aBlock
d640780dabb0 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 20885
diff changeset
  8673
    "enumerate loadable packages from the packages folder."
d640780dabb0 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 20885
diff changeset
  8674
d640780dabb0 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 20885
diff changeset
  8675
    Smalltalk realSystemPath do:[:dirName |
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8676
	|packageDir|
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8677
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8678
	packageDir := dirName asFilename / 'packages'.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8679
	(packageDir exists and:[packageDir isDirectory]) ifTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8680
	    packageDir directoryContentsAsFilenames sort do:[:fn |
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8681
		|item base nm path parentPath parent isLibrary isApplication isAlreadyLoaded
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8682
		 defClass target type nameComponents packageName packageID|
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8683
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8684
		((fn suffix = 'mcz')
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8685
		or:[ fn isDirectory
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8686
		or:[ (fn baseName startsWith:'.')
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8687
		or:[ (fn baseName = 'README') ]]]) ifFalse:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8688
		    base := fn withoutSuffix baseName.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8689
		    (base startsWith:'lib') ifTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8690
			nm := (base copyFrom:4).
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8691
			fn suffix notEmptyOrNil ifTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8692
			    type := #library.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8693
			] ifFalse:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8694
			    type := #application.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8695
			]
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8696
		    ] ifFalse:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8697
			nm := base.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8698
			type := #application.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8699
		    ].
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8700
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8701
		    (base ~= 'librun') ifTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8702
			(fn suffix = 'mcz') ifTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8703
			    packageName := fn withoutSuffix.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8704
			    target := fn.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8705
			] ifFalse:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8706
			    ( #('dll' 'so' 'sl' 'dylib') includes:(fn suffix)) ifTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8707
				(base startsWith:'lib') ifTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8708
				    nm := base copyFrom:4.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8709
				] ifFalse:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8710
				    nm := base.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8711
				].
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8712
			    ].
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8713
			    nameComponents := nm asCollectionOfSubstringsSeparatedBy:$_.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8714
			    packageName := nameComponents first.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8715
			    nameComponents size > 1 ifTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8716
				packageName := packageName,':',((nameComponents copyFrom:2) asStringWith:'/')
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8717
			    ].
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8718
			].
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8719
			packageName notNil ifTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8720
			    aBlock value:packageName value:type value:fn .
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8721
			]
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8722
		    ]
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8723
		]
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8724
	    ]
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8725
	]
20898
d640780dabb0 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 20885
diff changeset
  8726
    ]
d640780dabb0 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 20885
diff changeset
  8727
d640780dabb0 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 20885
diff changeset
  8728
    "
d640780dabb0 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 20885
diff changeset
  8729
     Smalltalk knownLoadablePackagesDo:[:packageID :type :path |
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8730
	 Transcript showCR:'%1 (%2) in %3' with:packageID with:type with:path.
20898
d640780dabb0 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 20885
diff changeset
  8731
     ]
d640780dabb0 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 20885
diff changeset
  8732
    "
d640780dabb0 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 20885
diff changeset
  8733
!
d640780dabb0 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 20885
diff changeset
  8734
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8735
loadPackage:aPackageIdOrPackage
12250
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  8736
    "make certain, that some particular package is loaded into the system.
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  8737
     Return true if loaded, false otherwise."
11668
a7f22eab5b72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11667
diff changeset
  8738
a7f22eab5b72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11667
diff changeset
  8739
    ^ self loadPackage:aPackageIdOrPackage asAutoloaded:false
a7f22eab5b72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11667
diff changeset
  8740
a7f22eab5b72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11667
diff changeset
  8741
    "
a7f22eab5b72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11667
diff changeset
  8742
     Smalltalk loadPackage:'stx:libbasic'
a7f22eab5b72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11667
diff changeset
  8743
     Smalltalk loadPackage:'stx:goodies/persistency'
a7f22eab5b72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11667
diff changeset
  8744
     Smalltalk loadPackage:'cg:cparser'
a7f22eab5b72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11667
diff changeset
  8745
     Smalltalk loadPackage:'cg:rose'
a7f22eab5b72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11667
diff changeset
  8746
    "
a7f22eab5b72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11667
diff changeset
  8747
!
a7f22eab5b72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11667
diff changeset
  8748
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8749
packageDirectoryForPackageId:aPackageId
12250
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  8750
    "used by classes to find the location of their resource- and bitmap directories.
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  8751
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  8752
     Notice that the directory structure is different between the development
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  8753
     environment (top for packages is ../../../stx) and delivered stand alone executables,
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  8754
     where the top is specified via a shell environment variable, and is typically ../lib.
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  8755
     At runtime, Smalltalk knows about the systemPath setting."
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  8756
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8757
    |packageDirName packageDir|
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8758
14589
058231c234cb class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 14546
diff changeset
  8759
    packageDirName := aPackageId asPackageId string copyReplaceAll:$: with:$/.
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8760
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8761
    packageDir := self getPackageFileName:packageDirName.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8762
    packageDir isNil ifTrue:[
23450
704f8e20673d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23449
diff changeset
  8763
        ^ nil.
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8764
    ].
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8765
    ^ packageDir asFilename
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8766
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8767
    "
11375
bcdaeec8353c splash support
Claus Gittinger <cg@exept.de>
parents: 11367
diff changeset
  8768
     Smalltalk packageDirectoryForPackageId:'stx:libbasic'
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8769
     Smalltalk packageDirectoryForPackageId:'stx:goodies/persistency'
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8770
     Smalltalk packageDirectoryForPackageId:'exept:ctypes'
23450
704f8e20673d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23449
diff changeset
  8771
     Smalltalk getPackageFileName:'stx/libview'
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8772
    "
12250
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  8773
!
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  8774
24563
dabe24b121db #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24562
diff changeset
  8775
require:className fromPackage:aPackageIdOrPackage
dabe24b121db #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24562
diff changeset
  8776
    "make certain, that some particular package is loaded into the system,
dabe24b121db #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24562
diff changeset
  8777
     and that a class named className is present.
dabe24b121db #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24562
diff changeset
  8778
     Returns the class, or raises an error, if the load fails."
dabe24b121db #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24562
diff changeset
  8779
dabe24b121db #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24562
diff changeset
  8780
    |cls|
dabe24b121db #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24562
diff changeset
  8781
dabe24b121db #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24562
diff changeset
  8782
    (cls := self classNamed:className) isNil ifTrue:[
dabe24b121db #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24562
diff changeset
  8783
        self requirePackage:aPackageIdOrPackage.
dabe24b121db #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24562
diff changeset
  8784
        (cls := self classNamed:className) isNil ifTrue:[ 
dabe24b121db #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24562
diff changeset
  8785
            NotFoundError 
dabe24b121db #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24562
diff changeset
  8786
                raiseRequestWith:className 
dabe24b121db #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24562
diff changeset
  8787
                errorString:('class not found: %1' bindWith:className).
dabe24b121db #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24562
diff changeset
  8788
            ^ nil
dabe24b121db #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24562
diff changeset
  8789
        ].
dabe24b121db #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24562
diff changeset
  8790
    ].
dabe24b121db #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24562
diff changeset
  8791
    ^ cls
dabe24b121db #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24562
diff changeset
  8792
dabe24b121db #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24562
diff changeset
  8793
    "
dabe24b121db #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24562
diff changeset
  8794
     Smalltalk require:#Array fromPackage:'stx:libbasic'
dabe24b121db #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24562
diff changeset
  8795
    "
dabe24b121db #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24562
diff changeset
  8796
!
dabe24b121db #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24562
diff changeset
  8797
18794
d9c30cfc3959 #UI_ENHANCEMENT
Claus Gittinger <cg@exept.de>
parents: 18733
diff changeset
  8798
requirePackage:aPackageIdOrPackage
d9c30cfc3959 #UI_ENHANCEMENT
Claus Gittinger <cg@exept.de>
parents: 18733
diff changeset
  8799
    "make certain, that some particular package is loaded into the system.
24679
28a451eaa355 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24563
diff changeset
  8800
     Raises a proceedable error, if the load fails.
28a451eaa355 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24563
diff changeset
  8801
     Returns the package-definition class or nil (if exception was proceeded)."
28a451eaa355 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24563
diff changeset
  8802
28a451eaa355 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24563
diff changeset
  8803
    |packageId def|
24562
33dd11e56674 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24417
diff changeset
  8804
33dd11e56674 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24417
diff changeset
  8805
    (self loadPackage:aPackageIdOrPackage) ifFalse:[
33dd11e56674 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24417
diff changeset
  8806
        PackageNotFoundError 
33dd11e56674 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24417
diff changeset
  8807
            raiseRequestWith:aPackageIdOrPackage 
33dd11e56674 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24417
diff changeset
  8808
            errorString:('require failed to load package: %1' bindWith:aPackageIdOrPackage).
24679
28a451eaa355 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24563
diff changeset
  8809
        ^ nil
28a451eaa355 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24563
diff changeset
  8810
    ].
28a451eaa355 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24563
diff changeset
  8811
    packageId := aPackageIdOrPackage asPackageId.
28a451eaa355 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24563
diff changeset
  8812
28a451eaa355 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24563
diff changeset
  8813
    "/ if there is a projectDefinition, let it load itself...
28a451eaa355 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24563
diff changeset
  8814
    def := packageId projectDefinitionClass.
28a451eaa355 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24563
diff changeset
  8815
    ^ def
24562
33dd11e56674 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24417
diff changeset
  8816
33dd11e56674 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24417
diff changeset
  8817
    "
33dd11e56674 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24417
diff changeset
  8818
     Smalltalk requirePackage:'foobar'
33dd11e56674 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24417
diff changeset
  8819
33dd11e56674 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24417
diff changeset
  8820
     Smalltalk requirePackage:'stx:libbasic'
33dd11e56674 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24417
diff changeset
  8821
     Smalltalk requirePackage:'stx:goodies/bla'
24679
28a451eaa355 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24563
diff changeset
  8822
     Smalltalk requirePackage:'stx:goodies/regression'
28a451eaa355 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24563
diff changeset
  8823
     Smalltalk requirePackage:'exept:ctypes'
24562
33dd11e56674 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24417
diff changeset
  8824
     Smalltalk requirePackage:'cg:rose'
18794
d9c30cfc3959 #UI_ENHANCEMENT
Claus Gittinger <cg@exept.de>
parents: 18733
diff changeset
  8825
    "
d9c30cfc3959 #UI_ENHANCEMENT
Claus Gittinger <cg@exept.de>
parents: 18733
diff changeset
  8826
!
d9c30cfc3959 #UI_ENHANCEMENT
Claus Gittinger <cg@exept.de>
parents: 18733
diff changeset
  8827
12250
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  8828
unloadPackage:aPackageIdOrPackage
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  8829
    |projectDefinition|
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  8830
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  8831
    projectDefinition := aPackageIdOrPackage.
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  8832
    projectDefinition isProjectDefinition ifFalse:[
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8833
	projectDefinition := projectDefinition asPackageId projectDefinitionClass.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8834
	projectDefinition isNil ifTrue:[
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8835
	    Logger warning:'trying to unload non-existing package: %1' with:aPackageIdOrPackage.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8836
	    ^ self.
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8837
	].
12250
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  8838
    ].
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  8839
    projectDefinition unloadPackage.
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  8840
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  8841
    "
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  8842
     Smalltalk loadPackage:'stx:goodies/persistency'
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  8843
     Smalltalk unloadPackage:'stx:goodies/persistency'
1a21bcbad053 added: #unloadPackage:
Claus Gittinger <cg@exept.de>
parents: 12194
diff changeset
  8844
    "
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  8845
! !
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  8846
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  8847
!Smalltalk class methodsFor:'system management-undeclared variables'!
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  8848
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8849
clearUndeclaredVariables
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8850
    "remove all undeclared variables"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8851
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8852
    (Smalltalk at:#Undeclared) do:[:eachKey |
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8853
	Smalltalk removeKey:(self undeclaredPrefix , eachKey) asSymbol.
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8854
    ].
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8855
    (Smalltalk at:#Undeclared) removeAll.
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  8856
    Smalltalk removeKey:#Undeclared.
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8857
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8858
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8859
undeclaredPrefix
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8860
    "the prefix used for undeclared variables"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8861
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8862
    ^ 'Undeclared:::'
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8863
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8864
    "Created: / 31.10.1997 / 01:13:10 / cg"
7758
526f0a3a74a4 *** empty log message ***
penk
parents: 7757
diff changeset
  8865
! !
526f0a3a74a4 *** empty log message ***
penk
parents: 7757
diff changeset
  8866
526f0a3a74a4 *** empty log message ***
penk
parents: 7757
diff changeset
  8867
!Smalltalk class methodsFor:'time-versions'!
526f0a3a74a4 *** empty log message ***
penk
parents: 7757
diff changeset
  8868
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8869
configuration
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8870
    "{ Pragma: +optSpace }"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8871
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8872
    "for developers only: return the configuration, with which
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8873
     this smalltalk was compiled."
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8874
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8875
%{  /* NOCONTEXT */
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8876
    extern char *__getConfigurationString();
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8877
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8878
    RETURN (__MKSTRING(__getConfigurationString() COMMA_SND));
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8879
%}.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8880
    ^ 'unknownOS/unknownCONF:unknownPACK'
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8881
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8882
    "
10071
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
  8883
     Smalltalk configuration
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  8884
    "
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  8885
!
453
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  8886
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8887
copyrightString
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8888
    "{ Pragma: +optSpace }"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8889
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8890
    "return a copyright string"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8891
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8892
%{  /* NOCONTEXT */
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8893
#ifndef __getCopyrightString
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8894
    extern OBJ __getCopyrightString();
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8895
#endif
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8896
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8897
    RETURN (__getCopyrightString());
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8898
%}.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8899
    ^ self primitiveFailed
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8900
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8901
    "
7758
526f0a3a74a4 *** empty log message ***
penk
parents: 7757
diff changeset
  8902
     Smalltalk copyrightString
526f0a3a74a4 *** empty log message ***
penk
parents: 7757
diff changeset
  8903
    "
526f0a3a74a4 *** empty log message ***
penk
parents: 7757
diff changeset
  8904
!
526f0a3a74a4 *** empty log message ***
penk
parents: 7757
diff changeset
  8905
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8906
distributorString
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8907
    "{ Pragma: +optSpace }"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8908
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8909
    "return a string describing the distributor of this software"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8910
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8911
%{  /* NOCONTEXT */
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8912
#ifndef __getDistributorString
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8913
    extern OBJ __getDistributorString();
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8914
#endif
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8915
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8916
    RETURN (__getDistributorString());
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8917
%}.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8918
    ^ 'eXept Software AG, Germany'
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8919
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8920
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8921
     Smalltalk distributorString
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8922
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8923
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8924
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8925
expirationTime
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8926
    "{ Pragma: +optSpace }"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8927
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8928
    "for developers only: return the time when the system will expire.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8929
     after this time it will not run any longer.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8930
     It returns nil, if no expiration time has been set (system runs forever :-))"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8931
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8932
    |exp|
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8933
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8934
%{
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8935
    extern unsigned int __getExpirationTime();
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8936
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8937
    exp = __MKUINT(__getExpirationTime());
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8938
%}.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8939
    exp == 0 ifTrue:[
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  8940
	^ nil
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8941
    ].
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8942
    ^ Timestamp new fromOSTime:(exp * 1000). "OSTime is ms since 1970"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8943
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8944
    "
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  8945
     Smalltalk expirationTime
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  8946
    "
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  8947
!
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  8948
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8949
fullVersionString
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8950
    "{ Pragma: +optSpace }"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8951
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8952
    "return a full version string"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8953
19516
69d40825637a #UI_ENHANCEMENT
Claus Gittinger <cg@exept.de>
parents: 19511
diff changeset
  8954
    ^ 'Smalltalk/X release %1%2 of %3'
22900
8d0aedd02702 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 22831
diff changeset
  8955
        bindWith:(self versionString)
8d0aedd02702 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 22831
diff changeset
  8956
        with:((ExternalBytes sizeofPointer == 8)
8d0aedd02702 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 22831
diff changeset
  8957
                        ifTrue:[' (64bit)']
8d0aedd02702 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 22831
diff changeset
  8958
                        ifFalse:[''])
8d0aedd02702 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 22831
diff changeset
  8959
        with:(self versionDate)
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8960
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8961
    "
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  8962
     Smalltalk fullVersionString
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8963
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8964
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8965
    "Created: / 27.10.1997 / 17:03:09 / cg"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8966
    "Modified: / 27.10.1997 / 17:04:02 / cg"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8967
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8968
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8969
hello
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8970
    "{ Pragma: +optSpace }"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8971
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8972
    "return a greeting string"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8973
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8974
    "stupid: this should come from a resource file ...
18924
f5063aa4e434 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 18868
diff changeset
  8975
     but I don't use it here, to allow mini-systems without
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8976
     Resource-stuff."
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8977
19187
7730a271c529 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19121
diff changeset
  8978
    |proto lang bit bitsPerWordString|
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8979
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8980
    lang := Language.
19187
7730a271c529 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19121
diff changeset
  8981
    bit := 'bit'.
7730a271c529 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19121
diff changeset
  8982
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8983
    (lang == #de) ifTrue:[
22900
8d0aedd02702 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 22831
diff changeset
  8984
        proto := 'Willkommen bei %1 (%4Version %2 von %3)'. bit := 'Bit'.
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8985
    ] ifFalse:[ (lang == #fr) ifTrue:[
24136
0f13645d4faf #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24123
diff changeset
  8986
        proto := 'Salut, Bienvenue à %1 (%4version %2 de %3)'
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8987
    ] ifFalse:[ (lang == #it) ifTrue:[
22900
8d0aedd02702 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 22831
diff changeset
  8988
        proto := 'Ciao, benvenuto al %1 (%4versione %2 di %3)'
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8989
    ] ifFalse:[ (lang == #es) ifTrue:[
22900
8d0aedd02702 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 22831
diff changeset
  8990
        proto := 'Hola, bienvenida a %1 (%4version %2 de %3)'
18924
f5063aa4e434 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 18868
diff changeset
  8991
    ] ifFalse:[ (lang == #pt) ifTrue:[
24136
0f13645d4faf #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24123
diff changeset
  8992
        proto := 'Olá!!, mem-vindo a %1 (%4version %2 de %3)'
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8993
    ] ifFalse:[ (lang == #no) ifTrue:[
22900
8d0aedd02702 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 22831
diff changeset
  8994
        proto := 'Hei, verdenmottakelse til %1 (%4versjon %2 av %3)'
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8995
    ]]]]]].
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8996
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8997
    "/ ... more needed here ...
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8998
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  8999
    proto isNil ifTrue:[
22900
8d0aedd02702 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 22831
diff changeset
  9000
        proto := 'Hello World - welcome to %1 (%4version %2 of %3)'.
8d0aedd02702 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 22831
diff changeset
  9001
    ].
8d0aedd02702 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 22831
diff changeset
  9002
    ExternalBytes sizeofPointer ~~ 4 ifTrue:[
8d0aedd02702 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 22831
diff changeset
  9003
        bitsPerWordString := (ExternalBytes sizeofPointer * 8) printString,bit,' '.
19187
7730a271c529 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19121
diff changeset
  9004
    ] ifFalse:[
22900
8d0aedd02702 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 22831
diff changeset
  9005
        bitsPerWordString := ''
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  9006
    ].
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9007
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9008
    ^ proto bindWith:('SmallTalk/X' allBold)
22900
8d0aedd02702 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 22831
diff changeset
  9009
                with:(self versionString)
8d0aedd02702 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 22831
diff changeset
  9010
                with:(self versionDate)
8d0aedd02702 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 22831
diff changeset
  9011
                with:bitsPerWordString
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9012
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9013
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9014
     Smalltalk language:#us.
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  9015
     Smalltalk hello
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9016
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9017
     Smalltalk language:#de.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9018
     Smalltalk hello
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9019
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9020
     Smalltalk language:#no.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9021
     Smalltalk hello
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9022
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9023
     Transcript showCR:(Smalltalk hello)
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9024
     Stdout showCR:(Smalltalk hello)
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9025
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9026
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9027
    "Modified: 18.5.1996 / 14:25:13 / cg"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9028
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9029
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9030
imageRestartTime
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9031
    "return a timestamp for the moment when this image was restarted.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9032
     If we do not execute from an image (i.e. fresh start), return nil."
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9033
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9034
    ^ ImageRestartTime
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9035
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9036
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9037
     Smalltalk imageStartTime
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9038
     Smalltalk imageRestartTime
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9039
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9040
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9041
    "Created: 13.12.1995 / 17:44:20 / cg"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9042
    "Modified: 6.3.1996 / 11:56:35 / cg"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9043
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9044
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9045
imageSaveTime
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9046
    "{ Pragma: +optSpace }"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9047
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9048
    "return a timestamp for the moment when this image was saved"
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  9049
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  9050
    ^ ObjectMemory imageSaveTime
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  9051
!
7758
526f0a3a74a4 *** empty log message ***
penk
parents: 7757
diff changeset
  9052
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9053
imageStartTime
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9054
    "{ Pragma: +optSpace }"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9055
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9056
    "return a timestamp for the moment when this system started the first time
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9057
     (i.e. the first initial start without an image)"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9058
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9059
    ^ ImageStartTime
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9060
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9061
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9062
     Smalltalk imageStartTime
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9063
     Smalltalk imageRestartTime
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9064
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9065
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9066
    "Created: 13.12.1995 / 17:44:14 / cg"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9067
    "Modified: 13.12.1995 / 17:45:47 / cg"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9068
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9069
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9070
majorVersionNr
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9071
    "{ Pragma: +optSpace }"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9072
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9073
    "return the major version number.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9074
     This is only incremented for very fundamental changes,
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9075
     which make old object files totally incompatible
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9076
     (for example, if the layout/representation of fundamental
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9077
      classes changes).
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9078
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9079
     ST/X revision Naming is:
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  9080
	<major>.<minor>.<revision>.<release>"
19974
09283ec7cc62 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 19958
diff changeset
  9081
09283ec7cc62 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 19958
diff changeset
  9082
    ^ 7
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9083
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9084
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9085
     Smalltalk majorVersionNr
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9086
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9087
19974
09283ec7cc62 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 19958
diff changeset
  9088
    "Modified: / 09-06-2016 / 16:28:40 / cg"
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9089
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9090
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9091
minorVersionNr
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9092
    "{ Pragma: +optSpace }"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9093
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9094
    "return the minor version number.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9095
     This is incremented for changes which make some old object
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9096
     files incompatible, or the protocol changes such that some
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9097
     classes need rework.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9098
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9099
     ST/X revision Naming is:
23683
05f38e32876b #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23679
diff changeset
  9100
        <major>.<minor>.<revision>.<release>"
05f38e32876b #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23679
diff changeset
  9101
05f38e32876b #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23679
diff changeset
  9102
    ^ 2
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9103
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9104
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9105
     Smalltalk minorVersionNr
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9106
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9107
19974
09283ec7cc62 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 19958
diff changeset
  9108
    "Modified: / 09-06-2016 / 16:28:45 / cg"
23683
05f38e32876b #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23679
diff changeset
  9109
    "Modified: / 08-02-2019 / 22:36:33 / Claus Gittinger"
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9110
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9111
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9112
releaseIdentification
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9113
    "{ Pragma: +optSpace }"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9114
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9115
    "for developers only: return the release
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9116
     (to further identify the version in case of errors)"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9117
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9118
%{  /* NOCONTEXT */
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9119
    extern OBJ __getRel();
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9120
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9121
    RETURN (__getRel());
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9122
%}.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9123
    ^ 'ST/X_experimental'
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9124
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9125
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9126
     Smalltalk releaseIdentification
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9127
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9128
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9129
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9130
releaseNr
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9131
    "{ Pragma: +optSpace }"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9132
14542
8ed2cefffa0c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 14529
diff changeset
  9133
    "return the release number.
8ed2cefffa0c class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 14529
diff changeset
  9134
     Now releaseNr is the build number (BUILD_NUMBER from Jenkins)
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9135
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9136
     ST/X revision Naming is:
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  9137
	<major>.<minor>.<revision>.<release>"
14529
93eb58ca1886 class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 14522
diff changeset
  9138
93eb58ca1886 class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 14522
diff changeset
  9139
    |releaseNumber|
93eb58ca1886 class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 14522
diff changeset
  9140
93eb58ca1886 class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 14522
diff changeset
  9141
    releaseNumber := Smalltalk versionBuildNumber.
93eb58ca1886 class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 14522
diff changeset
  9142
    releaseNumber isEmpty ifTrue:[
18668
b8be71e850e1 schteam
Claus Gittinger <cg@exept.de>
parents: 18572
diff changeset
  9143
	^ 0.
14529
93eb58ca1886 class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 14522
diff changeset
  9144
    ].
93eb58ca1886 class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 14522
diff changeset
  9145
    ^ releaseNumber
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9146
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9147
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9148
     Smalltalk releaseNr
12867
2b9cbcea983b version bump - layout of Class, Method and Context changed.
Claus Gittinger <cg@exept.de>
parents: 12861
diff changeset
  9149
     Smalltalk versionString
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9150
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9151
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9152
    "Created: / 10-12-1995 / 01:42:19 / cg"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9153
    "Modified: / 10-02-2007 / 14:49:51 / cg"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9154
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9155
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9156
revisionNr
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9157
    "{ Pragma: +optSpace }"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9158
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9159
    "return the revision number.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9160
     Incremented for releases which fix bugs/add features
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9161
     and represent a stable workable version which got published
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9162
     to the outside world.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9163
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9164
     ST/X revision Naming is:
22791
5aebe8996c2d --silent + --repl
Claus Gittinger <cg@exept.de>
parents: 22707
diff changeset
  9165
	<major>.<minor>.<revision>.<release>"
19974
09283ec7cc62 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 19958
diff changeset
  9166
09283ec7cc62 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 19958
diff changeset
  9167
    ^ 0
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9168
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9169
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9170
     Smalltalk revisionNr
13323
68e5bb82f5f7 changed: #loadPackage:fromClassLibrary:
Stefan Vogel <sv@exept.de>
parents: 13303
diff changeset
  9171
     Smalltalk hello string
13014
fe6484596968 changed: #revisionNr
Claus Gittinger <cg@exept.de>
parents: 13000
diff changeset
  9172
    "
fe6484596968 changed: #revisionNr
Claus Gittinger <cg@exept.de>
parents: 13000
diff changeset
  9173
14898
5afe1d1f7ffe class: Smalltalk
az
parents: 14892
diff changeset
  9174
    "Modified: / 19-03-2013 / 10:48:59 / az"
19974
09283ec7cc62 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 19958
diff changeset
  9175
    "Modified: / 09-06-2016 / 16:28:57 / cg"
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9176
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9177
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9178
timeStamp
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9179
    "return a string useful for timestamping a file.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9180
     The returned string is padded with spaces for a constant
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9181
     length (to avoid changing a files size in fileOut with unchanged
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9182
     class)."
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9183
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9184
    ^ ('''' , self timeStampString , '''') paddedTo:80 with:(Character space)
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9185
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9186
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9187
timeStamp:aStream
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9188
    "write a string useful for timestamping a file onto aStream.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9189
     ST80 compatibility"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9190
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9191
    aStream nextPutAll:(self timeStamp).
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9192
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9193
    "Created: / 18.6.1998 / 17:22:58 / cg"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9194
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9195
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9196
timeStampString
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9197
    "return a string useful for timestamping a file."
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9198
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9199
    |dateString|
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9200
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9201
    dateString := String streamContents:[:s | Date today printOn:s language:#en].  "/ MUST be english !!!!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9202
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9203
    ^ ('From Smalltalk/X, Version:' , (Smalltalk versionString) , ' on '
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9204
       , dateString , ' at ' , Time now printString
7758
526f0a3a74a4 *** empty log message ***
penk
parents: 7757
diff changeset
  9205
       )
526f0a3a74a4 *** empty log message ***
penk
parents: 7757
diff changeset
  9206
!
526f0a3a74a4 *** empty log message ***
penk
parents: 7757
diff changeset
  9207
14529
93eb58ca1886 class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 14522
diff changeset
  9208
versionBuildNumber
93eb58ca1886 class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 14522
diff changeset
  9209
    "{ Pragma: +optSpace }"
93eb58ca1886 class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 14522
diff changeset
  9210
93eb58ca1886 class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 14522
diff changeset
  9211
    "return the executables build number - that's the jenkins build #.
93eb58ca1886 class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 14522
diff changeset
  9212
     Empty if not built by jenkins"
93eb58ca1886 class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 14522
diff changeset
  9213
93eb58ca1886 class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 14522
diff changeset
  9214
%{  /* NOCONTEXT */
93eb58ca1886 class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 14522
diff changeset
  9215
    extern char *__getBuildNumberString();
93eb58ca1886 class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 14522
diff changeset
  9216
93eb58ca1886 class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 14522
diff changeset
  9217
    RETURN (__MKSTRING(__getBuildNumberString() COMMA_SND) );
93eb58ca1886 class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 14522
diff changeset
  9218
%}.
93eb58ca1886 class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 14522
diff changeset
  9219
    ^ ''
93eb58ca1886 class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 14522
diff changeset
  9220
93eb58ca1886 class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 14522
diff changeset
  9221
    "
93eb58ca1886 class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 14522
diff changeset
  9222
     Smalltalk versionBuildNumber
93eb58ca1886 class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 14522
diff changeset
  9223
    "
93eb58ca1886 class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 14522
diff changeset
  9224
!
93eb58ca1886 class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 14522
diff changeset
  9225
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9226
versionDate
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9227
    "{ Pragma: +optSpace }"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9228
14522
ae3c24478338 build number
Claus Gittinger <cg@exept.de>
parents: 14487
diff changeset
  9229
    "return the executables build date - that's the date when the smalltalk
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9230
     executable was built"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9231
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9232
%{  /* NOCONTEXT */
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9233
    extern char *__getBuildDateString();
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9234
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9235
    RETURN (__MKSTRING(__getBuildDateString() COMMA_SND) );
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9236
%}.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9237
    ^ 'today'
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9238
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9239
    "
10071
c3ac1c847c22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10069
diff changeset
  9240
     Smalltalk versionDate
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  9241
    "
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  9242
!
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  9243
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9244
versionString
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9245
    "{ Pragma: +optSpace }"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9246
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9247
    "return the version string"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9248
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9249
    ^ (self majorVersionNr printString ,
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9250
       '.',
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9251
       self minorVersionNr printString ,
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9252
       '.',
14529
93eb58ca1886 class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 14522
diff changeset
  9253
       self revisionNr printString,
93eb58ca1886 class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 14522
diff changeset
  9254
       '.',
93eb58ca1886 class: Smalltalk
Stefan Vogel <sv@exept.de>
parents: 14522
diff changeset
  9255
       self releaseNr printString)
13771
42c23bea6aaf *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 13675
diff changeset
  9256
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9257
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9258
    "
8583
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  9259
     Smalltalk versionString
2952bfabeaf7 oops - garbage was checked in
Claus Gittinger <cg@exept.de>
parents: 8570
diff changeset
  9260
    "
10641
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9261
!
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9262
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9263
vmMajorVersionNr
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9264
    "{ Pragma: +optSpace }"
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9265
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9266
    "return the VMs major version number."
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9267
%{
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9268
    RETURN (__mkSmallInteger(4));
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9269
%}.
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9270
    ^ 4
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9271
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9272
    "
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9273
     Smalltalk vmMajorVersionNr
e2a4830afe72 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10640
diff changeset
  9274
    "
2
claus
parents: 1
diff changeset
  9275
! !
453
57381f377c3f fix logged-arg (was nil)
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
  9276
1750
36ff7e62388a care for privateClasses in remove
Claus Gittinger <cg@exept.de>
parents: 1713
diff changeset
  9277
!Smalltalk class methodsFor:'documentation'!
630
b785d23d7c5b version at the end
Claus Gittinger <cg@exept.de>
parents: 617
diff changeset
  9278
13532
638f9bfab880 changed: #recursiveInstallAutoloadedClassesFrom:rememberIn:maxLevels:noAutoload:packageTop:showSplashInLevels:
Claus Gittinger <cg@exept.de>
parents: 13531
diff changeset
  9279
version
18560
a37464a68e70 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 18385
diff changeset
  9280
    ^ '$Header$'
13532
638f9bfab880 changed: #recursiveInstallAutoloadedClassesFrom:rememberIn:maxLevels:noAutoload:packageTop:showSplashInLevels:
Claus Gittinger <cg@exept.de>
parents: 13531
diff changeset
  9281
!
638f9bfab880 changed: #recursiveInstallAutoloadedClassesFrom:rememberIn:maxLevels:noAutoload:packageTop:showSplashInLevels:
Claus Gittinger <cg@exept.de>
parents: 13531
diff changeset
  9282
12172
d90a72004f43 changed: #fileNameForClass:
Claus Gittinger <cg@exept.de>
parents: 12033
diff changeset
  9283
version_CVS
18560
a37464a68e70 class: Smalltalk
Claus Gittinger <cg@exept.de>
parents: 18385
diff changeset
  9284
    ^ '$Header$'
13415
ba3e5e6dd910 Jan's changes
vrany
parents: 13385
diff changeset
  9285
!
ba3e5e6dd910 Jan's changes
vrany
parents: 13385
diff changeset
  9286
ba3e5e6dd910 Jan's changes
vrany
parents: 13385
diff changeset
  9287
version_SVN
15225
80d7f00bfcc0 refactored
Claus Gittinger <cg@exept.de>
parents: 15170
diff changeset
  9288
    ^ '$ Id: Smalltalk.st 10648 2011-06-23 15:55:10Z vranyj1  $'
630
b785d23d7c5b version at the end
Claus Gittinger <cg@exept.de>
parents: 617
diff changeset
  9289
! !
22792
642855917cc2 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22791
diff changeset
  9290