AbstractOperatingSystem.st
changeset 4001 fa75465bd263
parent 3942 52b6ed227424
child 4004 b9ce30dcb84c
--- a/AbstractOperatingSystem.st	Wed Feb 24 12:27:49 1999 +0100
+++ b/AbstractOperatingSystem.st	Thu Feb 25 20:17:28 1999 +0100
@@ -49,36 +49,36 @@
 
     [Class variables:]
 
-        LastErrorNumber <Integer>       the last value of errno
-
-        OSSignals       <Array>         Array of signals to be raised for corresponding
-                                        OperatingSystem signals.
-
-        PipeFailed      <Boolean>       set if a fork (or popen) has failed;
-                                        ST/X will avoid doing more forks/popens
-                                        if this flag is set, for a slightly
-                                        smoother operation.
-
-        ErrorSignal     <Signal>        Parentsignal of all OS error signals.
-                                        not directly raised.
-
-        AccessDeniedErrorSignal         misc concrete error reporting signals
-        FileNotFoundErrorSignal
-        UnsupportedOperationSignal
-        InvalidArgumentsSignal
-
-        LocaleInfo      <Dictionary>    if non nil, that is taken instead of the operating
-                                        systems locale definitions (allows for overwriting
-                                        these, or provide a compatible info on systems which do
-                                        not support locales)
+	LastErrorNumber <Integer>       the last value of errno
+
+	OSSignals       <Array>         Array of signals to be raised for corresponding
+					OperatingSystem signals.
+
+	PipeFailed      <Boolean>       set if a fork (or popen) has failed;
+					ST/X will avoid doing more forks/popens
+					if this flag is set, for a slightly
+					smoother operation.
+
+	ErrorSignal     <Signal>        Parentsignal of all OS error signals.
+					not directly raised.
+
+	AccessDeniedErrorSignal         misc concrete error reporting signals
+	FileNotFoundErrorSignal
+	UnsupportedOperationSignal
+	InvalidArgumentsSignal
+
+	LocaleInfo      <Dictionary>    if non nil, that is taken instead of the operating
+					systems locale definitions (allows for overwriting
+					these, or provide a compatible info on systems which do
+					not support locales)
 
     [author:]
-        Claus Gittinger
+	Claus Gittinger
 
     [see also:]
-        OSProcessStatus
-        Filename Date Time
-        ExternalStream FileStream PipeStream Socket
+	OSProcessStatus
+	Filename Date Time
+	ExternalStream FileStream PipeStream Socket
 "
 !
 
@@ -708,14 +708,14 @@
      Can be used on UNIX with fork or on other systems to chain to another program."
 
     ^ self 
-        exec:aCommandPath 
-        withArguments:argArray
-        environment:nil
-        fileDescriptors:nil
-        closeDescriptors:nil 
-        fork:false 
-        newPgrp:false
-        inDirectory:nil
+	exec:aCommandPath 
+	withArguments:argArray
+	environment:nil
+	fileDescriptors:nil
+	closeDescriptors:nil 
+	fork:false 
+	newPgrp:false
+	inDirectory:nil
 
     "/ never reached ...
 
@@ -726,31 +726,31 @@
     "Internal lowLevel entry for combined fork & exec;
 
      If fork is false (chain a command):
-         execute the OS command specified by the argument, aCommandPath, with
-         arguments in argArray (no arguments, if nil).
-         If successful, this method does not return and smalltalk is gone.
-         If not successful, it does return.
-         Normal use is with forkForCommand.
+	 execute the OS command specified by the argument, aCommandPath, with
+	 arguments in argArray (no arguments, if nil).
+	 If successful, this method does not return and smalltalk is gone.
+	 If not successful, it does return.
+	 Normal use is with forkForCommand.
 
      If fork is true (subprocess command execution):
-        fork a child to do the above.
-        The process id of the child process is returned; nil if the fork failed.
+	fork a child to do the above.
+	The process id of the child process is returned; nil if the fork failed.
 
      fdArray contains the filedescriptors, to be used for the child (if fork is true).
