"

 COPYRIGHT (c) 1997 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:libtool' }"

"{ NameSpace: Smalltalk }"

ToolApplicationModel subclass:#AbstractLauncherApplication

	instanceVariableNames:'transcript'

	classVariableNames:'NotifyingEmergencyHandler OpenLaunchers RegisteredMenuHandlers

		OpenSettingsDialog SettingsList UserSettingsList

		LastSettingsPageName'

	poolDictionaries:''

	category:'Interface-Smalltalk'

!

Object subclass:#LauncherDialogs

	instanceVariableNames:''

	classVariableNames:''

	poolDictionaries:''

	privateIn:AbstractLauncherApplication

!

!AbstractLauncherApplication class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1997 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

"

    This is an abstract class, providing mechanisms and common functionality

    for launcher-type applications. Subclasses may implement their GUI either

    with or without the UIPainter framework, and still use the common functions

    provided here.

    [author:]

        Claus Gittinger, eXept Software AG

"

! !

!AbstractLauncherApplication class methodsFor:'accessing'!

closeAllLaunchers

    "close all opened launchers"

    self openLaunchers copy do:[:eachLauncher |

        eachLauncher closeRequest

    ].

    "

     self closeAllLaunchers.

     NewLauncher open

    "

!

current

    "return the launcher running on the current screen.

     (for access via addMenu/ removeMenu)"

    |currentScreen|

    OpenLaunchers size > 0 ifTrue:[

        currentScreen := Screen current.

        ^ OpenLaunchers detect:[:eachLauncher | eachLauncher graphicsDevice == currentScreen] ifNone:nil

    ].

    ^ nil.

    "

     NewLauncher current

    "

    "Modified: / 9.9.1996 / 22:41:36 / stefan"

    "Modified: / 13.10.1998 / 16:09:50 / cg"

!

openLaunchers

    "return all opened launchers"

    OpenLaunchers isNil ifTrue:[

        OpenLaunchers := IdentitySet new

    ].

    ^ OpenLaunchers

! !

!AbstractLauncherApplication class methodsFor:'defaults'!

notifyingEmergencyHandler

    "return a block (used as an emergency handler

     for exceptions), which does errorNotification before going

     into the debugger."

    "Remember the handlerBlock, to be able to determine if the current

     handler is the notifying one."

    NotifyingEmergencyHandler isNil ifTrue:[

        NotifyingEmergencyHandler := NoHandlerError notifyingEmergencyHandler

    ].

    ^ NotifyingEmergencyHandler

    "Created: 7.1.1997 / 22:18:19 / cg"

    "Modified: 15.1.1997 / 21:15:38 / cg"

! !

!AbstractLauncherApplication class methodsFor:'image specs'!

