"
 COPYRIGHT (c) 2006 by eXept Software AG
              All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"
"{ Package: 'stx:libbasic' }"

Object subclass:#StandaloneStartup
	instanceVariableNames:''
	classVariableNames:'Verbose CommandLineArguments'
	poolDictionaries:''
	category:'System-Support'
!

StandaloneStartup class instanceVariableNames:'MutexHandle'

"
 No other class instance variables are inherited by this class.
"
!

!StandaloneStartup class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) 2006 by eXept Software AG
              All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"
!

documentation
"
    a subclassable template class for a standalone GUI-application's startup;
    For your own stand alone programs, define a subclass of this, 
    and redefine the #main method there.
    (of course, the other methods can also be redefined.)

    [author:]
        Claus Gittinger

    [start with:]
        <yourNamehere>Startup start

    [see also:]
        Smalltalk
        GetOpt
        ReadEvalPrintLoop
"
!

howToDealWithMultipleApplicationInstances
"
    please read the comment in the corresponding ApplicationModel class-documentation method.
"
!

whichMethodsToRedefine
"
    main:argv
        thats the actual program.

    suppressRCFileReading
        false here; redefine to return true, to disable the rc-file reading.
        you loose the chance of configuration, but lock the user out from any access to any smalltalk
        (if you have a user-phobia)

    allowDebugOption
        false here; redefine to return true, to enable the --debug startup option.
        if disabled, you loose the chance of debugging, but lock the user out from any access to any smalltalk

    allowScriptingOption
        false here; redefine to return true, to enable the --scripting startup option.
        if disabled, you loose the chance of remote control, but lock the user out from any access to any smalltalk

"
! !

!StandaloneStartup class methodsFor:'initialization'!

initialize
    "/ Verbose := true.
    Verbose := false.
! !

!StandaloneStartup class methodsFor:'defaults'!

allowDebugOption
    "enable/disable the --debug startup option.
     The default is now false, so standAlone apps are closed by default.
     Can be redefined in subclasses to enable it"

    ^ false
!

allowScriptingOption
    "enable/disable the --scripting startup option.
     The default is now false, so standAlone apps are closed by default.
     Can be redefined in subclasses to enable it"

    ^ false
!

suppressRCFileReading
    "enable/disable the rc-file reading (and also the --rcFileName option).
     If suppressed, there is no chance to interfere with the startup.
     Can be redefined in subclasses to disable it"

    ^ false
! !

!StandaloneStartup class methodsFor:'helpers'!

printInfo:msg
    Transcript 
        show:('%1 [info]: ' bindWith:(self applicationName));
        showCR:msg
!

redirectStandardStreams
    Stdout := Stderr.
    Transcript := Stderr.
!

verboseInfo:msg
    Verbose == true ifFalse:[^ self].
    self printInfo:msg

    "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:subKey.
            subEntry isNil ifTrue:[
                Transcript showCR: 'Failed to create ',subKey,' entry in registry'.
                ^ nil.
            ].
            softwareEntry := subEntry.
        ].
        applicationEntry := softwareEntry.
    ].
    ^ applicationEntry
!

confirmOpenNewApplicationInstance

    ^ 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'
!

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 setForegroundWindowSucceeded|

    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:[
        ^ self confirmOpenNewApplicationInstance not.
    ].

    currentIDFromRegistry := Integer readFrom:currentIDStringFromRegistry onError: 0.

    "/ bring the other application to the foreground
    aWindowId := ExternalAddress newAddress: currentIDFromRegistry.
    setForegroundWindowSucceeded := Display primSetForegroundWindow: aWindowId.
"/    setForegroundWindowSucceeded ifFalse:[^ self confirmOpenNewApplicationInstance not].

    "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

    |applicationEntry currentIDEntry|

    applicationEntry := self applicationRegistryEntry.
    applicationEntry isNil ifTrue:[^ false.].

    currentIDEntry := applicationEntry createSubKeyNamed:(self currentIDKeyInRegistry).
    currentIDEntry isNil ifTrue:[
        Transcript showCR: 'Failed to create CurrentID entry in registry'.
        ^ false.
    ].

    ^ applicationEntry 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
    "used in verbose messages - can/should be redefined in subclasses"

    |nm|

    nm := self nameWithoutPrefix.
    (nm endsWith:'Startup') ifTrue:[
        ^ nm copyWithoutLast:('Startup' size).
    ].
    (nm endsWith:'Start') ifTrue:[
        ^ nm copyWithoutLast:('Start' size).
    ].
    ^ nm

    "Created: / 19-09-2006 / 16:26:44 / cg"