-        fdArray[1] = 15 -> use fd 15 as stdin.
-        If an element of the array is set to nil, the corresponding filedescriptor
-        will be closed for the child.
-        fdArray[0] == StdIn for child
-        fdArray[1] == StdOut for child
-        fdArray[2] == StdErr for child
-        on VMS, these must be channels as returned by createMailBox.
+	fdArray[1] = 15 -> use fd 15 as stdin.
+	If an element of the array is set to nil, the corresponding filedescriptor
+	will be closed for the child.
+	fdArray[0] == StdIn for child
+	fdArray[1] == StdOut for child
+	fdArray[2] == StdErr for child
+	on VMS, these must be channels as returned by createMailBox.
 
      closeFdArray contains descriptors that will be closed in the subprocess.
-        closeDescriptors are ignored in the WIN32 & VMS versions.
+	closeDescriptors are ignored in the WIN32 & VMS versions.
 
      If newPgrp is true, the subprocess will be established in a new process group.
-        The processgroup will be equal to id.
-        newPgrp is not used on WIN32 and VMS systems.
+	The processgroup will be equal to id.
+	newPgrp is not used on WIN32 and VMS systems.
 
      env specifies environment variables which are passed differently from
      the current environment. If non-nil, it must be a dictionary providing
@@ -758,28 +758,28 @@
      To pass a variable as empty (i.e. unset), pass a nil value.
 
      Notice: this used to be two separate ST-methods; however, in order to use
-            vfork on some machines, it had to be merged into one, to avoid write
-            accesses to ST/X memory from the vforked-child.
-            The code below only does read accesses."
+	    vfork on some machines, it had to be merged into one, to avoid write
+	    accesses to ST/X memory from the vforked-child.
+	    The code below only does read accesses."
 
     ^ self
-        exec:aCommandPath 
-        withArguments:argColl 
-        environment:env 
-        fileDescriptors:fdColl 
-        closeDescriptors:closeFdColl 
-        fork:doFork
-        newPgrp:newPgrp 
-        inDirectory:nil
+	exec:aCommandPath 
+	withArguments:argColl 
+	environment:env 
+	fileDescriptors:fdColl 
+	closeDescriptors:closeFdColl 
+	fork:doFork
+	newPgrp:newPgrp 
+	inDirectory:nil
 
     "
      |id|
 
      id := OperatingSystem fork.
      id == 0 ifTrue:[
-        'I am the child'.
-        OperatingSystem exec:'/bin/ls' withArguments:#('ls' '/tmp').
-        'not reached'.
+	'I am the child'.
+	OperatingSystem exec:'/bin/ls' withArguments:#('ls' '/tmp').
+	'not reached'.
      ]
     "
     "
@@ -787,11 +787,11 @@
 
      id := OperatingSystem fork.
      id == 0 ifTrue:[
-        'I am the child'.
-        OperatingSystem
-           exec:'/bin/sh'
-           withArguments:#('sh' '-c' 'sleep 2;echo 1;sleep 2;echo 2').
-        'not reached'.
+	'I am the child'.
+	OperatingSystem
+	   exec:'/bin/sh'
+	   withArguments:#('sh' '-c' 'sleep 2;echo 1;sleep 2;echo 2').
+	'not reached'.
      ].
      id printNL.
      (Delay forSeconds:3.5) wait.
@@ -815,57 +815,57 @@
 exec:aCommandPath withArguments:argArray fileDescriptors:fdArray closeDescriptors:closeFdArray fork:doFork newPgrp:newPgrp
     "combined fork & exec;
      If fork is false (chain a command):
-         execute the OS command specified by the argument, aCommandPath, with
-         arguments in argArray (no arguments, if nil).
-         If successful, this method does not return and smalltalk is gone.
-         If not successful, it does return.
-         Normal use is with forkForCommand.
+	 execute the OS command specified by the argument, aCommandPath, with
+	 arguments in argArray (no arguments, if nil).
+	 If successful, this method does not return and smalltalk is gone.
+	 If not successful, it does return.
+	 Normal use is with forkForCommand.
 
      If fork is true (subprocess command execution):
-        fork a child to do the above.
-        The process id of the child process is returned; nil if the fork failed.
+	fork a child to do the above.
+	The process id of the child process is returned; nil if the fork failed.
 
      fdArray contains the filedescriptors, to be used for the child (if fork is true).