communicationIcon

    "This resource specification was automatically generated

     by the ImageEditor of ST/X."

    "Do not manually edit this!! If it is corrupted,

     the ImageEditor may not be able to read the specification."

    "

     self communicationIcon inspect

     ImageEditor openOnClass:self andSelector:#communicationIcon

     Icon flushCachedIcons

    "

    <resource: #image>

    ^Icon

        constantNamed:'AbstractLauncherApplication communicationIcon'

        ifAbsentPut:[(Depth4Image width:22 height:22) bits:(ByteArray fromPackedString:'

@@W%@@@@@@A^T@@@V2/@@@@@CKJ5@@V?!!>T@@@A[=W9PV?!!<R5@@A[=W1KVR<.S@$@@IC28UJ];?IR- @@7"<%>6NW?2/C&Y%)$/><$3A0/J$A@C$IAL*Y3^

;B*QF:''F_,J)G*"R(#G;8W(Y*"$S,)J(G4.CN2&*U@.[$(G5_K1)82U!!@K\86O=[*&93!!DD@)KP7G?>+9T-JPP@@DC\H>$+,@P+%@@@@%@6K(''0@3,@@@@AE

E9H";@3,@@@@@L5Z$"+,3,@@@@@@19"Z)H3,@@@@@@@L%=)F%<@@@@@@@@B.]H@@@@@@@@@@@@18@@@@@@@b') colorMapFromArray:#[0 0 0 148 148 148 224 224 224 52 52 52 128 128 128 180 180 180 32 32 32 84 84 84 160 160 160 64 64 64 212 212 212 116 116 116 192 192 192 20 20 20 96 96 96 244 244 244] mask:((ImageMask width:22 height:22) bits:(ByteArray fromPackedString:'G@C O G0_0O8?8_<?(W<?8_<???<=:^<???<???<???<_??<O??<O??<B?=\@?<8@?=0@?? @??@@_>@@O @@G@@'); yourself); yourself]

!

cross2Icon

    "This resource specification was automatically generated

     by the ImageEditor of ST/X."

    "Do not manually edit this!! If it is corrupted,

     the ImageEditor may not be able to read the specification."

    "

     self cross2Icon inspect

     ImageEditor openOnClass:self andSelector:#cross2Icon

     Icon flushCachedIcons

    "

    <resource: #image>

    ^Icon

        constantNamed:'AbstractLauncherApplication cross2Icon'

        ifAbsentPut:[(Depth1Image width:32 height:32) bits:(ByteArray fromPackedString:'

@@@@@@@F0@@@@H@@@@@@@@@@0@@@@H@@@@@@@@@N<@@@LH0@@D@B@@B@8P@@ HD@@P@@ @D 0HIIIHBB[[X@@@@@[[YA@RRRPPLD @D@@H@@ PD@@H\A@@A@

@ @@LP0@@@=0@@@@@@@@@P@@@@L@@@@@@@@@@P@@@@M @@@@@@@b') colorMapFromArray:#[0 0 0 255 255 255] mask:((ImageMask width:32 height:32) bits:(ByteArray fromPackedString:'

@@_@@@@G0@@@@X@@@@G@@@@A0@@@@X@@@@?0@@@??@@@\X8@@LG#@@FA8X@A XF@@0G@0@M!!0LO[[XCC???????????C@[[[00NF0@LC L@A XF@@X^A @CG

 0@@\X8@@C?<@@@O<@@@@X@@@@N@@@@C @@@@X@@@@O @@@C8@@b'); yourself); yourself]

!

httpServerIcon

    <resource: #programImage>

    ^ AbstractSettingsApplication::HTTPStartServerSettingsApplication defaultIcon

!

systemBrowser24x24Icon

    <resource: #programImage>

    ^ ToolbarIconLibrary systemBrowser24x24Icon

! !

!AbstractLauncherApplication class methodsFor:'queries'!

isAbstract

    ^ self == AbstractLauncherApplication

! !

!AbstractLauncherApplication class methodsFor:'settings application list'!

addSettingsApplicationByClass:aClass withName:aName icon:anIcon

    | userSetList addItem|

    userSetList := self userSettingsList.

    addItem := Array with:aName with:aClass with:anIcon.

    "Ignore existing entries found in SettingsList for that name"

    (SettingsList ? #()) do:[:entry |

        entry first = aName ifTrue: [

            ('Settings named "%1" already exists in "%2" with settings app class "%3"' 

                bindWith:aName

                    with:self name printString

                    with:entry second

            ) infoPrintCR.

            ^ self

        ].    

    ].

    "/ remove existing entries in UserSettingsList for that name

    userSetList copy do:[:entry |

        entry first = aName ifTrue:[

            userSetList remove:entry.

        ]

    ].

    userSetList add:addItem.

    OpenSettingsDialog notNil ifTrue:[

        OpenSettingsDialog installSettingsEntry:addItem

    ].

!

allSettingsList

    ^ self settingsList, self userSettingsList

!

defaultSettingsApplicationList

    "/ cg: moved it to SettingsDialog - everyone is expecting it there and had to search it...

    "/ left here for backw. compatibility.

    ^ SettingsDialog defaultSettingsApplicationList

!

expandSettingsList:rawList

    "this expands a raw settings list,

     by looking for entries with a block in their class name.

     If any such is present, it is evaluated, returning

     a collection of actual entries to use. Then, also % entries in

     the name and icon are evaluated by sending corresponding messages

     to the collected classes.

     This allows for easy dynamic construction of more complicated

     lists, for example to adapt to the set of loaded classes dynamically."

    "I am not sure. if this is is a good idea; although it makes heavy use of

     Smalltalk's dynamic features, it is probably better done differently

     (letting the caller do this).

     The code here is harder to debug, and understand"

    |cookedList settingsList|

    cookedList := OrderedCollection new.

    rawList do:[:eachEntry|

        |treeName classNameOrBlock newEntry code classList name nameCode nameBlock nameList iconCode iconBlock|

        classNameOrBlock := eachEntry at:2 ifAbsent:nil.

        classNameOrBlock isBlock ifTrue:[

            classList := classNameOrBlock value select:[:clsOrNil | clsOrNil notNil].

            name := eachEntry at:1.

            self assert:(name includesString:'[').

            nameCode := name copyFrom:(name indexOf:$[)+1 to:(name indexOf:$])-1.

            nameCode := '^ [:each | ' , (nameCode copyReplaceString:'%' withString:'each') ,']'.

            nameBlock := Parser evaluate:nameCode.

            nameList := classList collect:nameBlock.

            nameList sortWith:classList.

            nameList with:classList do:[:eachName :eachClass |

                |newEntry|

                newEntry := eachEntry copy.

                newEntry at:1 put:(name copyTo:(name indexOf:$[)-1),eachName.

                newEntry at:2 put:eachClass name.

                cookedList add:newEntry.

            ].

        ] ifFalse:[

            (classNameOrBlock isNil "a directory entry"

            or:[ (Smalltalk at:classNameOrBlock) notNil "a valid entry"]) ifTrue:[

                cookedList add:eachEntry.

            ] ifFalse:[

                classNameOrBlock notNil ifTrue:[

                    Transcript showCR:'Launcher: missing settings class: ',classNameOrBlock.

                ].

            ].

        ].

    ].

    settingsList := 

        cookedList collect:[:eachEntry |

            |iconCodeOrSelector iconCode iconBlock newEntry|

            iconCodeOrSelector := eachEntry at:3 ifAbsent:nil.

            iconCodeOrSelector isNil ifTrue:[

                newEntry := eachEntry

            ] ifFalse:[

                newEntry := eachEntry copy.

                (iconCodeOrSelector startsWith:'[') ifTrue:[

                    iconCode := iconCodeOrSelector copyFrom:(iconCodeOrSelector indexOf:$[)+1 to:(iconCodeOrSelector indexOf:$])-1.

                    iconCode := '^ [:each | ' , (iconCode copyReplaceString:'%' withString:'each') ,']'.

                    iconBlock := Parser evaluate:iconCode.

                    newEntry at:3 put:(iconBlock value:(Smalltalk classNamed:(eachEntry at:2))).

                ] ifFalse:[

                    newEntry at:3 put:(self perform:iconCodeOrSelector).

                ].

            ].

            newEntry.

        ].

    ^ settingsList.

    "

     self withAllSubclassesDo:[:cls | cls initializeSettingsList ]

    "

!

initializeSettingsList

    SettingsList := self expandSettingsList:(self defaultSettingsApplicationList).

    ^ SettingsList.

    "

     self withAllSubclassesDo:[:cls | cls initializeSettingsList ]

    "

    "Modified: / 16-12-2002 / 18:12:50 / penk"

    "Modified: / 20-04-2011 / 17:03:33 / cg"

!

removeSettingsApplicationByClass:aClass

    | userSetList remItem|

    userSetList := self userSettingsList.

    remItem := userSetList detect:[:item| (item at:2) = aClass] ifNone:[nil].

    remItem notNil ifTrue:[

        userSetList remove:remItem.

        OpenSettingsDialog notNil ifTrue:[

            self removeSettingsEntry:remItem forSettingsApp:OpenSettingsDialog.

        ].

    ].

!

removeSettingsEntry:entry forSettingsApp:aSettingsApp

    |applName applClass|

    applName := entry at:1.

    applClass := entry at:2.

    aSettingsApp remApplClassByName:applName.

!

settingsList

    "/ do NOT cache SettingsList

    "/ use UserSettingsList to add settings from loaded libraries

    SettingsList := nil.

    SettingsList isNil ifTrue: [

        SettingsList := self initializeSettingsList

    ].

    ^ SettingsList

    "Modified: / 19-04-2011 / 12:08:17 / cg"

!

userSettingsList

    UserSettingsList isNil ifTrue: [

        UserSettingsList := OrderedCollection new.

    ].

    ^ UserSettingsList

! !

!AbstractLauncherApplication class methodsFor:'settings dialog'!

openSettings

    ^ self openSettingsFor: nil

    "Created: / 08-10-2014 / 23:42:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

openSettingsAndSelect: selectedPageName

    ^ self openSettingsFor: nil andSelect: selectedPageName

    "Created: / 08-10-2014 / 23:43:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

openSettingsFor: requestor

    ^ self openSettingsFor: requestor andSelect: LastSettingsPageName

    "Created: / 08-10-2014 / 23:40:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

openSettingsFor: requestor andSelect: selectedPageName

    |settingsApp wg proc|

    OpenSettingsDialog notNil ifTrue:[

        (wg := OpenSettingsDialog windowGroup) notNil ifTrue:[

            (proc := wg process) notNil ifTrue:[

                proc isDead ifFalse:[

                    OpenSettingsDialog window raiseDeiconified.

                    ^ self.

                ]

            ]

        ].

        OpenSettingsDialog := nil.

    ].

    settingsApp := SettingsDialog new.

    settingsApp requestor:requestor.

    settingsApp installSettingsEntries:(self allSettingsList).

    "/ settingsApp requestor:self.

    OpenSettingsDialog := settingsApp.

    settingsApp allButOpen.

    settingsApp window label:(self classResources string:'ST/X Settings').

    settingsApp openWindow.

    selectedPageName notNil ifTrue:[

        settingsApp selectItemWithName:selectedPageName

    ].

    "Created: / 08-10-2014 / 23:42:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!AbstractLauncherApplication methodsFor:'drag & drop'!

canDropObjects:aCollectionOfDropObjects

    "Any object can be dropped into workspace..."

    ^ aCollectionOfDropObjects

        contains:[:someObject| (someObject isTextObject or:[ someObject isFileObject ])].

!

dropFileObject:aFilename

    |suffix|

    suffix := aFilename asFilename suffix.

    suffix = 'st' ifTrue:[

        ChangesBrowser openOn:aFilename.

        ^ self.

    ].

    UserPreferences fileBrowserClass openOn:aFilename.

!

dropObjects:aCollectionOfObjects

    "Any object can be dropped:

        text: open a workspace

        file:

            .st - open a cange-browser

            other - open a fileBrowser

    "

    aCollectionOfObjects do:[:dropObject|

        |theObject|

        theObject := dropObject theObject.

        dropObject isTextObject ifTrue:[

            self dropTextObject:theObject

        ] ifFalse:[

            dropObject isFileObject ifTrue:[

                self dropFileObject:theObject

            ] ifFalse:[

            ].

        ].

    ].

!

dropTextObject:aDropContext

    WorkspaceApplication openWith:aDropContext.

! !

!AbstractLauncherApplication methodsFor:'menu actions - tools'!

clearAllCoverageInfo

    "clear all coverage information"

    self withWaitCursorDo:[

        InstrumentedMethod cleanAllInfoWithChange:false

    ].

    Smalltalk changed:#coverageInfo.

!

startSUnitTestRunner2

    "open the SUnit test runner"

    self openApplication:#Tools::TestRunner2

! !

!AbstractLauncherApplication methodsFor:'oldStyle-user actions-settings'!