"

 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' }"

ToolApplicationModel subclass:#AbstractLauncherApplication

	instanceVariableNames:'transcript'

	classVariableNames:'NotifyingEmergencyHandler OpenLaunchers RegisteredMenuHandlers

		OpenSettingsDialog SettingsList'

	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]

!

compilerIcon

    "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 compilerIcon inspect

     ImageEditor openOnClass:self andSelector:#compilerIcon

     Icon flushCachedIcons

    "

    <resource: #image>

    ^Icon

        constantNamed:#'AbstractLauncherApplication class compilerIcon'

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

@ @@@@@@@@@@@@@@@@@@@@@@@@@@@@H@@@@@@@@@@@@@@@@@@@@@@@@@@@@B@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ @@@@@@@@@@@@@@@@@@@@@@@@@@@@H@

@@DA@PD@@PDA@@DA@PD@@PDA@@@B@@@A@PDA@@DA@P@A@PDA@@DA@P@@@ @@@P@@@P@A@@D@@P@@@P@A@@D@@@H@@@DA@PD@@PDA@@DA@PD@@PDA@@@B@@@@

@@@@@@@@@@@@@@@@@@@@@@@@@ @@@PDA@PDA@PDA@PDA@PD@@PD@@@H@@@D@@@@@@PDA@@@@@PDA@@DA@@@B@@@A@PDA@PDA@@DA@P@A@P@A@P@@@ @@@P@@

@@@A@P@A@PDA@PD@@PD@@@H@@@DA@PDA@PD@@PDA@PDA@@DA@@@B@@@A@@@@@@DA@@DA@PDA@P@A@P@@@ @@@PDA@PDA@P@A@PD@@PD@@PD@@@H@@@D@@@@@

@PDA@@@@@PDA@@DA@@@B@@@A@PDA@PDA@PDA@PDA@P@A@P@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@

@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@a') ; colorMapFromArray:#[0 0 0 255 255 255 0 0 0]; mask:((ImageMask new) width: 22; height: 22; photometric:(#blackIs0); bitsPerSample:(#(1 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'@@@@@@@@@@@@O??8O??8O??8O??8O??8O??8O??8O??8O??8O??8O??8O??8O??8O??8O??8O??8@@@@@@@@@@@@') ; yourself); yourself]

! !

!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:aIcon

    | setList addItem|

    setList := self settingsList.

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

    "/ remove existing entries for that name

    setList reverseDo:[:entry |

        entry first = aName ifTrue:[

            setList remove:entry.

        ]

    ].

    setList add:addItem.

    OpenSettingsDialog notNil ifTrue:[

        self installSettingsEntry:addItem forSettingsApp:OpenSettingsDialog.

    ].

!