-        fdArray[1] = 15 -> use fd 15 as stdin.
-        If an element of the array is set to nil, the corresponding filedescriptor
-        will be closed for the child.
-        fdArray[0] == StdIn for child
-        fdArray[1] == StdOut for child
-        fdArray[2] == StdErr for child
-        on VMS, these must be channels as returned by createMailBox.
+	fdArray[1] = 15 -> use fd 15 as stdin.
+	If an element of the array is set to nil, the corresponding filedescriptor
+	will be closed for the child.
+	fdArray[0] == StdIn for child
+	fdArray[1] == StdOut for child
+	fdArray[2] == StdErr for child
+	on VMS, these must be channels as returned by createMailBox.
 
      closeFdArray contains descriptors that will be closed in the subprocess.
-        closeDescriptors are ignored in the WIN32 & VMS versions.
+	closeDescriptors are ignored in the WIN32 & VMS versions.
 
      NOTE that in WIN32 the fds are HANDLES!!
 
      If newPgrp is true, the subprocess will be established in a new process group.
-        The processgroup will be equal to id.
-        newPgrp is not used on WIN32 and VMS systems.
+	The processgroup will be equal to id.
+	newPgrp is not used on WIN32 and VMS systems.
 
      Notice: this used to be two separate ST-methods; however, in order to use
-            vfork on some machines, it had to be merged into one, to avoid write
-            accesses to ST/X memory from the vforked-child.
-            The code below only does read accesses."
+	    vfork on some machines, it had to be merged into one, to avoid write
+	    accesses to ST/X memory from the vforked-child.
+	    The code below only does read accesses."
 
     ^ self
-        exec:aCommandPath 
-        withArguments:argArray
-        environment:nil 
-        fileDescriptors:fdArray 
-        closeDescriptors:closeFdArray
-        fork:doFork 
-        newPgrp:newPgrp
-        inDirectory:nil
+	exec:aCommandPath 
+	withArguments:argArray
+	environment:nil 
+	fileDescriptors:fdArray 
+	closeDescriptors:closeFdArray
+	fork:doFork 
+	newPgrp:newPgrp
+	inDirectory:nil
 
     "
      |id|
 
      id := OperatingSystem fork.
      id == 0 ifTrue:[
-        'I am the child'.
-        OperatingSystem exec:'/bin/ls' withArguments:#('ls' '/tmp').
-        'not reached'.
+	'I am the child'.
+	OperatingSystem exec:'/bin/ls' withArguments:#('ls' '/tmp').
+	'not reached'.
      ]
     "
     "
@@ -873,11 +873,11 @@
 
      id := OperatingSystem fork.
      id == 0 ifTrue:[
-        'I am the child'.
-        OperatingSystem
-           exec:'/bin/sh'
-           withArguments:#('sh' '-c' 'sleep 2;echo 1;sleep 2;echo 2').
-        'not reached'.
+	'I am the child'.
+	OperatingSystem
+	   exec:'/bin/sh'
+	   withArguments:#('sh' '-c' 'sleep 2;echo 1;sleep 2;echo 2').
+	'not reached'.
      ].
      id printNL.
      (Delay forSeconds:3.5) wait.
@@ -895,14 +895,14 @@
      Not needed with Unix"
 
     ^ self
-        exec:aCommandPath 
-        withArguments:argArray 
-        environment:nil
-        fileDescriptors:fdArray
-        closeDescriptors:closeFdArray 
-        fork:doFork 
-        newPgrp:newPgrp
-        inDirectory:aDirectory
+	exec:aCommandPath 
+	withArguments:argArray 
+	environment:nil
+	fileDescriptors:fdArray
+	closeDescriptors:closeFdArray 
+	fork:doFork 
+	newPgrp:newPgrp
+	inDirectory:aDirectory
 
     "Modified: / 12.11.1998 / 14:47:58 / cg"
     "Created: / 12.11.1998 / 14:49:18 / cg"
@@ -915,26 +915,26 @@
      (typically, the xterm window)"
 
     ^ self 
