--- a/AbstractOperatingSystem.st Tue Feb 04 21:09:59 2014 +0100
+++ b/AbstractOperatingSystem.st Wed Apr 01 10:20:10 2015 +0100
@@ -1,3 +1,5 @@
+"{ Encoding: utf8 }"
+
"
COPYRIGHT (c) 1988 by Claus Gittinger
All Rights Reserved
@@ -11,6 +13,8 @@
"
"{ Package: 'stx:libbasic' }"
+"{ NameSpace: Smalltalk }"
+
Object subclass:#AbstractOperatingSystem
instanceVariableNames:''
classVariableNames:'ConcreteClass LastErrorNumber LocaleInfo OSSignals PipeFailed
@@ -228,17 +232,18 @@
initialize
"initialize the class"
- self initializeConcreteClass.
-
+ "/ protect against double initialization
ErrorSignal isNil ifTrue:[
+ self initializeConcreteClass.
+
OSErrorHolder initialize.
ErrorSignal := OsError.
InvalidArgumentsSignal := OsInvalidArgumentsError.
AccessDeniedErrorSignal := OSErrorHolder noPermissionsSignal.
FileNotFoundErrorSignal := OSErrorHolder nonexistentSignal.
UnsupportedOperationSignal := OSErrorHolder unsupportedOperationSignal.
+ Smalltalk addDependent:self. "/ to catch language changes
].
- Smalltalk addDependent:self. "/ to catch language changes
!
initializeConcreteClass
@@ -601,58 +606,91 @@
!AbstractOperatingSystem class methodsFor:'dummy shell operations'!
openApplicationForDocument:aFilenameOrString operation:operationSymbol
- "open a windows-shell application to present the document contained in aFilenameOrString.
- This looks for the files extension, and is typically used to present help-files,
- html documents, pdf documents etc.
+ "open a windows-shell/mac finder/desktop application to present the document contained in aFilenameOrString.
+ This is typically used to present help-files, html documents, pdf documents etc.
+ operationSymbol is one of:
+ open
+ edit
+ explore
+ "
+
+ self
+ openApplicationForDocument:aFilenameOrString
+ operation:operationSymbol
+ mimeType:nil
+!
+
+openApplicationForDocument:aFilenameOrString operation:operationSymbol mimeType:mimeTypeStringArgOrNil
+ "open a windows-shell/mac finder/desktop application to present the document contained in aFilenameOrString.
+ This is typically used to present help-files, html documents, pdf documents etc.
operationSymbol is one of:
- open
- edit
- explore
- "
-
- self openApplicationForDocument:aFilenameOrString operation:operationSymbol mimeType:nil
-!
-
-openApplicationForDocument:aFilenameOrString operation:operationSymbol mimeType:mimeTypeStringArg
- "open a windows-shell application to present the document contained in aFilenameOrString.
- This looks for the files extension, and is typically used to present help-files,
- html documents, pdf documents etc.
+ open
+ edit
+ explore
+ mimeTypeStringArgOrNil is e.g. 'text/html' or: 'application/pdf'.
+ If nil is passed in, the file's suffix is used to guess the mime type.
+ "
+
+ self
+ openApplicationForDocument:aFilenameOrString
+ operation:operationSymbol
+ mimeType:mimeTypeStringArgOrNil
+ ifNone:[
+ "/ last resort: use a fileBrowser
+ UserPreferences fileBrowserClass openOn:aFilenameOrString
+ ].
+
+ "
+ self openApplicationForDocument: Filename currentDirectory operation:#open
+ self openApplicationForDocument: '..\..\doc\books\ArtOfSmalltalk\artMissing186187Fix1.pdf' asFilename operation:#open
+
+ self openApplicationForDocument: 'C:\WINDOWS\Help\clipbrd.chm' asFilename operation:#open
+ "
+
+ "Created: / 29-10-2010 / 12:16:38 / cg"
+ "Modified: / 05-02-2011 / 16:13:42 / cg"
+!
+
+openApplicationForDocument:aFilenameOrString operation:operationSymbol mimeType:mimeTypeStringArgOrNil ifNone:exceptionBlock
+ "open a windows-shell/mac finder/desktop application to present the document contained in aFilenameOrString.
+ This is typically used to present help-files, html documents, pdf documents etc.
operationSymbol is one of:
- open
- edit
- explore
- mimeTypeStringArg is e.g. 'text/html' or: 'application/pdf'
+ open
+ edit
+ explore
+ mimeTypeStringArgOrNil is e.g. 'text/html' or: 'application/pdf';
+ if nil is passed in, the file's suffix is used to guess it.
"
|openCommand mimeTypeString|
- mimeTypeString := mimeTypeStringArg.
+ mimeTypeString := mimeTypeStringArgOrNil.
MIMETypes notNil ifTrue:[
- mimeTypeString isNil ifTrue:[
- mimeTypeString := MIMETypes mimeTypeForFilename:aFilenameOrString.
- ].
- openCommand := MIMETypes defaultCommandTemplateToOpenMimeType:mimeTypeString.
+ mimeTypeString isNil ifTrue:[
+ mimeTypeString := MIMETypes mimeTypeForFilename:aFilenameOrString.
+ ].
+ mimeTypeString notNil ifTrue:[
+ openCommand := MIMETypes defaultCommandTemplateToOpenMimeType:mimeTypeString.
+ ].
].
openCommand notEmptyOrNil ifTrue:[
- (openCommand includesSubString:'%1') ifTrue:[
- openCommand := openCommand bindWith:aFilenameOrString asString.
- ] ifFalse:[
- openCommand := openCommand, ' "', aFilenameOrString asString, '"'.
- ].
-
- (self
- startProcess:openCommand
- inputFrom:nil outputTo:nil
- errorTo:nil auxFrom:nil
- environment:nil inDirectory:nil) notNil
- ifTrue:[
- ^ self.
- ].
+ (openCommand includesSubString:'%1') ifTrue:[
+ openCommand := openCommand bindWith:aFilenameOrString asString.
+ ] ifFalse:[
+ openCommand := openCommand, ' "', aFilenameOrString asString, '"'.
+ ].
+
+ (self
+ startProcess:openCommand
+ inputFrom:nil outputTo:nil
+ errorTo:nil auxFrom:nil
+ environment:nil inDirectory:nil) notNil
+ ifTrue:[
+ ^ self.
+ ].
].
-
- "/ last resort: use a fileBrowser
- UserPreferences current fileBrowserClass openOn:aFilenameOrString
+ exceptionBlock notNil ifTrue:[ exceptionBlock value ].
"
self openApplicationForDocument: Filename currentDirectory operation:#open
@@ -1050,8 +1088,11 @@
executeCommand:aCommandString
"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.
+ If aCommandString is a String, the commandString is passed to a shell for execution
+ - see the description of 'sh -c' in your UNIX manual ('cmd.com' in your MSDOS manual).
+ If aCommandString is an Array, the first element is the command to be executed,
+ and the other elements are the arguments to the command. No shell is invoked in this case.
+ Blocks until the command has finished.
Return true if successful, false otherwise."
^ self
@@ -1060,6 +1101,7 @@
outputTo:nil
errorTo:nil
auxFrom:nil
+ environment:nil
inDirectory:nil
lineWise:false
onError:[:status| false]
@@ -1092,8 +1134,10 @@
executeCommand:aCommandString errorTo:errorStream
"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.
+ If aCommandString is a String, the commandString is passed to a shell for execution
+ - see the description of 'sh -c' in your UNIX manual ('cmd.com' in your MSDOS manual).
+ If aCommandString is an Array, the first element is the command to be executed,
+ and the other elements are the arguments to the command. No shell is invoked in this case.
Return true if successful, false otherwise."
^ self
@@ -1102,6 +1146,7 @@
outputTo:nil
errorTo:errorStream
auxFrom:nil
+ environment:nil
inDirectory:nil
lineWise:false
onError:[:status| false]
@@ -1116,8 +1161,10 @@
executeCommand:aCommandString errorTo:errorStream 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.
+ If aCommandString is a String, the commandString is passed to a shell for execution
+ - see the description of 'sh -c' in your UNIX manual ('cmd.com' in your MSDOS manual).
+ If aCommandString is an Array, the first element is the command to be executed,
+ and the other elements are the arguments to the command. No shell is invoked in this case.
Return true if successful, false otherwise."
^ self
@@ -1126,6 +1173,7 @@
outputTo:nil
errorTo:errorStream
auxFrom:nil
+ environment:nil
inDirectory:aDirectory
lineWise:false
onError:[:status| false]
@@ -1142,8 +1190,10 @@
executeCommand:aCommandString 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.
+ If aCommandString is a String, the commandString is passed to a shell for execution
+ - see the description of 'sh -c' in your UNIX manual ('cmd.com' in your MSDOS manual).
+ If aCommandString is an Array, the first element is the command to be executed,
+ and the other elements are the arguments to the command. No shell is invoked in this case.
Return true if successful, false otherwise."
^ self
@@ -1152,6 +1202,7 @@
outputTo:nil
errorTo:nil
auxFrom:nil
+ environment:nil
inDirectory:aDirectory
lineWise:false
onError:[:exitStatus| false]
@@ -1161,8 +1212,10 @@
executeCommand:aCommandString inDirectory:aDirectory 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.
+ If aCommandString is a String, the commandString is passed to a shell for execution
+ - see the description of 'sh -c' in your UNIX manual ('cmd.com' in your MSDOS manual).
+ If aCommandString is an Array, the first element is the command to be executed,
+ and the other elements are the arguments to the command. No shell is invoked in this case.
Return true if successful, the value from aBlock if not.
If not successfull, aBlock is called with an OsProcessStatus
(containing the exit status) as argument."
@@ -1173,6 +1226,7 @@
outputTo:nil
errorTo:nil
auxFrom:nil
+ environment:nil
inDirectory:aDirectory
lineWise:false
onError:aBlock
@@ -1180,13 +1234,93 @@
"Modified: / 10.11.1998 / 20:54:37 / cg"
!
-executeCommand:aCommandString inputFrom:anInStream outputTo:anOutStream
+executeCommand:aCommandString inputFrom:anInStream outputTo:anOutStream errorTo:anErrStream
+ "execute the unix command specified by the argument, aCommandString.
+ If aCommandString is a String, the commandString is passed to a shell for execution
+ - see the description of 'sh -c' in your UNIX manual ('cmd.com' in your MSDOS manual).
+ If aCommandString is an Array, the first element is the command to be executed,
+ and the other elements are the arguments to the command. No shell is invoked in this case.
+ Return true if successful, false if not."
+
+ ^ self
+ executeCommand:aCommandString
+ inputFrom:anInStream
+ outputTo:anOutStream
+ errorTo:anErrStream
+ auxFrom:nil
+ environment:nil
+ inDirectory:nil
+ lineWise:false
+ onError:[:status | false]
+
+ "
+ OperatingSystem
+ executeCommand:'ls'
+ inputFrom:nil
+ outputTo:Transcript
+ errorTo:Transcript
+
+ |s|
+ s := WriteStream on:''.
+ (OperatingSystem
+ executeCommand:'ls'
+ inputFrom:nil
+ outputTo:s
+ errorTo:Transcript) ifTrue:[Transcript showCR:s contents]
+
+ OperatingSystem
+ executeCommand:'dir'
+ inputFrom:nil
+ outputTo:Transcript
+ errorTo:Transcript
+
+ OperatingSystem
+ executeCommand:'foo'
+ inputFrom:Transcript
+ outputTo:Transcript
+ errorTo:nil
+ "
+ "
+ |outStr errStr|
+
+ outStr := '' writeStream.
+ errStr := '' writeStream.
+ OperatingSystem
+ executeCommand:'ls'
+ inputFrom:nil
+ outputTo:outStr
+ errorTo:errStr
+ onError:[:status | Transcript flash].
+ Transcript show:'out:'; showCR:outStr contents.
+ Transcript show:'err:'; showCR:errStr contents.
+ "
+ "
+ |outStr errStr|
+
+ outStr := '' writeStream.
+ errStr := '' writeStream.
+ OperatingSystem
+ executeCommand:'ls /fooBar'
+ inputFrom:nil
+ outputTo:outStr
+ errorTo:errStr
+ onError:[:status | Transcript flash].
+ Transcript show:'out:'; showCR:outStr contents.
+ Transcript show:'err:'; showCR:errStr contents.
+ "
+
+ "Modified: / 10.11.1998 / 20:51:39 / cg"
+!
+
+executeCommand:aCommandStringOrArray inputFrom:anInStream outputTo:anOutStream
errorTo:anErrStream auxFrom:anAuxStream environment:environmentDictionary
inDirectory:dirOrNil lineWise:lineWise 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.
+ "execute the unix command specified by the argument, aCommandStringOrArray.
+ If aCommandString is a String, the commandString is passed to a shell for execution
+ - see the description of 'sh -c' in your UNIX manual ('cmd.com' in your MSDOS manual).
+ If aCommandString is an Array, the first element is the command to be executed,
+ and the other elements are the arguments to the command. No shell is invoked in this case.
Return true if successful, or the value of aBlock if not.
If not successfull, aBlock is called with an OsProcessStatus
(containing the exit status) as argument.
@@ -1199,241 +1333,255 @@
Set lineWise to true, if both error and output is sent to the same stream
and you don't want lines to be mangled. Set lineWise = false to
- avoid vlocking on pipes"
+ avoid blocking on pipes"
|pid exitStatus sema pIn pOut pErr pAux externalInStream externalOutStream externalErrStream externalAuxStream
shuffledInStream shuffledOutStream shuffledErrStream shuffledAuxStream
inputShufflerProcess outputShufflerProcess errorShufflerProcess auxShufflerProcess stopShufflers
- inStreamToClose outStreamToClose errStreamToClose auxStreamToClose terminateLock
+ inStreamToClose outStreamToClose errStreamToClose auxStreamToClose nullStream terminateLock
closeStreams|
terminateLock := Semaphore forMutualExclusion.
((externalInStream := anInStream) notNil
and:[externalInStream isExternalStream not]) ifTrue:[
- pIn := NonPositionableExternalStream makePipe.
- inStreamToClose := externalInStream := pIn at:1.
- shuffledInStream := pIn at:2.
- anInStream isBinary ifTrue:[
- shuffledInStream binary
- ].
- lineWise ifFalse:[
- shuffledInStream blocking:false.
- ].
-
- "/ start a reader process, shuffling data from the given
- "/ inStream to the pipe (which is connected to the commands input)
- inputShufflerProcess :=
- [
- [
- [anInStream atEnd] whileFalse:[
- self shuffleFrom:anInStream to:shuffledInStream lineWise:lineWise.
- shuffledInStream flush
- ]
- ] ensure:[
- shuffledInStream close
- ]
- ] newProcess
- name:'cmd input shuffler';
+ pIn := NonPositionableExternalStream makePipe.
+ inStreamToClose := externalInStream := pIn at:1.
+ shuffledInStream := pIn at:2.
+ anInStream isBinary ifTrue:[
+ shuffledInStream binary
+ ].
+ lineWise ifFalse:[
+ shuffledInStream blocking:false.
+ ].
+
+ "/ start a reader process, shuffling data from the given
+ "/ inStream to the pipe (which is connected to the commands input)
+ inputShufflerProcess :=
+ [
+ [
+ [anInStream atEnd] whileFalse:[
+ self shuffleFrom:anInStream to:shuffledInStream lineWise:lineWise.
+ shuffledInStream flush
+ ]
+ ] ensure:[
+ shuffledInStream close
+ ]
+ ] newProcess
+ name:'cmd input shuffler';
"/ beSystemProcess;
- resume.
+ resume.
].
((externalOutStream := anOutStream) notNil
and:[externalOutStream isExternalStream not]) ifTrue:[
- pOut := NonPositionableExternalStream makePipe.
- shuffledOutStream := (pOut at:1).
- anOutStream isBinary ifTrue:[
- shuffledOutStream binary
- ].
- outStreamToClose := externalOutStream := pOut at:2.
- outputShufflerProcess :=
- [
- WriteError handle:[:ex |
- "/ ignored
- ] do:[
- self shuffleAllFrom:shuffledOutStream to:anOutStream lineWise:lineWise lockWith:terminateLock.
- ].
- ] newProcess
- priority:(Processor userSchedulingPriority + 1);
- name:'cmd output shuffler';
+ pOut := NonPositionableExternalStream makePipe.
+ shuffledOutStream := (pOut at:1).
+ anOutStream isBinary ifTrue:[
+ shuffledOutStream binary
+ ].
+ outStreamToClose := externalOutStream := pOut at:2.
+ outputShufflerProcess :=
+ [
+ WriteError handle:[:ex |
+ "/ ignored
+ ] do:[
+ self shuffleAllFrom:shuffledOutStream to:anOutStream lineWise:lineWise lockWith:terminateLock.
+ ].
+ ] newProcess
+ priority:(Processor userSchedulingPriority + 1);
+ name:'cmd output shuffler';
"/ beSystemProcess;
- resume.
+ resume.
].
(externalErrStream := anErrStream) notNil ifTrue:[
- anErrStream == anOutStream ifTrue:[
- externalErrStream := externalOutStream
- ] ifFalse:[
- anErrStream isExternalStream ifFalse:[
- pErr := NonPositionableExternalStream makePipe.
- shuffledErrStream := (pErr at:1).
- anErrStream isBinary ifTrue:[
- shuffledErrStream binary
- ].
- errStreamToClose := externalErrStream := pErr at:2.
- errorShufflerProcess :=
- [
- self shuffleAllFrom:shuffledErrStream to:anErrStream lineWise:lineWise lockWith:terminateLock.
- ] newProcess
- priority:(Processor userSchedulingPriority + 2);
- name:'cmd err-output shuffler';
+ anErrStream == anOutStream ifTrue:[
+ externalErrStream := externalOutStream
+ ] ifFalse:[
+ anErrStream isExternalStream ifFalse:[
+ pErr := NonPositionableExternalStream makePipe.
+ shuffledErrStream := (pErr at:1).
+ anErrStream isBinary ifTrue:[
+ shuffledErrStream binary
+ ].
+ errStreamToClose := externalErrStream := pErr at:2.
+ errorShufflerProcess :=
+ [
+ self shuffleAllFrom:shuffledErrStream to:anErrStream lineWise:lineWise lockWith:terminateLock.
+ ] newProcess
+ priority:(Processor userSchedulingPriority + 2);
+ name:'cmd err-output shuffler';
"/ beSystemProcess;
- resume.
- ]
- ]
+ resume.
+ ]
+ ]
].
((externalAuxStream := anAuxStream) notNil
and:[externalAuxStream isExternalStream not]) ifTrue:[
- pAux := NonPositionableExternalStream makePipe.
- auxStreamToClose := externalAuxStream := pAux at:1.
- shuffledAuxStream := pAux at:2.
- shuffledAuxStream blocking:false.
- anAuxStream isBinary ifTrue:[
- shuffledAuxStream binary
- ].
-
- "/ start a reader process, shuffling data from the given
- "/ auxStream to the pipe (which is connected to the commands aux)
- auxShufflerProcess :=
- [
- [
- [anAuxStream atEnd] whileFalse:[
- self shuffleFrom:anAuxStream to:shuffledAuxStream lineWise:false.
- shuffledAuxStream flush
- ]
- ] ensure:[
- shuffledAuxStream close
- ]
- ] newProcess
- name:'cmd aux shuffler';
+ pAux := NonPositionableExternalStream makePipe.
+ auxStreamToClose := externalAuxStream := pAux at:1.
+ shuffledAuxStream := pAux at:2.
+ shuffledAuxStream blocking:false.
+ anAuxStream isBinary ifTrue:[
+ shuffledAuxStream binary
+ ].
+
+ "/ start a reader process, shuffling data from the given
+ "/ auxStream to the pipe (which is connected to the commands aux)
+ auxShufflerProcess :=
+ [
+ [
+ [anAuxStream atEnd] whileFalse:[
+ self shuffleFrom:anAuxStream to:shuffledAuxStream lineWise:false.
+ shuffledAuxStream flush
+ ]
+ ] ensure:[
+ shuffledAuxStream close
+ ]
+ ] newProcess
+ name:'cmd aux shuffler';
"/ beSystemProcess;
- resume.
+ resume.
].
stopShufflers := [:shuffleRest |
- inputShufflerProcess notNil ifTrue:[
- terminateLock critical:[inputShufflerProcess terminate].
- inputShufflerProcess waitUntilTerminated
- ].
- auxShufflerProcess notNil ifTrue:[
- terminateLock critical:[auxShufflerProcess terminate].
- auxShufflerProcess waitUntilTerminated
- ].
- outputShufflerProcess notNil ifTrue:[
- terminateLock critical:[outputShufflerProcess terminate].
- outputShufflerProcess waitUntilTerminated.
- shuffleRest ifTrue:[ self shuffleRestFrom:shuffledOutStream to:anOutStream lineWise:lineWise ].
- shuffledOutStream close.
- ].
- errorShufflerProcess notNil ifTrue:[
- terminateLock critical:[errorShufflerProcess terminate].
- errorShufflerProcess waitUntilTerminated.
- shuffleRest ifTrue:[ self shuffleRestFrom:shuffledErrStream to:anErrStream lineWise:lineWise ].
- shuffledErrStream close.
- ].
- ].
+ inputShufflerProcess notNil ifTrue:[
+ terminateLock critical:[inputShufflerProcess terminate].
+ inputShufflerProcess waitUntilTerminated
+ ].
+ auxShufflerProcess notNil ifTrue:[
+ terminateLock critical:[auxShufflerProcess terminate].
+ auxShufflerProcess waitUntilTerminated
+ ].
+ outputShufflerProcess notNil ifTrue:[
+ terminateLock critical:[outputShufflerProcess terminate].
+ outputShufflerProcess waitUntilTerminated.
+ shuffleRest ifTrue:[ self shuffleRestFrom:shuffledOutStream to:anOutStream lineWise:lineWise ].
+ shuffledOutStream close.
+ ].
+ errorShufflerProcess notNil ifTrue:[
+ terminateLock critical:[errorShufflerProcess terminate].
+ errorShufflerProcess waitUntilTerminated.
+ shuffleRest ifTrue:[ self shuffleRestFrom:shuffledErrStream to:anErrStream lineWise:lineWise ].
+ shuffledErrStream close.
+ ].
+ ].
closeStreams := [
- inStreamToClose notNil ifTrue:[
- inStreamToClose close
- ].
- errStreamToClose notNil ifTrue:[
- errStreamToClose close
- ].
- outStreamToClose notNil ifTrue:[
- outStreamToClose close
- ].
- auxStreamToClose notNil ifTrue:[
- auxStreamToClose close
- ].
- ].
+ inStreamToClose notNil ifTrue:[
+ inStreamToClose close
+ ].
+ errStreamToClose notNil ifTrue:[
+ errStreamToClose close
+ ].
+ outStreamToClose notNil ifTrue:[
+ outStreamToClose close
+ ].
+ auxStreamToClose notNil ifTrue:[
+ auxStreamToClose close
+ ].
+ nullStream notNil ifTrue:[
+ nullStream close
+ ].
+ ].
sema := Semaphore new name:'OS command wait'.
[
- pid := Processor
- monitor:[
- self
- startProcess:aCommandString
- inputFrom:externalInStream
- outputTo:externalOutStream
- errorTo:externalErrStream
- auxFrom:externalAuxStream
- environment:environmentDictionary
- inDirectory:dirOrNil
- ]
- action:[:status |
- status stillAlive ifFalse:[
- exitStatus := status.
- sema signal.
- self closePid:pid
- ]
- ].
-
- pid isNil ifTrue:[
- exitStatus := self osProcessStatusClass processCreationFailure
- ] ifFalse:[
- sema wait.
- ].
+ externalInStream isNil ifTrue:[
+ externalInStream := nullStream := Filename nullDevice readWriteStream.
+ ].
+ externalOutStream isNil ifTrue:[
+ nullStream isNil ifTrue:[nullStream := Filename nullDevice writeStream].
+ externalOutStream := nullStream.
+ ].
+ externalErrStream isNil ifTrue:[
+ externalErrStream := externalOutStream
+ ].
+
+ pid := Processor
+ monitor:[
+ self
+ startProcess:aCommandStringOrArray
+ inputFrom:externalInStream
+ outputTo:externalOutStream
+ errorTo:externalErrStream
+ auxFrom:externalAuxStream
+ environment:environmentDictionary
+ inDirectory:dirOrNil
+ ]
+ action:[:status |
+ status stillAlive ifFalse:[
+ exitStatus := status.
+ sema signal.
+ self closePid:pid
+ ]
+ ].
+
+ pid isNil ifTrue:[
+ exitStatus := self osProcessStatusClass processCreationFailure
+ ] ifFalse:[
+ sema wait.
+ ].
] ifCurtailed:[
- closeStreams value.
- pid notNil ifTrue:[
- "/ terminate the os-command (and all of its forked commands)
- self terminateProcessGroup:pid.
- self terminateProcess:pid.
- self closePid:pid.
- ].
- stopShufflers value:false.
+ closeStreams value.
+ pid notNil ifTrue:[
+ "/ terminate the os-command (and all of its forked commands)
+ self terminateProcessGroup:pid.
+ self terminateProcess:pid.
+ self closePid:pid.
+ ].
+ stopShufflers value:false.
].
closeStreams value.
stopShufflers value:true.
- exitStatus success ifFalse:[
- ^ aBlock value:exitStatus
+ (exitStatus isNil or:[exitStatus success]) ifFalse:[
+ ^ aBlock value:exitStatus
].
^ true
"
- |outStream errStream|
-
- outStream := '' writeStream.
-
- OperatingSystem executeCommand:'ls -l'
- inputFrom:'abc' readStream
- outputTo:outStream
- errorTo:nil
- inDirectory:nil
- lineWise:true
- onError:[:exitStatus | ^ false].
- outStream contents
- "
-
- "
- |outStream errStream|
-
- outStream := #[] writeStream.
-
- OperatingSystem executeCommand:'cat'
- inputFrom:(ByteArray new:5000000) readStream
- outputTo:outStream
- errorTo:nil
- inDirectory:nil
- lineWise:false
- onError:[:exitStatus | ^ false].
- outStream size
- "
-
- "
- |outStream errStream|
-
- outStream := '' writeStream.
-
- OperatingSystem executeCommand:'gpg -s --batch --no-tty --passphrase-fd 0 /tmp/passwd'
- inputFrom:'bla' readStream
- outputTo:outStream
- errorTo:nil
- inDirectory:nil
- lineWise:true
- onError:[:exitStatus | false].
- outStream contents
+ |outStream errStream|
+
+ outStream := '' writeStream.
+
+ OperatingSystem executeCommand:'ls -l'
+ inputFrom:'abc' readStream
+ outputTo:outStream
+ errorTo:nil
+ inDirectory:nil
+ lineWise:true
+ onError:[:exitStatus | ^ false].
+ outStream contents
+ "
+
+ "
+ |outStream errStream|
+
+ outStream := #[] writeStream.
+
+ OperatingSystem executeCommand:'cat'
+ inputFrom:(ByteArray new:5000000) readStream
+ outputTo:outStream
+ errorTo:nil
+ inDirectory:nil
+ lineWise:false
+ onError:[:exitStatus | ^ false].
+ outStream size
+ "
+
+ "
+ |outStream errStream|
+
+ outStream := '' writeStream.
+
+ OperatingSystem executeCommand:'gpg -s --batch --no-tty --passphrase-fd 0 /tmp/passwd'
+ inputFrom:'bla' readStream
+ outputTo:outStream
+ errorTo:nil
+ inDirectory:nil
+ lineWise:true
+ onError:[:exitStatus | false].
+ outStream contents
"
"Modified: / 11-02-2007 / 20:54:39 / cg"
@@ -1452,6 +1600,74 @@
onError:aBlock
!
+executeCommand:aCommandString inputFrom:anInStream outputTo:anOutStream errorTo:anErrStream environment:env onError:aBlock
+ "execute the unix command specified by the argument, aCommandString.
+ If aCommandString is a String, the commandString is passed to a shell for execution
+ - see the description of 'sh -c' in your UNIX manual ('cmd.com' in your MSDOS manual).
+ If aCommandString is an Array, the first element is the command to be executed,
+ and the other elements are the arguments to the command. No shell is invoked in this case.
+ Return true if successful, the value from aBlock if not.
+ If not successfull, aBlock is called with an OsProcessStatus
+ (containing the exit status) as argument."
+
+ ^ self
+ executeCommand:aCommandString
+ inputFrom:anInStream
+ outputTo:anOutStream
+ errorTo:anErrStream
+ auxFrom:nil
+ environment:env
+ inDirectory:nil
+ lineWise:false
+ onError:aBlock
+
+ "
+ 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]
+ "
+ "
+ |outStr errStr|
+
+ outStr := '' writeStream.
+ errStr := '' writeStream.
+ OperatingSystem
+ executeCommand:'ls'
+ inputFrom:nil
+ outputTo:outStr
+ errorTo:errStr
+ onError:[:status | Transcript flash].
+ Transcript show:'out:'; showCR:outStr contents.
+ Transcript show:'err:'; showCR:errStr contents.
+ "
+ "
+ |outStr errStr|
+
+ outStr := '' writeStream.
+ errStr := '' writeStream.
+ OperatingSystem
+ executeCommand:'ls /fooBar'
+ inputFrom:nil
+ outputTo:outStr
+ errorTo:errStr
+ onError:[:status | Transcript flash].
+ Transcript show:'out:'; showCR:outStr contents.
+ Transcript show:'err:'; showCR:errStr contents.
+ "
+
+ "Modified: / 10.11.1998 / 20:51:39 / cg"
+!
+
executeCommand:aCommandString inputFrom:inputStreamOrNil outputTo:outStreamOrNil errorTo:errStreamOrNil inDirectory:aDirectory
"much like #executeCommand:, but changes the current directory
for the command. Since this is OS specific, use this instead of
@@ -1463,6 +1679,7 @@
outputTo:outStreamOrNil
errorTo:errStreamOrNil
auxFrom:nil
+ environment:nil
inDirectory:aDirectory
lineWise:false
onError:[:status| false]
@@ -1481,8 +1698,10 @@
executeCommand:aCommandString inputFrom:anInStream outputTo:anOutStream errorTo:anErrStream inDirectory:dirOrNil lineWise:lineWise 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.
+ If aCommandString is a String, the commandString is passed to a shell for execution
+ - see the description of 'sh -c' in your UNIX manual ('cmd.com' in your MSDOS manual).
+ If aCommandString is an Array, the first element is the command to be executed,
+ and the other elements are the arguments to the command. No shell is invoked in this case.
Return true if successful, the value from aBlock if not.
If not successfull, aBlock is called with an OsProcessStatus
(containing the exit status) as argument.
@@ -1499,6 +1718,7 @@
outputTo:anOutStream
errorTo:anErrStream
auxFrom:nil
+ environment:nil
inDirectory:dirOrNil
lineWise:lineWise
onError:aBlock
@@ -1506,8 +1726,10 @@
executeCommand:aCommandString inputFrom:anInStream outputTo:anOutStream errorTo:anErrStream inDirectory:dirOrNil 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.
+ If aCommandString is a String, the commandString is passed to a shell for execution
+ - see the description of 'sh -c' in your UNIX manual ('cmd.com' in your MSDOS manual).
+ If aCommandString is an Array, the first element is the command to be executed,
+ and the other elements are the arguments to the command. No shell is invoked in this case.
Return true if successful, the value from aBlock if not.
If not successfull, aBlock is called with an OsProcessStatus
(containing the exit status) as argument.
@@ -1524,6 +1746,7 @@
outputTo:anOutStream
errorTo:anErrStream
auxFrom:nil
+ environment:nil
inDirectory:dirOrNil
lineWise:false
onError:aBlock
@@ -1574,8 +1797,10 @@
executeCommand:aCommandString inputFrom:anInStream outputTo:anOutStream errorTo:anErrStream 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.
+ If aCommandString is a String, the commandString is passed to a shell for execution
+ - see the description of 'sh -c' in your UNIX manual ('cmd.com' in your MSDOS manual).
+ If aCommandString is an Array, the first element is the command to be executed,
+ and the other elements are the arguments to the command. No shell is invoked in this case.
Return true if successful, the value from aBlock if not.
If not successfull, aBlock is called with an OsProcessStatus
(containing the exit status) as argument."
@@ -1586,6 +1811,7 @@
outputTo:anOutStream
errorTo:anErrStream
auxFrom:nil
+ environment:nil
inDirectory:nil
lineWise:false
onError:aBlock
@@ -1639,8 +1865,10 @@
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.
+ If aCommandString is a String, the commandString is passed to a shell for execution
+ - see the description of 'sh -c' in your UNIX manual ('cmd.com' in your MSDOS manual).
+ If aCommandString is an Array, the first element is the command to be executed,
+ and the other elements are the arguments to the command. No shell is invoked in this case.
Return true if successful, the value from aBlock if not.
If not successfull, aBlock is called with an OsProcessStatus
(containing the exit status) as argument."
@@ -1651,6 +1879,7 @@
outputTo:nil
errorTo:nil
auxFrom:nil
+ environment:nil
inDirectory:nil
lineWise:false
onError:aBlock
@@ -1674,36 +1903,12 @@
"Modified: / 10.11.1998 / 20:55:02 / cg"
!
-executeCommand:aCommandString onError:aBlock inDirectory:aDirectory
- "OBSOLETE for backward compatibility.
- 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, the value from aBlock if not.
- If not successfull, aBlock is called with an OsProcessStatus
- (containing the exit status) as argument."
-
- <resource:#obsolete>
-
- self obsoleteMethodWarning:'use executeCommand:inDirectory:onError:'.
-
- ^ self
- executeCommand:aCommandString
- inputFrom:nil
- outputTo:nil
- errorTo:nil
- auxFrom:nil
- inDirectory:aDirectory
- lineWise:false
- onError:aBlock
-
- "Modified: / 10.11.1998 / 20:54:37 / cg"
-!
-
executeCommand:aCommandString outputTo:anOutStreamOrNil
"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.
+ If aCommandString is a String, the commandString is passed to a shell for execution
+ - see the description of 'sh -c' in your UNIX manual ('cmd.com' in your MSDOS manual).
+ If aCommandString is an Array, the first element is the command to be executed,
+ and the other elements are the arguments to the command. No shell is invoked in this case.
Return true if successful, false otherwise."
^ self
@@ -1712,6 +1917,7 @@
outputTo:anOutStreamOrNil
errorTo:nil
auxFrom:nil
+ environment:nil
inDirectory:nil
lineWise:false
onError:[:status| false]
@@ -1742,6 +1948,7 @@
outputTo:outStreamOrNil
errorTo:errStreamOrNil
auxFrom:nil
+ environment:nil
inDirectory:aDirectory
lineWise:false
onError:[:status| false]
@@ -1769,6 +1976,7 @@
outputTo:outStreamOrNil
errorTo:nil
auxFrom:nil
+ environment:nil
inDirectory:aDirectory
lineWise:false
onError:[:status| false]
@@ -1826,30 +2034,30 @@
|result|
PipeFailed ~~ true ifTrue:[
- PipeStream openErrorSignal handle:[:ex |
- PipeFailed := true.
- 'OperatingSystem [warning]: cannot fork/popen' errorPrintCR.
- ex return.
- ] do:[
- |p line|
-
- p := PipeStream
- readingFrom:aCommand
- errorDisposition:errorDisposition
- inDirectory:nil.
- result := StringCollection new.
- [p atEnd] whileFalse:[
- line := p nextLine.
- (numLinesOrNil isNil
- or:[result size < numLinesOrNil]) ifTrue:[
- result add:line
- ].
- ].
- p close.
- (p exitStatus notNil and:[p exitStatus success]) ifFalse:[
- result := result asNilIfEmpty
- ].
- ].
+ PipeStream openErrorSignal handle:[:ex |
+ PipeFailed := true.
+ 'OperatingSystem [warning]: cannot fork/popen' errorPrintCR.
+ ex return.
+ ] do:[
+ |p line|
+
+ p := PipeStream
+ readingFrom:aCommand
+ errorDisposition:errorDisposition
+ inDirectory:nil.
+ result := StringCollection new.
+ [p atEnd] whileFalse:[
+ line := p nextLine.
+ (numLinesOrNil isNil
+ or:[result size < numLinesOrNil]) ifTrue:[
+ result add:line
+ ].
+ ].
+ p close.
+ (p exitStatus notNil and:[p exitStatus success]) ifFalse:[
+ result := result asNilIfEmpty
+ ].
+ ].
].
^ result
@@ -1949,11 +2157,18 @@
|path|
path := self pathOfCommand:(self nameOfSTXExecutable).
- self assert:(path notNil) message:'cannot figure out my executable''s path'.
+ path isNil ifTrue:[
+ './stx' asFilename exists ifTrue:[
+ path := './stx'
+ ].
+ ].
+ path isNil ifTrue:[
+ 'OperatingSystem [warning]: cannot figure out my executable''s path' infoPrintCR.
+ ].
^ path
"
- OperatingSystem pathOfSTXExecutable
+ OperatingSystem pathOfSTXExecutable
"
"Modified: / 20-01-2012 / 12:52:46 / cg"
@@ -2157,6 +2372,7 @@
!
linkFile:oldPath to:newPath
+ <resource: #obsolete>
"link the file 'oldPath' to 'newPath'. The link will be a hard link.
Return true if successful, false if not.
This method has been renamed - it remains in existance for
@@ -2282,6 +2498,17 @@
self subclassResponsibility
!
+sync
+ "sync the filesystems - redefined in subclasses"
+!
+
+syncFileSystem:handle
+ "sync the filesystem where the file represented by handle resides"
+
+ "default is to do a global sync"
+ self sync.
+!
+
truncateFile:aPathName to:newSize
"change a files size return true on success, false on failure.
This may not be supported on all architectures.
@@ -2544,6 +2771,30 @@
"Created: / 19.5.1999 / 12:24:59 / cg"
!
+getObjectFileInfoFor: aStringOrFilename
+ "Return and info object for given executable or shared object
+ or throw an error if given file is not a valid an executable now
+ shared object.
+
+ The info object returned is OS-specific, however it responds to at
+ least
+ #isFor32BitArchitecture
+ #isFor64BitArchitecture ... returns true, if the given object is for
+ 32bit, 64bit architecture respectively
+ "
+ ^ self subclassResponsibility
+
+ "Modified: / 26-03-2015 / 11:28:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+getTrashDirectory
+ "get the name of a trash folder (if the OS supports it),
+ or nil, if not.
+ Must be redefined to return non nil in concrete operating systems"
+
+ ^ nil
+!
+
idOf:aPathName
"return the fileNumber (i.e. inode number) of a file.
@@ -2571,7 +2822,7 @@
"return some object filled with info for the file 'aPathName';
the info (for which corresponding access methods are understood by
the returned object) is:
- type - a symbol giving the files type
+ type - a symbol giving the file's type
mode - numeric access mode
uid - owners user id
gid - owners group id
@@ -2704,6 +2955,15 @@
^ '..'
!
+pathNameForDrive:driveName
+ "given a drive name, return the pathname to open it as a directory.
+ For Windows, this is the driveName itself.
+ For OSX, '/Volumes' is prepended.
+ Other OSs might prepent the pount point (i.e. /mnt/)"
+
+ ^ driveName
+!
+
pathNameOf:pathName
"return the pathName of the argument, aPathString,
- thats the full pathname of the directory, starting at '/'.
@@ -3188,9 +3448,14 @@
!AbstractOperatingSystem class methodsFor:'misc'!
closePid:pid
- "free pid resource"
-
- self subclassResponsibility
+ "free pid resource.
+ Not required for Unix, but Windoze requires it."
+
+ ^ true.
+
+ "Created: / 28.1.1998 / 14:23:04 / md"
+ "Modified: / 28.1.1998 / 14:27:18 / md"
+ "Modified: / 5.6.1998 / 18:38:46 / cg"
!
exit
@@ -3270,6 +3535,33 @@
self obsoleteMethodWarning:'use asFilename baseName'.
^ aPath asFilename baseName
+!
+
+executeCommand:aCommandString onError:aBlock inDirectory:aDirectory
+ "OBSOLETE for backward compatibility.
+ 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, the value from aBlock if not.
+ If not successfull, aBlock is called with an OsProcessStatus
+ (containing the exit status) as argument."
+
+ <resource:#obsolete>
+
+ self obsoleteMethodWarning:'use executeCommand:inDirectory:onError:'.
+
+ ^ self
+ executeCommand:aCommandString
+ inputFrom:nil
+ outputTo:nil
+ errorTo:nil
+ auxFrom:nil
+ environment:nil
+ inDirectory:aDirectory
+ lineWise:false
+ onError:aBlock
+
+ "Modified: / 10.11.1998 / 20:54:37 / cg"
! !
!AbstractOperatingSystem class methodsFor:'os queries'!
@@ -3506,16 +3798,16 @@
!
getNetworkAddressInfo
- "return a Dictionary of network interface information.
- key -> name of interface
- value -> a Set of network address
- information for the interface - a dictionaries containing the
- information about the configuration of each interface in the system.
- The dictionary keys are:
- #address
- #netmask
- #flags
- #destAddress"
+ "return a Dictionary of network interface information.
+ key -> name of interface
+ value -> a Set of network address
+ information for the interface - a dictionaries containing the
+ information about the configuration of each interface in the system.
+ The dictionary keys are:
+ #address
+ #netmask
+ #flags
+ #destAddress"
^ self subclassResponsibility
!
@@ -3742,6 +4034,12 @@
# ifdef VMS
# define PLATFORM_DEFINE "-DVMS"
# endif
+# ifdef __osx__
+# define PLATFORM_DEFINE "-D__osx__"
+# endif
+# ifdef OSX
+# define PLATFORM_DEFINE "-DOSX"
+# endif
# ifndef PLATFORM_DEFINE
# define PLATFORM_DEFINE "-DUNIX"
# endif
@@ -3875,6 +4173,12 @@
^ false
!
+isLinuxLike
+ "return true, if the OS we're running on is a linux."
+
+ ^ false
+!
+
isMAClike
"return true, if running on a macOS (but not on A/UX or OS/X)"
@@ -3940,10 +4244,11 @@
^#(
win32
- os2 "/ actually - this is no longer true
- macos "/ actually - this is no longer true
- vms "/ actually - this is no longer true
- beos "/ actually - this was never true
+ os2 "/ actually - this is no longer true (OS/2 not supported)
+ macos "/ actually - this is no longer true (old MACOS not supported)
+ vms "/ actually - this is no longer true (VMS not supported)
+ beos "/ actually - this was never true (beos not supported)
+ osx "/ yes!! it is supported
unix
)
@@ -4016,6 +4321,7 @@
osID = #beos ifTrue:[ ^ '-DBEOS'].
osID = #vms ifTrue:[ ^ '-DVMS'].
osID = #unix ifTrue:[ ^ '-DUNIX'].
+ osID = #osx ifTrue:[ ^ '-DOSX'].
self error:'unknown os'.
"
@@ -4027,7 +4333,7 @@
platformName
"return a string describing the OS platform very we're running on.
- This returns #unix for all unix derivatives.
+ Except for osx, this returns #unix for all other unix derivatives.
I.e. it is much less specific than getOSType or getSystemType."
|os|
@@ -4035,6 +4341,7 @@
os := self getSystemType.
os = #win32 ifTrue:[ ^ #win32].
os = #os2 ifTrue:[ ^ #os2].
+ os = #osx ifTrue:[ ^ #osx].
os = #macos ifTrue:[ ^ #macos].
os = #VMS ifTrue:[ ^ #vms].
os = #openVMS ifTrue:[ ^ #vms].
@@ -4051,7 +4358,7 @@
randomBytesInto:bufferOrInteger
"If bufferOrInteger is a String or a ByteArray,
fill a given buffer with random bytes from the RtlGenRandom function
- and nswer the buffer.
+ and answer the buffer.
If bufferOrInteger is a SmallInteger,
return this many bytes (max 4) as a SmallInteger.
@@ -4201,7 +4508,7 @@
supportsVolumes
"return true, if the OS supports disk volumes.
- False is returned for UNIX, true for MSDOS and VMS"
+ False is returned for UNIX, true for MSDOS, VMS and OSX (which treats /Volumes as such)"
^ false
@@ -4210,21 +4517,29 @@
!AbstractOperatingSystem class methodsFor:'path queries'!
-decodePath:encodedPathName
- "decode the pathName as returned by system calls.
- E.g. linux system calls return sigle byte strings only,
- so the pathName has been UTF-8 decoded."
-
- ^ encodedPathName
+decodePath:encodedPathNameOrOutputLine
+ "decode the encodedPathNameOrOutputLine as returned by system calls or output by system commands.
+ E.g. linux system calls return single byte strings only,
+ so pathNames have been UTF-8 encoded."
+
+ ^ self decodePathOrCommandOutput:encodedPathNameOrOutputLine
+!
+
+decodePathOrCommandOutput:encodedPathNameOrOutputLine
+ "decode the encodedPathNameOrOutputLine as returned by system calls or output by system commands.
+ E.g. linux system calls return single byte strings only,
+ so pathNames have been UTF-8 encoded."
+
+ ^ encodedPathNameOrOutputLine
!
defaultPackagePath
- "return a default packagePath - thats a collection of
+ "return a default packagePath - that's a collection of
dirnames, where ST/X searches for its package subdirs.
This method might be redefined in concrete OS's to add
OS-specific directory names."
- |packagePath dirName homeDirName priv userPrivateSTXDir appDirName appDir topDirName|
+ |packagePath execPath dirName homeDirName priv userPrivateSTXDir appDir topDirName|
"
the path is set to search files first locally
@@ -4238,43 +4553,47 @@
"/
packagePath add:('.' "Filename currentDirectory pathName").
- "/
- "/ the executable's directory:
- "/ (/opt/stx/bin/stx -> /opt/stx/bin)
- "/
- appDirName := self pathOfSTXExecutable asFilename directory.
- (packagePath includes:appDirName) ifFalse:[
- packagePath add:appDirName.
- ].
-
- "/
- "/ the executable's parent directory:
- "/ (/opt/stx/bin/stx -> /opt/stx/packages)
- "/
- appDir := self pathOfSTXExecutable asFilename directory directory.
- dirName := appDir pathName.
- (packagePath includes:dirName) ifFalse:[
- packagePath add:dirName.
+ "/ accept the fact that sometimes, we cannot figure out, where I im
+ execPath := self pathOfSTXExecutable.
+ execPath notNil ifTrue:[
+ "/
+ "/ the executable's directory:
+ "/ (/opt/stx/bin/stx -> /opt/stx/bin)
+ "/
+ appDir := execPath asFilename directory.
+ (packagePath includes:appDir) ifFalse:[
+ packagePath add:appDir.
+ ].
+
+ "/
+ "/ the executable's parent directory:
+ "/ (/opt/stx/bin/stx -> /opt/stx)
+ "/
+ appDir := appDir directory.
+ dirName := appDir pathName.
+ (packagePath includes:dirName) ifFalse:[
+ packagePath add:dirName.
+ ].
].
homeDirName := OperatingSystem getHomeDirectory.
homeDirName notNil ifTrue:[
- "/
- "/ a users private smalltalk directory in its home (login) directory:
- "/ $HOME/.smalltalk/packages or $HOME\smalltalk\packages
- "/
- OperatingSystem isUNIXlike ifTrue:[
- priv := '.smalltalk'.
- ] ifFalse:[
- priv := 'smalltalk'.
- ].
- userPrivateSTXDir := homeDirName asFilename / priv.
- (userPrivateSTXDir isDirectory) ifTrue:[
- dirName := userPrivateSTXDir pathName.
- (packagePath includes:dirName) ifFalse:[
- packagePath add:dirName
- ]
- ].
+ "/
+ "/ a users private smalltalk directory in its home (login) directory:
+ "/ $HOME/.smalltalk/packages or $HOME\smalltalk\packages
+ "/
+ OperatingSystem isUNIXlike ifTrue:[
+ priv := '.smalltalk'.
+ ] ifFalse:[
+ priv := 'smalltalk'.
+ ].
+ userPrivateSTXDir := homeDirName asFilename / priv.
+ (userPrivateSTXDir isDirectory) ifTrue:[
+ dirName := userPrivateSTXDir pathName.
+ (packagePath includes:dirName) ifFalse:[
+ packagePath add:dirName
+ ]
+ ].
].
"/
@@ -4283,47 +4602,51 @@
"/
topDirName := OperatingSystem getEnvironment:'STX_TOPDIR'.
topDirName notNil ifTrue:[
- (packagePath includes:topDirName) ifFalse:[
- packagePath add:topDirName
- ].
+ (packagePath includes:topDirName) ifFalse:[
+ packagePath add:topDirName
+ ].
].
packagePath := packagePath select:[:each | (each asFilename / 'packages') exists]
- thenCollect:[:each | (each asFilename constructString:'packages')].
-
- "
- unconditionally prepend all directories from $STX_PACKAGEPATH
+ thenCollect:[:each | (each asFilename constructString:'packages')].
+
+ "
+ unconditionally prepend all directories from $STX_PACKAGEPATH
"
(dirName := OperatingSystem getEnvironment:'STX_PACKAGEPATH') notNil ifTrue:[
- dirName := dirName asCollectionOfSubstringsSeparatedBy:$:.
- dirName reverseDo:[:eachDirectoryName|
- (packagePath includes:eachDirectoryName) ifFalse:[
- packagePath addFirst:eachDirectoryName.
- ].
- ].
+ dirName := dirName asCollectionOfSubstringsSeparatedBy:$:.
+ dirName reverseDo:[:eachDirectoryName|
+ (packagePath includes:eachDirectoryName) ifFalse:[
+ packagePath addFirst:eachDirectoryName.
+ ].
+ ].
].
- "maybe the sources are kept in a central place..."
- (appDir / 'source') isDirectory ifTrue:[
- packagePath add:(appDir / 'source') pathName.
+false ifTrue:[
+ appDir notNil ifTrue:[
+ "maybe the sources are kept in a central place..."
+ (appDir / 'source') isDirectory ifTrue:[
+ packagePath add:(appDir / 'source') pathName.
+ ].
].
+].
"maybe we are running in the build environment: XXX/stx /projects /smalltalk
- or: XXX/exept /expecco /application
+ or: XXX/exept /expecco /application
- if XXX/stx/libbasic exists, add XXX to the package path"
-
+false ifTrue:[
topDirName isNil ifTrue:[
- "appdir is now: projects"
- appDir := appDir directory directory.
- (appDir / 'stx' / 'libbasic') isDirectory ifTrue:[
- appDir pathName = homeDirName ifTrue:[
- "but take care, it may be directly in the home directory"
- appDir := appDir / 'stx'.
- ].
- packagePath add:appDir pathName.
- ].
+ "appdir is now: projects"
+ appDir := appDir directory directory.
+ (appDir / 'stx' / 'libbasic') isDirectory ifTrue:[
+ appDir pathName = homeDirName ifTrue:[
+ "but take care, it may be directly in the home directory"
+ appDir := appDir / 'stx'.
+ ].
+ packagePath add:appDir pathName.
+ ].
].
-
+].
^ packagePath
"
@@ -4334,7 +4657,7 @@
!
defaultSystemPath
- "return a default systemPath - thats a collection of
+ "return a default systemPath - that's 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."
@@ -4626,6 +4949,18 @@
else if (aSymbolOrInteger == @symbol(AF_NETDES))
domainCode = __mkSmallInteger(AF_NETDES);
#endif
+#ifdef AF_CCITT
+ else if (aSymbolOrInteger == @symbol(AF_CCITT))
+ domainCode = __mkSmallInteger(AF_CCITT);
+#endif
+#ifdef AF_ISDN
+ else if (aSymbolOrInteger == @symbol(AF_ISDN))
+ domainCode = __mkSmallInteger(AF_ISDN);
+#endif
+#ifdef AF_SYSTEM
+ else if (aSymbolOrInteger == @symbol(AF_SYSTEM))
+ domainCode = __mkSmallInteger(AF_SYSTEM);
+#endif
%}.
^ domainCode.
@@ -4860,6 +5195,21 @@
domainSymbol = @symbol(AF_NETDES);
break;
#endif
+#ifdef AF_CCITT
+ case AF_CCITT:
+ domainSymbol = @symbol(AF_CCITT);
+ break;
+#endif
+#ifdef AF_ISDN
+ case AF_ISDN:
+ domainSymbol = @symbol(AF_ISDN);
+ break;
+#endif
+#ifdef AF_SYSTEM
+ case AF_SYSTEM:
+ domainSymbol = @symbol(AF_SYSTEM);
+ break;
+#endif
}
}
%}.
@@ -5233,6 +5583,22 @@
socketSize = __mkSmallInteger( sizeof(struct sockaddr_netdes) );
break;
#endif
+#ifdef WANT__AF_CCITT
+ case AF_CCITT:
+ socketSize = __mkSmallInteger( sizeof(struct sockaddr_ccitt) );
+ break;
+#endif
+#ifdef WANT__AF_ISDN
+ case AF_ISDN:
+ socketSize = __mkSmallInteger( sizeof(struct sockaddr_isdn) );
+ break;
+#endif
+#ifdef WANT__AF_SYSTEM
+ case AF_SYSTEM:
+ socketSize = __mkSmallInteger( sizeof(struct sockaddr_sys) );
+ break;
+#endif
+
}
}
%}.
@@ -5346,44 +5712,44 @@
(non-AF-prefixed) symbols; these will vanish."
^ #(
- #AF_INET
- #AF_UNIX
- #AF_INET6
- #AF_APPLETALK
- #AF_DECnet
- #AF_NS
- #AF_X25
- #AF_SNA
- #AF_RAW
- #AF_ISO
- #AF_ECMA
- #AF_NETBIOS
- #AF_IPX
- #AF_AX25
- #AF_NETROM
- #AF_BRIDGE
- #AF_BSC
- #AF_ROSE
- #AF_IRDA
- #AF_NETLINK
- #AF_NETLINK
- #AF_NETBEUI
- #AF_ATM
- #AF_ATMPVC
- #AF_ATMSVC
- #AF_BAN
- #AF_VOICEVIEW
- #AF_ECONET
- #AF_IMPLINK
- #AF_PUP
- #AF_CHAOS
- #AF_DLI
- #AF_LAT
- #AF_HYLINK
- #AF_FIREFOX
- #AF_CLUSTER
- #AF_12844
- #AF_NETDES
+ #AF_INET
+ #AF_UNIX
+ #AF_INET6
+ #AF_APPLETALK
+ #AF_DECnet
+ #AF_NS
+ #AF_X25
+ #AF_SNA
+ #AF_RAW
+ #AF_ISO
+ #AF_ECMA
+ #AF_NETBIOS
+ #AF_IPX
+ #AF_AX25
+ #AF_NETROM
+ #AF_BRIDGE
+ #AF_BSC
+ #AF_ROSE
+ #AF_IRDA
+ #AF_NETLINK
+ #AF_NETLINK
+ #AF_NETBEUI
+ #AF_ATM
+ #AF_ATMPVC
+ #AF_ATMSVC
+ #AF_BAN
+ #AF_VOICEVIEW
+ #AF_ECONET
+ #AF_IMPLINK
+ #AF_PUP
+ #AF_CHAOS
+ #AF_DLI
+ #AF_LAT
+ #AF_HYLINK
+ #AF_FIREFOX
+ #AF_CLUSTER
+ #AF_12844
+ #AF_NETDES
) select:[:sym | (AbstractOperatingSystem domainCodeOf:sym) isInteger ]
"
@@ -5464,18 +5830,44 @@
computeOSTimeFromUTCYear:y month:m day:d hour:h minute:min second:s millisecond:millis
"return the OS-dependent time for the given time and day.
- The arguments are assumed to be in UTC Time"
-
- self subclassResponsibility
-
- "Created: / 13.7.1999 / 12:44:03 / stefan"
-!
-
-computeOSTimeFromYear:y month:m day:d hour:h minute:min seconds:s millis:millis
+ The arguments are assumed to be in UTC time."
+
+ ^ self
+ computeOSTimeFromYear:y month:m day:d hour:h minute:min second:s millisecond:millis
+ utc:true
+
+ "
+ OperatingSystem computeOSTimeFromUTCYear:1970 month:1 day:1 hour:0 minute:0 second:0 millisecond:0
+ invalid:
+ OperatingSystem computeOSTimeFromUTCYear:1970 month:1 day:1 hour:24 minute:0 second:0 millisecond:0
+ "
+
+ "Modified: / 07-07-2010 / 16:56:21 / cg"
+!
+
+computeOSTimeFromYear:y month:m day:d hour:h minute:min second:s millisecond:millis
"return the OS-dependent time for the given time and day.
The arguments are assumed to be in localtime including
any daylight saving adjustings."
+ ^ self
+ computeOSTimeFromYear:y month:m day:d hour:h minute:min second:s millisecond:millis
+ utc:false
+
+ "
+ OperatingSystem computeOSTimeFromYear:1970 month:1 day:1 hour:0 minute:0 second:0 millisecond:0
+ invalid:
+ OperatingSystem computeOSTimeFromYear:1970 month:1 day:1 hour:24 minute:0 second:0 millisecond:0
+ "
+
+ "Modified: / 07-07-2010 / 16:56:21 / cg"
+!
+
+computeOSTimeFromYear:y month:m day:d hour:h minute:min second:s millisecond:millis utc:utcBoolean
+ "return the OS-dependent time for the given time and day.
+ If utcBoolean is true, the arguments are assumed to be in UTC Time;
+ otherwise in localtime including any daylight saving adjustings."
+
self subclassResponsibility
!
@@ -5486,11 +5878,7 @@
dayInYear (1..) and dayInWeek (1..).
Conversion is to localtime including any daylight saving adjustments."
- |divMod ret|
-
- divMod := osTime divMod:1000.
- ret := self timeInfoFromSeconds:(divMod at:1) milliseconds:(divMod at:2) localTime:true.
- ^ ret
+ ^ self timeInfoFromSeconds:(osTime // 1000) milliseconds:(osTime \\ 1000) localTime:true.
"
OperatingSystem computeTimeAndDateFrom:0
@@ -5540,11 +5928,7 @@
dayInWeek (1..).
Conversion is to utc."
- |divMod ret|
-
- divMod := osTime divMod:1000.
- ret := self timeInfoFromSeconds:(divMod at:1) milliseconds:(divMod at:2) localTime:false.
- ^ ret
+ ^ self timeInfoFromSeconds:(osTime // 1000) milliseconds:(osTime \\ 1000) localTime:false.
"
OperatingSystem computeUTCTimeAndDateFrom:0
@@ -5572,16 +5956,40 @@
aBlock value:hours value:minutes value:seconds value:millis
!
+epochEndOSTime
+ "private interface for timestamp to ask the OS what the maximum time
+ (in milliseconds since the Unix epoch, 1.1.1970) is.
+ Unix systems will return 0x7FFFFFFF here; other OS's may return a higher number to indicate,
+ that they can deal with timestamps after 2038 (especially: win32 will do so).
+ Notice that timestamp is prepared to compensate for any OS limitation by computing the timeInfo
+ components itself.
+ So it is usually (except for a little performane) no problem to return a reange too small here."
+
+ ^ 16r7FFFFFFF * 1000
+!
+
+epochStartOSTime
+ "private interface for timestamp to ask the OS what the minimum time
+ (in milliseconds since the Unix epoch, 1.1.1970) is.
+ Unix systems will return 0 here; other OS's may return a negative number to indicate,
+ that they can deal with timestamps before 1970 (especially: win32 will do so).
+ Notice that timestamp is prepared to compensate for any OS limitation by computing the timeInfo
+ components itself.
+ So it is usually (except for a little performane) no problem to return a reange too small here."
+
+ ^ 0
+!
+
getCPUCycleCount
"get a CPU specific cycle counter value.
Can be used for exact timing & performance measurements.
Notice, that the # of cycles has to be multiplied by the cycle time (1/cpu-frequency).
For x86:
- the CPU cycle count register value is returned (RDTSC instruction).
- Fails if RDTSC instruction is not supported (which is unlikely, nowadays).
+ the CPU cycle count register value is returned (RDTSC instruction).
+ Fails if RDTSC instruction is not supported (which is unlikely, nowadays).
For others:
- currently fails"
+ currently fails"
%{ /* NOCONTEXT */
unsigned INT low, high;
@@ -5690,7 +6098,10 @@
then := self millisecondTimeAdd:now and:millis.
[(delta := self millisecondTimeDeltaBetween:then and:now) > 0] whileTrue:[
- self selectOnAnyReadable:nil writable:nil exception:nil withTimeOut:delta.
+ self
+ selectOnAnyReadable:nil writable:nil exception:nil
+ readableInto:nil writableInto:nil exceptionInto:nil
+ withTimeOut:delta.
now := self getMillisecondTime.
]
@@ -5822,6 +6233,18 @@
An internal helper"
self subclassResponsibility
+!
+
+timeZoneInfoClass
+ ^ TimeZoneInfo
+!
+
+utcOffset
+ ^ (self computeTimeAndDateFrom:0) utcOffset
+
+ "
+ OperatingSystem utcOffset
+ "
! !
!AbstractOperatingSystem class methodsFor:'users & groups'!
@@ -6113,13 +6536,12 @@
].
result := self
- selectOnAnyReadable:(Array with:fd)
- writable:nil
- exception:nil
+ selectOnAnyReadable:(Array with:fd) writable:nil exception:nil
+ readableInto:nil writableInto:nil exceptionInto:nil
withTimeOut:0.
"on select error, a read will immediately return, so answer true"
- ^ result == fd or:[result == #error].
+ ^ result ~~ 0.
!
readWriteCheck:fd
@@ -6129,7 +6551,7 @@
This is actually only used with sockets, to wait for a connect to
be finished."
- |result|
+ |result fdArray|
self supportsSelect ifFalse:[
"/ mhmh - what should we do then ?
@@ -6140,26 +6562,29 @@
^ true
].
- result := self selectOnAnyReadable:(Array with:fd)
- writable:(Array with:fd)
- exception:nil
- withTimeOut:0.
-
- ^ result == fd or:[result == #error].
+ result := self
+ selectOnAnyReadable:(fdArray := Array with:fd) writable:fdArray exception:nil
+ readableInto:nil writableInto:nil exceptionInto:nil
+ withTimeOut:0.
+
+ "on select error, a read will immediately return, so answer true"
+ ^ result > 0.
!
selectOn:fd1 and:fd2 withTimeOut:millis
- <resource: #obsolete>
"wait for any fd to become ready; timeout after t milliseconds.
A zero timeout-time will immediately return (i.e. poll).
Return fd if i/o ok, nil if timed-out or interrupted.
Obsolete:
This is a leftover method and will vanish."
-
- ^ self selectOnAnyReadable:(Array with:fd1 with:fd2)
- writable:(Array with:fd1 with:fd2)
- exception:nil
- withTimeOut:millis
+ <resource: #obsolete>
+
+ |fdArray|
+
+ ^ (self
+ selectOnAnyReadable:(fdArray := Array with:fd1 with:fd2) writable:fdArray exception:nil
+ readableInto:nil writableInto:nil exceptionInto:nil
+ withTimeOut:millis) > 0.
!
selectOn:fd withTimeOut:millis
@@ -6169,10 +6594,12 @@
of read-data.
Experimental."
- ^ self selectOnAnyReadable:(Array with:fd)
- writable:(Array with:fd)
- exception:nil
- withTimeOut:millis
+ |fdArray|
+
+ ^ (self
+ selectOnAnyReadable:(fdArray := Array with:fd) writable:fdArray exception:nil
+ readableInto:nil writableInto:nil exceptionInto:nil
+ withTimeOut:millis) > 0.
!
selectOnAny:fdArray withTimeOut:millis
@@ -6181,10 +6608,19 @@
Return first ready fd if i/o ok, nil if timed-out or interrupted.
Experimental."
- ^ self selectOnAnyReadable:fdArray
- writable:fdArray
- exception:nil
- withTimeOut:millis
+ |resultFdArray nReady|
+
+ resultFdArray := Array new:1. "/ I am only interested in the first fd
+
+ nReady := self
+ selectOnAnyReadable:fdArray writable:fdArray exception:nil
+ readableInto:resultFdArray writableInto:resultFdArray exceptionInto:nil
+ withTimeOut:millis.
+ nReady > 0 ifTrue:[
+ ^ resultFdArray first.
+ ].
+
+ ^ nil
!
selectOnAnyReadable:fdArray withTimeOut:millis
@@ -6194,10 +6630,19 @@
Return first ready fd if i/o ok, nil if timed-out or interrupted.
Experimental."
- ^ self selectOnAnyReadable:fdArray
- writable:nil
- exception:nil
- withTimeOut:millis
+ |resultFdArray nReady|
+
+ resultFdArray := Array new:1. "/ I am only interested in the first fd
+
+ nReady := self
+ selectOnAnyReadable:fdArray writable:nil exception:nil
+ readableInto:resultFdArray writableInto:nil exceptionInto:nil
+ withTimeOut:millis.
+ nReady > 0 ifTrue:[
+ ^ resultFdArray first.
+ ].
+
+ ^ nil
!
selectOnAnyReadable:readFdArray writable:writeFdArray exception:exceptFdArray
@@ -6231,7 +6676,19 @@
descriptors (i.e. to check if I/O possible without blocking).
Return first ready fd if I/O ok, nil if timed-out or interrupted."
- self subclassResponsibility
+ |resultFdArray nReady|
+
+ resultFdArray := Array new:1. "/ I am only interested in the first fd
+
+ nReady := self
+ selectOnAnyReadable:readFdArray writable:writeFdArray exception:exceptFdArray
+ readableInto:resultFdArray writableInto:resultFdArray exceptionInto:resultFdArray
+ withTimeOut:millis.
+ nReady > 0 ifTrue:[
+ ^ resultFdArray first.
+ ].
+
+ ^ nil
!
setBlocking:aBoolean on:fd
@@ -6262,12 +6719,13 @@
^ true
].
- result := self selectOnAnyReadable:nil
- writable:(Array with:fd)
- exception:nil
- withTimeOut:0.
-
- ^ result == fd or:[result == #error].
+ result := self
+ selectOnAnyReadable:nil writable:(Array with:fd) exception:nil
+ readableInto:nil writableInto:nil exceptionInto:nil
+ withTimeOut:0.
+
+ "on select error, a read will immediately return, so answer true"
+ ^ result > 0.
! !
!AbstractOperatingSystem::PrinterInfo class methodsFor:'constants'!
@@ -6880,10 +7338,12 @@
!
dayInWeek
+ <resource: #obsolete>
^ dayInWeek
!
dayInYear
+ <resource: #obsolete>
"answer of compute the day of the year - if necessary
(it is not set in windows)"
@@ -6953,8 +7413,13 @@
^ utcOffset
"
- OperatingSystem utcOffset
- "
+ (OperatingSystem timeInfoFromSeconds:Timestamp now utcSecondsSince1970 milliseconds:0 localTime:true)
+ utcOffset
+ "
+!
+
+utcOffset:something
+ utcOffset := something.
!
year
@@ -7252,32 +7717,14 @@
standardMinute := standardMinuteArg.
! !
-!AbstractOperatingSystem::TimeZoneInfo methodsFor:'queries'!
-
-utcOffset
- "return the difference between UTC (Greenwich Mean Time) and the local time in seconds.
- If daylight saving time applies to ourself, take that into account.
- Add utcOffset to convert from local time to UTC time.
- Subtract utcOffset to convert from UTC time to local time.
-
- If utcOffset is negative, the local timezone is east of Greenwich.
- If utcOffset is positive, the local timezone is west of Greenwich."
-
- ^ (bias + daylightBias) * 60
-
- "
- OperatingSystem utcOffset
- "
-! !
-
!AbstractOperatingSystem class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/AbstractOperatingSystem.st,v 1.248 2014-01-28 19:37:53 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/AbstractOperatingSystem.st,v 1.295 2015-03-26 11:24:48 vrany Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/AbstractOperatingSystem.st,v 1.248 2014-01-28 19:37:53 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/AbstractOperatingSystem.st,v 1.295 2015-03-26 11:24:48 vrany Exp $'
! !