!

isBrowserStartable
    "do not allow clicking on me in the browser"

    ^ false

    "Created: / 06-10-2006 / 11:33:13 / cg"
!

startupFilename
    "used in verbose messages - can/should be redefined in subclasses"

    ^ self applicationName asLowercase,'Start.rc'

    "
     ExpeccoStartup startupFilename -> 'expecco.rc'
    "

    "Created: / 19-09-2006 / 16:38:28 / cg"
! !

!StandaloneStartup class methodsFor:'startup'!

loadPatch:fileName
    self verboseInfo:('loading patch: ',fileName baseName).
    Smalltalk fileIn:fileName pathName.
!

loadPatches
    |patchesDir|

    patchesDir := OperatingSystem pathOfSTXExecutable asFilename directory construct:'patches'.
    (patchesDir exists and:[patchesDir isDirectory]) ifTrue:[
        patchesDir directoryContents sort do:[:eachFile |
            self loadPatch:(patchesDir construct:eachFile).
        ].
    ].

    "Modified: / 19-09-2006 / 16:30:58 / cg"
!

setupSmalltalkFromArguments:argv
    "handle common command line arguments:
        --help ............... print usage and exit
        --verbose (-V) ....... be verbose during startup
        --debug .............. enable debugger & inspector
        --rcFileName ......... define a startup rc-file
        --scripting portNr ... start a scripting server
        --allowHost host ..... add host to the allowed scripting hosts
    "

    |idx rcFilename nextArg debugging scripting allowedScriptingHosts portNr|

"/    Smalltalk beHeadless:true.
"/    OperatingSystem disableSignal:(OperatingSystem sigHUP).
"/    Smalltalk infoPrinting:true.

    (argv includes:'--help') ifTrue:[
        self usage.
        AbortOperationRequest raise.
    ].

    idx := argv indexOfAny:#('--verbose' '-V').
    idx ~~ 0 ifTrue:[
        argv removeAtIndex:idx.
        Verbose := true.
    ].
    self verboseInfo:('args: ',argv asArray printString).

    debugging := false.
    (self allowDebugOption) ifTrue:[
        idx := argv indexOfAny:#('--debug').
        idx ~~ 0 ifTrue:[
            self verboseInfo:('debug on').
            argv removeAtIndex:idx.
            debugging := true
        ].
    ].
    debugging ifTrue:[
        self setupToolsForDebug.
    ] ifFalse:[
        self setupToolsForNoDebug.
    ].

    self suppressRCFileReading ifFalse:[
        idx := argv indexOf:'--rcFileName'.
        idx ~~ 0 ifTrue:[
            nextArg := argv at:(idx + 1) ifAbsent:nil.
            (nextArg notNil and:[ (nextArg startsWith:'-') not ]) ifTrue:[
                rcFilename := nextArg.
                argv removeAtIndex:idx+1; removeAtIndex:idx.
            ]
        ].

        rcFilename isNil ifTrue:[
            rcFilename := self startupFilename.
        ].
        rcFilename asFilename exists ifTrue:[
            self verboseInfo:('reading ',rcFilename,'...').
            rcFilename isAbsolute ifFalse:[
                rcFilename := OperatingSystem pathOfSTXExecutable asFilename directory constructString:rcFilename.
            ].
            Smalltalk secureFileIn:rcFilename
        ].
    ].

    scripting := false.
    (self allowScriptingOption) ifTrue:[
        idx := argv indexOfAny:#('--scripting').
        idx ~~ 0 ifTrue:[
            nextArg := argv at:(idx + 1) ifAbsent:nil.
            (nextArg notNil and:[ (nextArg startsWith:'-') not ]) ifTrue:[
                portNr := nextArg asInteger.
                argv removeAtIndex:idx+1.
            ].
            argv removeAtIndex:idx.

            scripting := true
        ].

        allowedScriptingHosts := OrderedCollection new.

        idx := argv indexOfAny:#('--allowHost').
        [idx ~~ 0] whileTrue:[
            nextArg := argv at:(idx + 1) ifAbsent:nil.
            nextArg isNil ifTrue:[
                self usage.
                AbortOperationRequest raise.
            ].
            allowedScriptingHosts add:nextArg.
            idx := argv indexOfAny:#('--allowHost').
        ].
    ].

    scripting ifTrue:[
        self verboseInfo:('scripting on').
        STXScriptingServer notNil ifTrue:[
            allowedScriptingHosts do:[:eachHost | STXScriptingServer allowHost:eachHost ].

            "/ scripting on port/stdin_out/8008
            self verboseInfo:('start scripting').
            STXScriptingServer startAt:portNr
        ] ifFalse:[
            self verboseInfo:('missing STXScriptingServer class').
        ].
    ].

    ^ true

    "Modified: / 31-10-2007 / 16:05:59 / cg"