-        exec:aCommandPath 
-        withArguments:argArray 
-        environment:nil
-        fileDescriptors:nil
-        closeDescriptors:nil 
-        fork:doFork 
-        newPgrp:false
-        inDirectory:nil
+	exec:aCommandPath 
+	withArguments:argArray 
+	environment:nil
+	fileDescriptors:nil
+	closeDescriptors:nil 
+	fork:doFork 
+	newPgrp:false
+	inDirectory:nil
 
     "
      |id|
 
      id := OperatingSystem fork.
      id == 0 ifTrue:[
-        'I am the child'.
-        OperatingSystem 
-            exec:'/bin/ls' 
-            withArguments:#('ls' '/tmp')
-            fork:false.
-        'not reached'.
+	'I am the child'.
+	OperatingSystem 
+	    exec:'/bin/ls' 
+	    withArguments:#('ls' '/tmp')
+	    fork:false.
+	'not reached'.
      ]
     "
 
@@ -943,12 +943,12 @@
 
      id := OperatingSystem fork.
      id == 0 ifTrue:[
-        'I am the child'.
-        OperatingSystem 
-            exec:'/bin/sh' 
-            withArguments:#('sh' '-c' 'sleep 2;echo 1;sleep 2;echo 2')
-            fork:false.
-        'not reached'.
+	'I am the child'.
+	OperatingSystem 
+	    exec:'/bin/sh' 
+	    withArguments:#('sh' '-c' 'sleep 2;echo 1;sleep 2;echo 2')
+	    fork:false.
+	'not reached'.
      ].
      id printNL.
      (Delay forSeconds:3.5) wait.
@@ -968,26 +968,26 @@
      (typically, the xterm window)"
 
     ^ self 
-        exec:aCommandPath
-        withArguments:argArray
-        environment:nil
-        fileDescriptors:nil
-        closeDescriptors:nil
-        fork:doFork 
-        newPgrp:false
-        inDirectory:aDirectory
+	exec:aCommandPath
+	withArguments:argArray
+	environment:nil
+	fileDescriptors:nil
+	closeDescriptors:nil
+	fork:doFork 
+	newPgrp:false
+	inDirectory:aDirectory
 
     "
      |id|
 
      id := OperatingSystem fork.
      id == 0 ifTrue:[
-        'I am the child'.
-        OperatingSystem 
-            exec:'/bin/ls' 
-            withArguments:#('ls' '/tmp')
-            fork:false.
-        'not reached'.
+	'I am the child'.
+	OperatingSystem 
+	    exec:'/bin/ls' 
+	    withArguments:#('ls' '/tmp')
+	    fork:false.
+	'not reached'.
      ]
     "
 
@@ -996,12 +996,12 @@
 
      id := OperatingSystem fork.
      id == 0 ifTrue:[
-        'I am the child'.
-        OperatingSystem 
-            exec:'/bin/sh' 
-            withArguments:#('sh' '-c' 'sleep 2;echo 1;sleep 2;echo 2')
-            fork:false.
-        'not reached'.
+	'I am the child'.
+	OperatingSystem 
+	    exec:'/bin/sh' 
+	    withArguments:#('sh' '-c' 'sleep 2;echo 1;sleep 2;echo 2')
+	    fork:false.
+	'not reached'.
      ].
      id printNL.
      (Delay forSeconds:3.5) wait.
@@ -1031,12 +1031,12 @@
      Return true if successful, false otherwise."
 
      ^ self
-        executeCommand:aCommandString 
-        inputFrom:nil 
-        outputTo:nil 
-        errorTo:nil 
-        inDirectory:nil
-        onError:[:status| false]
+	executeCommand:aCommandString 
+	inputFrom:nil 
+	outputTo:nil 
+	errorTo:nil 
+	inDirectory:nil
+	onError:[:status| false]
 
     "unix:
 
@@ -1070,9 +1070,9 @@
      hardwiring any 'cd ..' command strings into your applictions."
 
      ^ self
-        executeCommand:aCommandString
-        onError:[:status| false]
-        inDirectory:aDirectory
+	executeCommand:aCommandString
+	onError:[:status| false]
+	inDirectory:aDirectory
 
     "
      OperatingSystem executeCommand:'tdump date.obj' inDirectory:'c:\winstx\stx\libbasic\objbc'. 
@@ -1099,46 +1099,46 @@
     sema := Semaphore new name:'OS command wait'.
 
     pid := Processor 