defaultSettingsApplicationList

    "when changed, execute:

                SettingsList := nil

     to flush cached list.

    "

    ^ #(          

        #('Tools'                       #'AbstractSettingsApplication::ToolsSettingsAppl'               )

        #('Tools/System Browser/Syntax Color'

                                        #'AbstractSettingsApplication::SyntaxColorSettingsAppl'         )

        #('Tools/System Browser/Code Format'

                                        #'AbstractSettingsApplication::SourceCodeFormatSettingsAppl'    )

        #('Tools/Debugger'              #'AbstractSettingsApplication::DebuggerSettingsAppl'            )

        #('Language'                    #'AbstractSettingsApplication::LanguageSettingsAppl'            )

        #('Keyboard Mappings'           #'AbstractSettingsApplication::KbdMappingSettingsAppl'          )

        #('ViewStyle'                   #'AbstractSettingsApplication::StyleSettingsAppl'               )

        #('ViewStyle/Fonts'             #'AbstractSettingsApplication::FontSettingsAppl'                )

        #('ViewStyle/Misc'              #'AbstractSettingsApplication::MiscDisplaySettingsAppl'         )

        #('System Messages'             #'AbstractSettingsApplication::SystemMessageSettingsAppl'       )

        #('Compiler'                    #'AbstractSettingsApplication::GeneralCompilerSettingsAppl'     )

        #('Compiler/ByteCode'           #'AbstractSettingsApplication::ByteCodeCompilerSettingsAppl'    )

        #('Compiler/STC     '           #'AbstractSettingsApplication::STCCompilerSettingsAppl'         )

        #('Memory'                      #'AbstractSettingsApplication::MemorySettingsAppl'              )

        #('Processor & Scheduler'       #'AbstractSettingsApplication::ProcessorSchedulerSettingsAppl'  )

        #('Source Code Management'      #'AbstractSettingsApplication::SourceCodeManagementSettingsAppl')

        #('Printer'                     #'AbstractSettingsApplication::PrinterSettingsAppl'             )

        #('Display'                     #'AbstractSettingsApplication::DisplaySettingsAppl'             )

        #('Editor'                      #'AbstractSettingsApplication::EditSettingsAppl'                )

        #('Communication/RDoIt'         #'AbstractSettingsApplication::RDoItServerSettingsAppl'         )

        #('Communication/OSI Protocol'  #'AbstractSettingsApplication::OsiSettingsAppl'                 )

        #('Communication/Misc'          #'AbstractSettingsApplication::MiscCommunicationSettingsAppl'   )

        #('Communication/HTTPServer'    #'AbstractSettingsApplication::HTTPStartServerSettingsApplication'   )

    ) asOrderedCollection

    "Modified: / 16.12.2002 / 18:12:28 / penk"

!

installSettingsApplicationsIn:aSettingsApp

    aSettingsApp addIcon:self communicationIcon forCategory:'Communication'.

    aSettingsApp addIcon:self compilerIcon forCategory:'Compiler'.

    aSettingsApp addIcon:ToolbarIconLibrary systemBrowser24x24Icon forCategory:'Tools/System Browser'.

    self settingsList do:[ :entry| | applName applClass  |

        self installSettingsEntry:entry forSettingsApp:aSettingsApp.

    ].

!

installSettingsEntry:entry forSettingsApp:aSettingsApp

    |applName applClass|

    applName := entry at:1.

    applClass := entry at:2.

    aSettingsApp addApplClass:applClass withName:applName 

!

