Mercurial Mercurial > hg > stx-libbasic / diff
summary | shortlog | changelog | graph | tags | bookmarks | branches | files | changeset | file | latest | revisions | annotate | diff | comparison | raw | help
Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Win32OperatingSystem.st
changeset 3927 028ca7c70ac9
parent 3902 39c11e93056a
child 3946 bdb1c55980c1 
--- a/Win32OperatingSystem.st	Wed Nov 11 16:02:35 1998 +0100
+++ b/Win32OperatingSystem.st	Wed Nov 11 16:09:46 1998 +0100
@@ -2396,227 +2396,58 @@
     "Modified: / 11.9.1998 / 19:03:55 / cg"
 !
 
-exec:aCommandPath withArguments:argArray fileDescriptors:fdArray closeDescriptors:closeFdArray fork:doFork newPgrp:newPgrp
-    "Internal lowLevel entry for combined fork & exec;
+exec:aCommandPath withArguments:argArray fileDescriptors:fdArray closeDescriptors:closeFdArray fork:doFork newPgrp:newPgrp inDirectory:aDirectory
+    "Internal lowLevel entry for combined fork & exec for WIN32
+
      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.
-
-     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."
-
-    ^ self 
-	exec:aCommandPath 
-	withArguments:argArray 
-	fileDescriptors:fdArray
-	closeDescriptors:closeFdArray 
-	fork:doFork 
-	newPgrp:newPgrp 
-	inDirectory:nil.
-!
-
-exec:aCommandPath withArguments:argArray fileDescriptors:fdArray closeDescriptors:closeFdArray fork:doFork newPgrp:newPgrp inDirectory:aDirectory
-    "Internal lowLevel entry for combined fork & exec for WIN32"
+        The processgroup will be equal to id.
+        newPgrp is not used on WIN32 and VMS systems."
 
     |path|
