# HG changeset patch # User Claus Gittinger # Date 1217510445 -7200 # Node ID fece26c79af5da3394ceedfd843da70dfd545922 # Parent 6f1176a154861e3910155323ebc3c0c57123108b refactored diff -r 6f1176a15486 -r fece26c79af5 StandaloneStartup.st --- 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!