removeSettingsApplicationByClass:aClass

    | setList remItem|

    setList := self settingsList.

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

    remItem notNil ifTrue:[

        setList 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

    SettingsList isNil ifTrue:[

        SettingsList := self defaultSettingsApplicationList.

    ].

    ^ SettingsList

    "

     SettingsList := nil        

    "

    "Modified: / 16.12.2002 / 18:12:50 / penk"

! !

!AbstractLauncherApplication methodsFor:'private'!

findApplicationClass:classOrClassName nameSpace:aNameSpace

    "find some application, given the classes name.

     Look for it in Smalltalk and the given nameSpace"

    |cls|

    classOrClassName isBehavior ifTrue:[

        cls := classOrClassName.

    ] ifFalse:[

        cls := Smalltalk at:classOrClassName asSymbol.

        cls isNil ifTrue:[

            "/ look if its in the nameSpace

            aNameSpace notNil ifTrue:[

                cls := aNameSpace at:classOrClassName asSymbol

            ]

        ].

        cls isNil ifTrue:[

            self warn:(resources string:'Sorry, the ''%1''-class is not available.' with:classOrClassName).

            ^ nil

        ].

    ].

    ^ cls

!

findWindow:title

    "a helper for find & destroy and find & raise operations;

     let user choose a view and return it; return nil on cancel"

    ^ self findWindow:title windowGroupFilter:nil

!

findWindow:title windowGroupFilter:windowGroupFilterOrNil

    "a helper for find & destroy and find & raise operations;

     let user choose a view and return it; return nil on cancel"

    |knownTopViews nameList box|

    knownTopViews := IdentitySet new.

    Screen allScreens do:[:aScreen |

        aScreen knownViews do:[:aView |

            |top showIt wg|

            aView notNil ifTrue:[

                top := aView topView.

                (top isKindOf:DebugView) ifTrue:[

                    "/ although modal, show it.

                    showIt := top realized

                ] ifFalse:[

                    wg := top windowGroup.

                    showIt := (wg notNil and:[wg isModal not]).

                    showIt ifTrue:[

                        windowGroupFilterOrNil notNil ifTrue:[

                            showIt := windowGroupFilterOrNil includes:wg

                        ]

                    ]

                ].

                showIt ifTrue:[

                    knownTopViews add:top

                ]

            ]

        ]

    ].

    knownTopViews := knownTopViews asOrderedCollection.

    knownTopViews sort:[:v1 :v2 | |l1 l2|

                                l1 := v1 label ? 'aView'.

                                l2 := v2 label ? 'aView'.

                                l1 < l2

                       ].

    nameList := knownTopViews collect:[:v | 

                                        |isDead wg p l|

                                        l := v label ? 'aView'.

                                        v device == Display ifFalse:[

                                            l := l , ' [' , (v device displayName ? '?') , ']'

                                        ].

                                        ((wg := v windowGroup) notNil

                                        and:[(p := wg process) notNil

                                        and:[p state ~~ #dead]]) ifTrue:[

                                            l  

                                        ] ifFalse:[

                                            l , ' (dead ?)'

                                        ]

                                      ].

    box := ListSelectionBox new.

    box selectionChangeCallback:[:selectionIndex |   |v|

                                    v := knownTopViews at:box selectionIndex.

                                    v raise. box raise 

                                ].

    box noEnterField.

    box list:nameList.

    box label:(resources string:'View Selection').

    box title:(resources string:title) withCRs.

    box action:[:selection |

        |v|

        v := knownTopViews at:box selectionIndex.

        box destroy.

        ^ v

    ].

    box extent:400@300.

    box open.

    ^ nil

!

openApplication: classOrClassName

     "open an application, given by the classe name."

    self openApplication:classOrClassName nameSpace:nil

!

openApplication:classOrClassName nameSpace:aNameSpace

    "open some application, given the classes name.

     Look for it in Smalltalk and the given nameSpace"

    self openApplication:classOrClassName nameSpace:aNameSpace with:#open

!

openApplication:classOrClassName nameSpace:aNameSpace with:aSelector

    "open some application, given the classes name.

     Look for it in Smalltalk and the given nameSpace"

    |cls|

    cls := self findApplicationClass:classOrClassName nameSpace:aNameSpace.

    cls isNil ifTrue:[

        ^ self

    ].

    Autoload autoloadFailedSignal handle:[:ex |

        self warn:(resources string:'Sorry, the %1 class seems to be not available.' with:cls name)

    ] do:[

        self withWaitCursorDo:[

            cls perform:aSelector

        ]

    ]

!

pickAView

    "let user pick a view and return it"

    |v|

    (Delay forSeconds:1) wait.

    v := Screen current viewFromUser.

    v isNil ifTrue:[

	self warn:'Sorry, this is not a smalltalk view'.

	^ nil

    ].

    ^ v

!

saveScreenImage:anImage defaultName:defaultName

    "save an image into a file 

     - ask user for filename using a fileSelectionBox."

    |fileName|

    fileName := Dialog

                    requestFileName:(resources string:'Save hardcopy image in:') 

                    default:(defaultName , '.tiff')

                    ok:(resources string:'Save')

                    abort:(resources string:'Cancel')

                    pattern:'*.tiff'

                    fromDirectory:nil

                    whenBoxCreatedEvaluate:[:box | 

                                                |editButton|

                                                UserPreferences current useNewFileDialog ifFalse:[

                                                    editButton := Button label:(resources string:'Edit').

                                                    (DialogBox defaultOKButtonAtLeft) ifFalse:[

                                                        box addButton:editButton before:nil

                                                    ] ifTrue:[

                                                        box addButton:editButton after:nil

                                                    ].

                                                    editButton 

                                                        action:[ 

                                                            box hide; destroy.

                                                            ImageEditor openOnImage:anImage.

                                                        ].

                                                ]