-                monitor:[
-                    self 
-                        startProcess:aCommandString
-                        inputFrom:anExternalInStream 
-                        outputTo:anExternalOutStream 
-                        errorTo:anExternalErrStream
-                        inDirectory:dirOrNil.
-                ] 
-                action:[:status |
-                    status stillAlive ifFalse:[
-                        exitStatus := status.
-                        self closePid:pid.
-                        sema signal
-                    ].
-                ].
+		monitor:[
+		    self 
+			startProcess:aCommandString
+			inputFrom:anExternalInStream 
+			outputTo:anExternalOutStream 
+			errorTo:anExternalErrStream
+			inDirectory:dirOrNil.
+		] 
+		action:[:status |
+		    status stillAlive ifFalse:[
+			exitStatus := status.
+			self closePid:pid.
+			sema signal
+		    ].
+		].
     pid notNil ifTrue:[
-        sema wait.
+	sema wait.
     ] ifFalse:[
-        exitStatus := self osProcessStatusClass processCreationFailure.
+	exitStatus := self osProcessStatusClass processCreationFailure.
     ].
 
     exitStatus success ifFalse:[
-        ^ aBlock value:exitStatus
+	^ aBlock value:exitStatus
     ].
     ^ true.
 
     "
-        OperatingSystem
-            executeCommand:'dir'
-            inputFrom:nil
-            outputTo:nil
-            errorTo:nil
-            onError:[:status | Transcript flash]
+	OperatingSystem
+	    executeCommand:'dir'
+	    inputFrom:nil
+	    outputTo:nil
+	    errorTo:nil
+	    onError:[:status | Transcript flash]
         
-        OperatingSystem
-            executeCommand:'foo'
-            inputFrom:nil
-            outputTo:nil
-            errorTo:nil
-            onError:[:status | Transcript flash]
+	OperatingSystem
+	    executeCommand:'foo'
+	    inputFrom:nil
+	    outputTo:nil
+	    errorTo:nil
+	    onError:[:status | Transcript flash]
     "
 
     "Modified: / 25.3.1997 / 11:02:02 / stefan"
@@ -1156,27 +1156,27 @@
      (containing the exit status) as argument."
 
     ^ self
-        executeCommand:aCommandString 
-        inputFrom:anExternalInStream 
-        outputTo:anExternalOutStream 
-        errorTo:anExternalErrStream 
-        inDirectory:nil
-        onError:aBlock
+	executeCommand:aCommandString 
+	inputFrom:anExternalInStream 
+	outputTo:anExternalOutStream 
+	errorTo:anExternalErrStream 
+	inDirectory:nil
+	onError:aBlock
 
     "
-        OperatingSystem
-            executeCommand:'dir'
-            inputFrom:nil
-            outputTo:nil
-            errorTo:nil
-            onError:[:status | Transcript flash]
+	OperatingSystem
+	    executeCommand:'dir'
+	    inputFrom:nil
+	    outputTo:nil
+	    errorTo:nil
+	    onError:[:status | Transcript flash]
         
-        OperatingSystem
-            executeCommand:'foo'
-            inputFrom:nil
-            outputTo:nil
-            errorTo:nil
-            onError:[:status | Transcript flash]
+	OperatingSystem
+	    executeCommand:'foo'
+	    inputFrom:nil
+	    outputTo:nil
+	    errorTo:nil
+	    onError:[:status | Transcript flash]
     "
 
     "Modified: / 10.11.1998 / 20:51:39 / cg"
@@ -1191,12 +1191,12 @@
      (containing the exit status) as argument."
 
     ^ self
-        executeCommand:aCommandString 
-        inputFrom:nil 
-        outputTo:nil 
-        errorTo:nil 
-        inDirectory:nil
-        onError:aBlock
+	executeCommand:aCommandString 
+	inputFrom:nil 
+	outputTo:nil 
+	errorTo:nil 
+	inDirectory:nil
+	onError:aBlock
 
     "unix:
 
@@ -1226,12 +1226,12 @@
      (containing the exit status) as argument."
 
     ^ self
-        executeCommand:aCommandString 
-        inputFrom:nil 
-        outputTo:nil 
-        errorTo:nil 
-        inDirectory:aDirectory
-        onError:aBlock
+	executeCommand:aCommandString 
+	inputFrom:nil 
+	outputTo:nil 
+	errorTo:nil 
+	inDirectory:aDirectory
+	onError:aBlock
 
     "Modified: / 10.11.1998 / 20:54:37 / cg"
 !