-    aDirectory isNil ifTrue:[
-      path := nil.
-    ] ifFalse:[
-      path := aDirectory asFilename pathName asFilename osNameForDirectory.
-      (path endsWith:':') ifTrue:[
-	 path := path , '\'.
-      ].
-    ].
-    ^ self 
-	primExec:aCommandPath 
-	withArguments:argArray 
-	fileDescriptors:fdArray 
-	closeDescriptors:closeFdArray 
-	fork:doFork 
-	newPgrp:newPgrp 
-	inPath:path
-
-    "Modified: 31.1.1998 / 10:54:24 / md"
-!
-
-executeCommand:aCommandString inDirectory:aDirectory
-    "much like #executeCommand:, but changes the current directory
-     for the command. Since this is OS specific, use this instead of
-     hardwiring any 'cd ..' command strings into your applictions."
-
-     ^ self
-	executeCommand:aCommandString
-	onError:[:status| false]
-	inDirectory:aDirectory
-
-    "
-     OperatingSystem executeCommand:'tdump date.obj' inDirectory:'c:\winstx\stx\libbasic\objbc'. 
-     OperatingSystem executeCommand:'xxdir date.obj' inDirectory:'c:\winstx\stx\libbasic\objbc'. 
-    "
-
-    "Modified: / 20.1.1998 / 17:03:03 / md"
-    "Modified: / 11.9.1998 / 18:52:36 / cg"
-!
-
-executeCommand:aCommandString inputFrom:anExternalInStream outputTo:anExternalOutStream errorTo:anExternalErrStream onError:aBlock
-    "execute the unix command specified by the argument, aCommandString.
-     The commandString is passed to a shell for execution - see the description of
-     'sh -c' in your UNIX manual.
-     Return true if successful.
-     If not successfull, aBlock is called with an OsProcessStatus
-     (containing the exit status) as argument."
-
-    |pid exitStatus sema|
-
-    sema := Semaphore new name:'Unix command wait'.
-
-    pid := Processor 
-		monitor:[
-		    self 
-			startProcess:aCommandString
-			inputFrom:anExternalInStream 
-			outputTo:anExternalOutStream 
-			errorTo:anExternalErrStream.
-		] 
-		action:[:status |
-		    status stillAlive ifFalse:[
-			exitStatus := status.
-			self closePid:pid.
-			sema signal
-		    ].
-		].
-    pid notNil ifTrue:[
-	sema wait.
-    ] ifFalse:[
-	exitStatus := OSProcessStatus processCreationFailure.
-    ].
-
-    exitStatus success ifFalse:[
-	^ aBlock value:exitStatus
+
+    aDirectory notNil ifTrue:[
+        path := aDirectory asFilename asAbsoluteFilename osNameForDirectory.
+        (path endsWith:':') ifTrue:[
+            path := path , '\'.
+        ].
     ].
-    ^ true.
-
-    "Modified: 25.3.1997 / 11:02:02 / stefan"
-    "Modified: 19.4.1997 / 18:15:04 / cg"
-    "Modified: 28.1.1998 / 14:46:36 / md"
-!
-
-executeCommand:aCommandString onError:aBlock
-    "execute the unix command specified by the argument, aCommandString.
-     The commandString is passed to a shell for execution - see the description of
-     'sh -c' in your UNIX manual.
-     Return true if successful.
-     If not successfull, aBlock is called with an OsProcessStatus
-     (containing the exit status) as argument."
-
-    |pid exitStatus sema|
-
-    sema := Semaphore new name:'OS command wait'.
-
-    pid := Processor 
-		monitor:[self startProcess:aCommandString] 
-		action:[:status |
-			status stillAlive ifFalse:[
-			    exitStatus := status.
-			    self closePid:pid.
-			    sema signal
-			].
-		].
-    pid notNil ifTrue:[
-	sema wait.
-    ] ifFalse:[
-	exitStatus := OSProcessStatus processCreationFailure.
-    ].
-
-    exitStatus success ifFalse:[
-	^ aBlock value:exitStatus
-    ].
-    ^ true.
-
-
-    "
-     OperatingSystem executeCommand:'sleep 30' onError:[]. 
-     OperatingSystem executeCommand:'pwd' onError:[:status|status inspect]. 
-     OperatingSystem executeCommand:'ls -l' onError:[]. 
-     OperatingSystem executeCommand:'invalidCommand' onError:[:status| status inspect]. 
-     OperatingSystem executeCommand:'rm /tmp/foofoofoofoo'onError:[:status | status inspect]. 
-    "
-
-    "Created: 22.12.1995 / 14:49:59 / stefan"
-    "Modified: 25.3.1997 / 11:06:43 / stefan"
-    "Modified: 19.4.1997 / 18:14:41 / cg"
-    "Modified: 28.1.1998 / 14:46:56 / md"
-!
-
-executeCommand:aCommandString onError:aBlock inDirectory:aDirectory
-    "execute the unix command specified by the argument, aCommandString.
-     The commandString is passed to a shell for execution - see the description of
-     'sh -c' in your UNIX manual.
-     Return true if successful.
-     If not successfull, aBlock is called with an OsProcessStatus
-     (containing the exit status) as argument."
-
-    |pid exitStatus sema|
-
-    sema := Semaphore new name:'OS command wait'.
-
-    pid := Processor
-		monitor:[self startProcess:aCommandString inDirectory:aDirectory]
-		action:[:status |
-			status stillAlive ifFalse:[
-			    exitStatus := status.
-			    self closePid:pid.
-			    sema signal
-			].
-		].
-    pid notNil ifTrue:[
-	sema wait.
-    ] ifFalse:[
-	exitStatus := OSProcessStatus processCreationFailure.
-    ].
-
-    exitStatus success ifFalse:[
-	^ aBlock value:exitStatus
-    ].
-    ^ true.
-
-
-    "
-     OperatingSystem executeCommand:'sleep 30' onError:[]. 
-     OperatingSystem executeCommand:'pwd' onError:[:status|status inspect]. 
-     OperatingSystem executeCommand:'ls -l' onError:[]. 
-     OperatingSystem executeCommand:'invalidCommand' onError:[:status| status inspect]. 
-     OperatingSystem executeCommand:'rm /tmp/foofoofoofoo'onError:[:status | status inspect]. 
-    "
-
-    "Created: 28.1.1998 / 14:12:15 / md"
+
+    ^ self 
+        primExec:aCommandPath 
+        withArguments:argArray 
+        fileDescriptors:fdArray 
+        closeDescriptors:closeFdArray 
+        fork:doFork 
+        newPgrp:newPgrp 
+        inPath:path
+
+    "Modified: / 31.1.1998 / 10:54:24 / md"
+    "Modified: / 10.11.1998 / 20:44:24 / cg"
 !
 
 getStatusOfProcess:aProcessId
@@ -2870,7 +2701,7 @@
     ^ self primitiveFailed
 !
 
-startProcess:aCommandString inputFrom:anExternalInStream outputTo:anExternalOutStream errorTo:anExternalErrStream
+startProcess:aCommandString inputFrom:anExternalInStream outputTo:anExternalOutStream errorTo:anExternalErrStream inDirectory:dirOrNil
     "start executing the OS command as specified by the argument, aCommandString
      as a separate process; do not wait for the command to finish.
      The commandString is passed to a shell for execution - see the description of
@@ -2884,56 +2715,27 @@
     |in out err shellAndArgs|
 
     anExternalInStream notNil ifTrue:[
-	in := anExternalInStream fileDescriptor.
+        in := anExternalInStream fileDescriptor.
     ].
     anExternalOutStream notNil ifTrue:[
-	out := anExternalOutStream fileDescriptor.
+        out := anExternalOutStream fileDescriptor.
     ].
     anExternalErrStream notNil ifTrue:[
-	err := anExternalErrStream fileDescriptor.
+        err := anExternalErrStream fileDescriptor.
     ].
 
     shellAndArgs := self commandAndArgsForOSCommand:aCommandString.
     ^ self
-	exec:(shellAndArgs at:1)
-	withArguments:(shellAndArgs at:2)
-	fileDescriptors:(Array with:in with:out with:err)
-	closeDescriptors:nil
-	fork:true
-	newPgrp:false.
-
-    "blocking at current prio (i.e. only higher prio threads execute):
-
-     OperatingSystem executeCommand:'dir'.
-    "
-
-    "non-blocking (lower prio threads continue):
-
-     |in out err pid sema|
-
-     in := 'out' asFilename readStream.
-     out := 'out2' asFilename writeStream.
-     err := 'err' asFilename writeStream.
-
-     sema := Semaphore new.
-     pid := OperatingSystem startProcess:'grep drw' inputFrom:in outputTo:out errorTo:err.
-
-     The following will no longer work. monitorPid has disappeared 
-
-     pid notNil ifTrue:[
-	 Processor monitorPid:pid action:[:OSstatus | sema signal ].
-     ].
-     in close.
-     out close.
-     err close.
-     sema wait.
-     Transcript showCR:'finished'
-    "
-
-    "Created: 29.2.1996 / 12:31:29 / cg"
-    "Modified: 21.3.1997 / 10:04:35 / dq"
-    "Modified: 2.5.1997 / 12:18:20 / cg"
-    "Modified: 15.7.1997 / 16:03:51 / stefan"
+        exec:(shellAndArgs at:1)
+        withArguments:(shellAndArgs at:2)
+        fileDescriptors:(Array with:in with:out with:err)
+        closeDescriptors:nil
+        fork:true
+        newPgrp:false
+        inDirectory:dirOrNil
+
+    "Modified: / 10.11.1998 / 20:43:12 / cg"
+    "Created: / 10.11.1998 / 20:48:35 / cg"
 ! !
 
 !Win32OperatingSystem class methodsFor:'file access'!
@@ -6851,6 +6653,6 @@
 !Win32OperatingSystem class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic/Win32OperatingSystem.st,v 1.34 1998-10-29 12:27:26 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/Win32OperatingSystem.st,v 1.35 1998-11-11 15:09:11 cg Exp $'
 ! !
 Win32OperatingSystem initialize!
hg/stx-libbasic