!

setupToolsForDebug
    Debugger := DebugView ? MiniDebugger.
    Inspector := InspectorView ? MiniInspector.
    Verbose ifTrue:[ 'debug enabled - CTRL-C brings you into a debugger.' errorPrintCR ].
"/    self verboseInfo:('debug enabled - CTRL-C brings you into a debugger.').

    "Created: / 19-09-2006 / 16:40:32 / cg"
!

setupToolsForNoDebug
    Smalltalk isStandAloneApp ifTrue:[
        Smalltalk at:#Debugger put:nil.
        Smalltalk at:#Inspector put:nil.
        NewLauncher notNil ifTrue:[
            NewLauncher allPrivateClasses do:[:cls |
                Smalltalk at:(cls name) put:nil.
            ].
            Smalltalk at:#NewLauncher put:nil.
        ].
        Verbose ifTrue:[ 'debug disabled.' errorPrintCR ].

        self redirectStandardStreams.
    ].

    "Created: / 19-09-2006 / 16:40:47 / cg"
    "Modified: / 31-10-2007 / 16:18:40 / cg"
!

start
    CommandLineArguments := Smalltalk commandLineArguments.

    self verboseInfo:('starting...').
    self verboseInfo:('args: ', CommandLineArguments asStringCollection asString).

    Smalltalk isStandAloneApp ifTrue:[
        self loadPatches.
        self verboseInfo:('setup Smalltalk').
    ].
    self setupSmalltalkFromArguments:CommandLineArguments.
    self main

    "Modified: / 31-10-2007 / 16:03:44 / cg"
!

usage
    Stderr nextPutLine:'usage:'.
    Stderr nextPutLine:'  ',self applicationName,' [options...]'.
    Stderr nextPutLine:'    options:'.
    Stderr nextPutLine:'          --help .................. output this message'.
    Stderr nextPutLine:'          --verbose ............... verbose startup'.
    Stderr nextPutLine:'          --noBanner .............. no splash screen'.
    self allowScriptingOption ifTrue:[
        Stderr nextPutLine:'          --scripting portNr ...... enable scripting via port (or stdin/stdOut, if 0)'.
    ].
    self allowDebugOption ifTrue:[
        Stderr nextPutLine:'          --debug ................. enable Debugger'.
    ].
    self suppressRCFileReading ifFalse:[
        Stderr nextPutLine:'          --rcFileName file ....... execute code from file on startup (default: ',self startupFilename,')'.
    ].

    "Created: / 19-09-2006 / 16:37:55 / cg"
! !

!StandaloneStartup class methodsFor:'startup-to be redefined'!

main
    self verboseInfo:('entering main').

    self main:CommandLineArguments.

    "
     self main
     self main:#('--info') 
    "

    "Modified: / 31-10-2007 / 16:03:22 / cg"
!

main:argv
    self subclassResponsibility.

"/ a typical main: looks like (in a subclass):

"/    |app fileArg|
"/
"/    self verboseInfo:('starting application').
"/    app := <someGUIApplicationModelClass> open.
"/
"/    self verboseInfo:('looking for args in ',argv).
"/    argv notEmptyOrNil ifTrue:[
"/        fileArg := argv last asFilename.
"/        self verboseInfo:('fileArg is ',fileArg name).
"/        fileArg exists ifTrue:[
"/            self verboseInfo:('file exists').
"/
"/            ( #('foo' 'bar' 'baz' ) includes:fileArg suffix) ifTrue:[
"/                self verboseInfo:('loading').
"/
"/                Error handle:[:ex |
"/                    self verboseInfo:'error while loading'.
"/                    ex suspendedContext fullPrintAll.
"/                ] do:[
"/                    app menuLoadFromFile:fileArg
"/                ].
"/            ].
"/        ].
"/    ].

    "Created: / 19-09-2006 / 16:48:29 / cg"
! !

!StandaloneStartup class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libbasic/StandaloneStartup.st,v 1.34 2009-05-26 12:21:25 fm Exp $'
! !

StandaloneStartup initialize!