@@ -1340,11 +1340,11 @@
      or #killProcess: to stop it."
 
     ^ self
-        startProcess:aCommandString 
-        inputFrom:nil 
-        outputTo:nil 
-        errorTo:nil 
-        inDirectory:nil
+	startProcess:aCommandString 
+	inputFrom:nil 
+	outputTo:nil 
+	errorTo:nil 
+	inDirectory:nil
 
     "
      |pid|
@@ -1364,11 +1364,11 @@
      |pid|
 
      pid := OperatingSystem 
-                startProcess:'dir/l'
-                inputFrom:nil
-                outputTo:Stdout
-                errorTo:nil
-                inDirectory:nil.
+		startProcess:'dir/l'
+		inputFrom:nil
+		outputTo:Stdout
+		errorTo:nil
+		inDirectory:nil.
      (Delay forSeconds:2) wait.
      OperatingSystem killProcess:pid.
     "
@@ -1387,11 +1387,11 @@
      or #killProcess: to stop it."
 
     ^ self
-        startProcess:aCommandString 
-        inputFrom:nil 
-        outputTo:nil 
-        errorTo:nil 
-        inDirectory:aDirectory
+	startProcess:aCommandString 
+	inputFrom:nil 
+	outputTo:nil 
+	errorTo:nil 
+	inDirectory:aDirectory
     "
      |pid|
 
@@ -1417,11 +1417,11 @@
      or #killProcess: to stop it."
 
      ^ self     
-        startProcess:aCommandString 
-        inputFrom:anExternalInStream 
-        outputTo:anExternalOutStream 
-        errorTo:anExternalErrStream 
-        inDirectory:nil
+	startProcess:aCommandString 
+	inputFrom:anExternalInStream 
+	outputTo:anExternalOutStream 
+	errorTo:anExternalErrStream 
+	inDirectory:nil
 
     "Modified: / 10.11.1998 / 20:59:05 / cg"
 !
@@ -2349,6 +2349,61 @@
     "
 ! !
 
+!AbstractOperatingSystem class methodsFor:'path queries'!
+
+defaultSystemPath
+    "return a default systemPath - thats a collection of
+     dirnames, where ST/X searches for its files.
+     This method is redefined in concrete OS's to add
+     OS-specific directory names."
+
+    |sysPath p homePath userPrivateSTXDir|
+
+    "
+     the path is set to search files first locally
+     - this allows private stuff to override global stuff
+    "
+    sysPath := OrderedCollection new.
+
+    "/
+    "/ the current (default) directory
+    "/
+    sysPath add:(Filename currentDirectory name).
+
+    "/
+    "/ the users home (login) directory
+    "/
+    homePath := OperatingSystem getHomeDirectory.
+    homePath notNil ifTrue:[
+	sysPath add:homePath.
+    ].
+
+    "/
+    "/ a users private smalltalk directory in its home (login) directory
+    "/
+    OperatingSystem isUNIXlike ifTrue:[
+	userPrivateSTXDir := homePath asFilename constructString:'.smalltalk'.
+    ] ifFalse:[
+	userPrivateSTXDir := homePath asFilename constructString:'smalltalk'.
+    ].
+    (userPrivateSTXDir asFilename isDirectory) ifTrue:[
+	sysPath add:userPrivateSTXDir
+    ].
+
+    "/
+    "/ SMALLTALK_LIBDIR and/or STX_LIBDIR from the environment
+    "/
+    p := OperatingSystem getEnvironment:'SMALLTALK_LIBDIR'.
+    p notNil ifTrue:[
+	sysPath add:p
+    ].
+    p := OperatingSystem getEnvironment:'STX_LIBDIR'.
+    p notNil ifTrue:[
+	sysPath add:p
+    ].
+    ^ sysPath
+! !
+
 !AbstractOperatingSystem class methodsFor:'os queries'!
 
 getCCDefine
@@ -3633,6 +3688,6 @@
 !AbstractOperatingSystem class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic/AbstractOperatingSystem.st,v 1.12 1998-12-11 15:35:32 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/AbstractOperatingSystem.st,v 1.13 1999-02-25 19:17:24 cg Exp $'
 ! !
 AbstractOperatingSystem initialize!