"{ Encoding: utf8 }"

"

 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 class communicationIcon'

        ifAbsentPut:[(Depth8Image new) width: 22; height: 22; photometric:(#palette); bitsPerSample:(#(8 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'

@@@@_$RA@@@@@@@@@@@@@HED_ @@@@@@ U2+UX\@@@@@@@@@@H]U*52A@@@@ U*9^S-A  @@@@@@@HIT.HD4O8D@_%29^#6JZE"B@@@@@HIX-(@9!!&-\_"Z+

.+QKZ(0@J @@@@@*@K*5SV2B*2XDQ+":,XR5WP8@@@@@BDJ5.+V@.E4KEA46-+*5U9TVHRD!!HP<+JKV:-%*SG1@Y@R8@WYV)I@A/@@@SH D$@E>K*BP-$PUH

QH60)2U0[$:]KYPJN$RK,JX''[TFW]BB*)*4Z\K)[Q''L6''GD *JZ.HF4UV;H_**U6\+)%T7,WDUB3G:^%_E<@WB%RG*)8\+*BL(=Q#@(!!R!!2-_P5-@@AUNA!!4

BGV:.(IQ)I<LQS@R^VE([P@@(E9OZQT/[[*:-9=YO8M''S6B ZF4@@@@@[0@[M0I5.)!!!!(4NE@F<@&$&C@@@@@@@@G&PCBGYV&;@<!!P@@#$^P@@@@@@@@@FN@

[R<#+J2,PHT@%$2E@@@@@@@@@@BEA7>"I;B/''$*H%$"I@@@@@@@@@@@@$#D]^RF''*F]5$D2I@@@@@@@@@@@@@@BIKB<F(VHIHSNE@@@@@@@@@@@@@@@@@I$>

MVY7@@@@@@@@@@@@@@@@@@@@@@@@!!3Y9@@@@@@@@@@@@@@@a') ; colorMapFromArray:#[0 0 0 0 0 0 7 7 7 12 12 12 20 20 20 23 23 23 24 24 24 28 28 28 30 30 30 32 32 32 35 35 35 40 40 40 41 41 41 43 43 43 45 45 45 48 47 48 50 49 50 51 50 51 52 52 52 54 53 54 55 54 55 56 56 56 58 57 58 58 58 58 59 59 59 60 59 60 60 60 60 61 61 61 62 62 62 66 65 66 66 66 66 67 66 67 68 67 68 69 69 69 70 69 70 70 70 70 71 71 71 72 71 72 73 73 73 74 73 74 75 75 75 76 75 76 76 76 76 77 76 77 78 78 78 79 79 79 80 80 80 85 84 85 86 84 86 86 85 86 87 86 87 87 87 87 88 87 88 89 88 89 89 89 89 90 88 90 90 89 90 93 91 93 93 93 93 94 92 94 94 93 94 96 94 96 97 96 97 98 97 98 99 98 99 99 99 99 100 99 100 100 100 100 102 102 102 103 103 103 104 103 104 104 104 104 105 105 105 106 106 106 108 107 108 109 109 109 110 110 110 111 110 111 113 113 113 114 113 114 114 114 114 115 115 115 116 116 116 117 115 117 118 118 118 120 120 120 121 121 121 122 121 122 122 122 122 123 122 123 123 123 123 124 124 124 125 125 125 127 127 127 128 128 128 129 129 129 130 130 130 131 131 131 132 131 132 132 132 132 133 132 133 134 134 134 135 135 135 136 136 136 137 137 137 138 138 138 140 139 140 142 142 142 147 147 147 151 151 151 153 153 153 154 154 154 155 155 155 156 155 156 156 156 156 159 159 159 164 163 164 165 165 165 167 167 167 168 168 168 170 170 170 172 172 172 174 174 174 175 174 175 177 177 177 178 178 178 181 181 181 182 182 182 183 183 183 185 185 185 189 189 189 190 190 190 191 191 191 192 192 192 194 192 194 194 194 194 195 195 195 196 196 196 198 196 198 199 198 199 200 200 200 201 200 201 201 201 201 202 201 202 202 202 202 203 203 203 204 204 204 205 204 205 205 205 205 206 205 206 206 206 206 209 209 209 210 210 210 211 211 211 212 212 212 213 212 213 213 213 213 214 214 214 215 213 215 215 215 215 216 216 216 217 216 217 217 217 217 218 217 218 219 219 219 221 219 221 222 221 222 224 222 224 224 223 224 225 223 225 225 224 225 225 225 225 226 224 226 226 225 226 227 226 227 228 226 228 229 228 229 231 231 231 232 231 232 235 234 235 237 237 237 239 239 239 241 241 241 244 244 244 247 247 247 248 248 248 255 255 255]; mask:((ImageMask new) width: 22; height: 22; photometric:(#blackIs0); bitsPerSample:(#(1 )); samplesPerPixel:(1); 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 class cross2Icon'

        ifAbsentPut:[(Depth1Image new) width: 32; height: 32; photometric:(#palette); bitsPerSample:(#[1]); samplesPerPixel:(1); 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 new) width: 32; height: 32; photometric:(#blackIs0); bitsPerSample:(#[1]); samplesPerPixel:(1); 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'!

isVisualStartable

    "return true, if this application can be started via #open.

     (to allow start of a change browser via double-click in the browser)"

    "/ assume all my subclasses can

    ^ self ~~ AbstractLauncherApplication

    "

     AbstractLauncherApplication isVisualStartable

     NewLauncher isVisualStartable

    "

! !

!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"