--- a/StandaloneStartup.st Tue Jul 29 14:47:42 2008 +0200
+++ b/StandaloneStartup.st Thu Jul 31 15:20:45 2008 +0200
@@ -18,6 +18,13 @@
category:'System-Support'
!
+StandaloneStartup class instanceVariableNames:'MutexHandle'
+
+"
+ No other class instance variables are inherited by this class.
+"
+!
+
!StandaloneStartup class methodsFor:'documentation'!
copyright
@@ -52,6 +59,12 @@
GetOpt
ReadEvalPrintLoop
"
+!
+
+howToDealWithMultipleApplicationInstances
+"
+ please read the comment in the corresponding ApplicationModel class-documentation method.
+"
! !
!StandaloneStartup class methodsFor:'initialization'!
@@ -78,6 +91,225 @@
"Modified: / 19-09-2006 / 16:30:27 / cg"
! !
+!StandaloneStartup class methodsFor:'multiple applications support'!
+
+applicationRegistryPath
+ "the key under which this application stores its process ID in the registry
+ as a collection of path-components.
+ i.e. if #('foo' 'bar' 'baz') is returned here, the current applications ID will be stored
+ in HKEY_CURRENT_USER\Software\foo\bar\baz\CurrentID.
+ (would also be used as a relative path for a temporary lock file under unix).
+ Used to detect if another instance of this application is already running."
+
+ self subclassResponsibility
+!
+
+applicationUUID
+ "answer an application-specific unique uuid.
+ This is used as the name of some exclusive OS-resource, which is used to find out,
+ if another instance of this application is already running.
+ Under win32, a mutex is used; under unix, an exclusive file in the tempDir could be used."
+
+ self subclassResponsibility
+!
+
+checkForAndExitIfAnotherApplicationInstanceIsRunning
+ "if another instance of this application is running,
+ send it an openFile command for my file-argument, and exit.
+ (i.e. to let the already running application open up another window)."
+
+ |shouldExit|
+
+ self isAnotherApplicationInstanceRunning ifTrue:[
+ shouldExit := self processStartupOfASecondInstance.
+ shouldExit ifTrue:[
+ self releaseApplicationMutex.
+ Smalltalk isStandAloneApp ifTrue:[
+ Smalltalk exit.
+ ]
+ ].
+ ].
+! !
+
+!StandaloneStartup class methodsFor:'multiple applications support-helpers'!
+
+applicationRegistryEntry
+ "retrieve the registry entry in which (if present), any currently running application
+ has left its process ID"
+
+ |path relPathName applicationEntry softwareEntry|
+
+ path := self applicationRegistryPath.
+ relPathName := path asStringWith:$\.
+ applicationEntry := Win32OperatingSystem registryEntry key:'HKEY_CURRENT_USER\Software\',relPathName.
+ applicationEntry isNil ifTrue:[
+ softwareEntry := Win32OperatingSystem registryEntry key:'HKEY_CURRENT_USER\Software'.
+ softwareEntry isNil ifTrue:[
+ Transcript showCR: 'Failed to get Software entry in registry'.
+ ^ nil.
+ ].
+
+ path do:[:subKey |
+ |subEntry|
+
+ subEntry := softwareEntry createSubKeyNamed:'Bosch'.
+ subEntry isNil ifTrue:[
+ Transcript showCR: 'Failed to create ',subKey,' entry in registry'.
+ ^ nil.
+ ].
+ softwareEntry := subEntry.
+ ].
+ applicationEntry := softwareEntry.
+ ].
+ ^ applicationEntry
+!
+
+currentIDKeyInRegistry
+ ^ 'CurrentID'
+!
+
+getCurrentIDFromRegistry
+
+ |applicationEntry|
+
+ applicationEntry := self applicationRegistryEntry.
+ applicationEntry isNil ifTrue:[^ nil.].
+ ^ applicationEntry valueNamed: self currentIDKeyInRegistry
+
+ "
+ |hWnd externalAddress|
+ hWnd := DapasXStartup getCurrentIDFromRegistry.
+ hWnd isEmptyOrNil ifTrue:[^ self halt.].
+ hWnd := hWnd asInteger.
+ externalAddress := ExternalAddress newAddress: hWnd.
+ Display raiseWindow:externalAddress.
+ Display setForegroundWindow:externalAddress
+ "
+!
+
+getIDOfRunningApplicationFromRegistryEntry
+ |applicationEntry|
+
+ applicationEntry := self applicationRegistryEntry.
+ applicationEntry isNil ifTrue:[^ nil.].
+ ^ applicationEntry valueNamed: self currentIDKeyInRegistry
+!
+
+isAnotherApplicationInstanceRunning
+ "answer true, if another instance of mzself is currently running.
+ For now, it only works under win32, because it uses the underlying mutex mechanism."
+
+ | lastErrorCode alreadyExists handleAndLastErrorCode|
+
+ OperatingSystem isMSDOSlike ifTrue:[
+ handleAndLastErrorCode := OperatingSystem createMutexNamed: (self applicationUUID printString).
+ MutexHandle := handleAndLastErrorCode first.
+ lastErrorCode := handleAndLastErrorCode second.
+ "/ self assert: lastErrorCode == 0.
+ alreadyExists :=
+ MutexHandle isNil
+ or:[lastErrorCode == 183 "ERROR_ALREADY_EXISTS"
+ or:[lastErrorCode == 5 "ERROR_ACCESS_DENIED"]].
+
+ alreadyExists ifFalse:[OperatingSystem waitForSingleObject: MutexHandle].
+ ^ alreadyExists
+ ].
+
+ ^ false.
+!
+
+processStartupOfASecondInstance
+ "This is executed when I have been started as a second instance of an already running application.
+ If I can get the currentID (i.e. windowID) of the first one and there is a command line argument with a file,
+ send a message to the main window of the already running application, o ask it for another window.
+ If the currentID is unknown, ask if the user wants to open a new instance of the application anyway.
+ Return true if the first instance has been notified, and this second instance should exit."
+
+ |currentIDStringFromRegistry currentIDFromRegistry fileArg commands aWindowId|
+
+ commands := Smalltalk commandLineArguments.
+
+ currentIDStringFromRegistry := self getCurrentIDFromRegistry.
+
+ "If the currentID is not found and there are arguments from the command line,
+ we should wait in case of starting the first instance of the application
+ with a multiple selection of files."
+ (currentIDStringFromRegistry isEmptyOrNil and:[commands notEmptyOrNil]) ifTrue:[
+ Delay waitForSeconds: 2.
+ ].
+
+ currentIDStringFromRegistry := self getCurrentIDFromRegistry.
+ currentIDStringFromRegistry isEmptyOrNil ifTrue:[
+ ^ (Dialog confirm: ('Continue opening a new instance of %1 or exit?' bindWith:self applicationName)
+ title: ('%1 is already open!!' bindWith:self applicationName)
+ yesLabel: 'Continue'
+ noLabel: 'Exit') not.
+ ].
+
+ currentIDFromRegistry := Integer readFrom:currentIDStringFromRegistry.
+
+ "/ bring the other application to the foreground
+ aWindowId := ExternalAddress newAddress: currentIDFromRegistry.
+ Display setForegroundWindow: aWindowId.
+
+ "Autostart for associated extension"
+ commands notEmpty ifTrue:[
+ fileArg := commands last asFilename.
+ fileArg exists ifTrue:[
+ self sendOpenPathCommand:(fileArg pathName) toWindowId: aWindowId.
+ ].
+ ].
+ ^ true
+!
+
+releaseApplicationMutex
+
+ OperatingSystem isMSDOSlike ifTrue:[
+ MutexHandle notNil ifTrue:[
+ OperatingSystem releaseMutex: MutexHandle.
+ OperatingSystem primCloseHandle: MutexHandle.
+ ].
+ ].
+!
+
+sendCommand:message toWindowId:aWindowId
+ "use the event send mechanism to forward a command to the already running application"
+
+ Display
+ sendCopyDataString: message
+ toWindowId: aWindowId.
+!
+
+sendOpenPathCommand:pathName toWindowId:aWindowId
+ "use the event send mechanism to forward an open-Path command to the already running application"
+
+ self sendCommand:('openPath:', pathName) toWindowId:aWindowId.
+!
+
+writeCurrentIDIntoRegistry: currentID
+
+ |dapasXEntry currentIDEntry|
+
+ dapasXEntry := self applicationRegistryEntry.
+ dapasXEntry isNil ifTrue:[^ false.].
+
+ currentIDEntry := dapasXEntry createSubKeyNamed:(self currentIDKeyInRegistry).
+ currentIDEntry isNil ifTrue:[
+ Transcript showCR: 'Failed to create CurrentID entry in registry'.
+ ^ false.
+ ].
+
+ ^ dapasXEntry valueNamed:(self currentIDKeyInRegistry) put:(currentID printString).
+
+ "
+ | currentID returnedCurrentID |
+ currentID := 999.
+ DapasXStartup writeCurrentIDIntoRegistry: currentID.
+ returnedCurrentID := DapasXStartup getCurrentIDFromRegistry.
+ self assert: currentID = returnedCurrentID asNumber.
+ "
+! !
+
!StandaloneStartup class methodsFor:'queries'!
applicationName
@@ -287,7 +519,7 @@
!StandaloneStartup class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/StandaloneStartup.st,v 1.10 2008-06-13 12:11:41 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/StandaloneStartup.st,v 1.11 2008-07-31 13:20:45 cg Exp $'
! !
StandaloneStartup initialize!