ToolApplicationModel subclass:#AbstractLauncherApplication

	instanceVariableNames:'transcript'

	classVariableNames:'NotifyingEmergencyHandler OpenLaunchers'

	poolDictionaries:''

	category:'Interface-Smalltalk'

!

Object subclass:#LauncherDialogs

	instanceVariableNames:''

	classVariableNames:''

	poolDictionaries:''

	privateIn:AbstractLauncherApplication

!

!AbstractLauncherApplication class methodsFor:'accessing'!

current

    "return the launcher running on the current screen.

     (for access via addMenu/ removeMenu)"

    |currentScreen|

    OpenLaunchers size > 0 ifTrue:[

        currentScreen := Screen current.

        OpenLaunchers do:[:aLauncher |

            aLauncher graphicsDevice == currentScreen ifTrue:[

                ^ aLauncher

            ]

        ]

    ].

    ^ nil.

    "

     Launcher current

    "

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

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

!

openLaunchers

    "return all opened launchers"

    ^OpenLaunchers ? (OpenLaunchers := OrderedCollection new)

! !

!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 := Exception notifyingEmergencyHandler

    ].

    ^ NotifyingEmergencyHandler

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

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

! !

!AbstractLauncherApplication methodsFor:'private'!

findWindow:title

    "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:[

                    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 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 showAtPointer.

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

    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).

            ^ 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 image in:')

		    default:(defaultName , '.tiff')

		    ok:(resources string:'save')

		    abort:(resources string:'cancel')

		    pattern:'*.tiff'.

    fileName notNil ifTrue:[

	anImage saveOn:fileName

    ].

    "Modified: / 21.2.1996 / 13:09:28 / cg"

    "Created: / 29.1.1998 / 23:20:36 / cg"

!

showDocumentation:aRelativeDocFilePath

    "open an HTML browser on some document"

    "

     although that one is not yet finished,

     its better than nothing ...

    "

    HTMLDocumentView notNil ifTrue:[

	self withWaitCursorDo:[

	    "

	     temporary kludge;

	     not all machines can autoload binaries;

	     however, on my SGI (which can) we want it

	     to load automatically.

	    "

	    HTMLDocumentView isLoaded ifFalse:[

		ErrorSignal catch:[HTMLDocumentView autoload]

	    ].

	    HTMLDocumentView isLoaded ifTrue:[

		HTMLDocumentView openFullOnDocumentationFile:aRelativeDocFilePath. 

		^ self

	    ].

	]

    ].

    self warn:'Sorry, the ST/X HTML reader is not

included in this release.

Please use Mosaic, netscape, chimera or any

other HTML viewer to see the documentation.

The documentation is found in the ''doc/online'' directory.'.

    "Modified: / 25.2.1998 / 21:24:20 / cg"

! !

!AbstractLauncherApplication methodsFor:'private - settings callBacks'!

changeViewStyleTo:newStyle

    newStyle notNil ifTrue:[

        self withWaitCursorDo:[

            transcript showCR:'change style to ' , newStyle , ' ...'.

            View defaultStyle:newStyle asSymbol.

        ].

        self reopenLauncher.

        DebugView newDebugger.

    ]

!

fontBoxForEncoding:encodingMatch

    "open a fontBox, showing fonts which match some encoding

     (used when changing to japanese ...)"

    ^ LauncherDialogs fontBoxForEncoding:encodingMatch for:self.

"/    |box y b

"/     labelDef buttonDef listDef menuDef textDef

"/     models labels allOfThem filter|

"/

"/    encodingMatch notNil ifTrue:[

"/        filter := [:f | f encoding notNil 

"/                        and:[encodingMatch match:f encoding]].

"/    ].

"/

"/    models := OrderedCollection new.

"/    labels := OrderedCollection new.

"/

"/    models add:(allOfThem := nil asValue).

"/    models add:(labelDef := Label defaultFont asValue).

"/    models add:(buttonDef := Button defaultFont asValue).

"/    models add:(listDef := SelectionInListView defaultFont asValue).

"/    models add:(menuDef := MenuView defaultFont asValue).

"/    models add:(textDef := TextView defaultFont asValue).

"/

"/    box := Dialog new.

"/    box label:(resources string:'Font settings').

"/

"/    models

"/    with:(resources array:#('all' 'labels' 'buttons' 'lists' 'menus' 'edit text'))

"/    do:[:model :title |

"/        |y2 lbl f i|

"/

"/        f := model value.

"/

"/        (box addTextLabel:title) adjust:#left.

"/

"/        y := box yPosition.

"/        b := box addComponent:(Button label:(resources string:'change ...')) tabable:true.

"/        b relativeExtent:nil; extent:(b preferredExtent).

"/        y2 := box yPosition.

"/        box yPosition:y.

"/        i := box leftIndent.

"/        box leftIndent:(b widthIncludingBorder + View viewSpacing).

"/        (lbl := box addTextLabel:'')

"/            adjust:#left;

"/            font:(model value);

"/            labelChannel:(BlockValue 

"/                            with:[:v | |f|

"/                                f := v value.

"/                                f isNil ifTrue:[

"/                                    ''

"/                                ] ifFalse:[

"/                                    f userFriendlyName

"/                                ]

"/                            ]

"/                            argument:model).

"/        labels add:lbl.

"/

"/        box leftIndent:i.

"/        box yPosition:(box yPosition max:y2).

"/        box addVerticalSpace.

"/        box addHorizontalLine.

"/        box addVerticalSpace.

"/

"/        b action:[

"/            |f|

"/

"/            f := FontPanel 

"/                fontFromUserInitial:(model value) 

"/                              title:(resources string:'font for %1' with:title)

"/                             filter:filter.

"/            f notNil ifTrue:[

"/                model == allOfThem ifTrue:[

"/                    models do:[:m | m value:f].

"/                    labels do:[:l | l font:f]

"/                ] ifFalse:[

"/                    model value:f.  

"/                    lbl font:f.

"/                ].

"/            ]

"/        ].

"/        model == allOfThem ifTrue:[

"/            box addVerticalSpace

"/        ]

"/    ].

"/

"/    box addAbortButton; addOkButton.

"/    (box addButton:(Button label:(resources string:'defaults')) before:nil)

"/        action:[

"/            "/ fetch defaults

"/            View readStyleSheetAndUpdateAllStyleCaches.

"/            labelDef value: Label defaultFont.

"/            buttonDef value: Button defaultFont.

"/            listDef value: SelectionInListView defaultFont.

"/            menuDef value: MenuView defaultFont.

"/            textDef value: TextView defaultFont.

"/        ].

"/

"/    box open.

"/    box accepted ifTrue:[

"/        Label defaultFont:labelDef value.

"/        Button defaultFont:buttonDef value.

"/        Toggle defaultFont:buttonDef value.

"/        SelectionInListView defaultFont:listDef value.

"/        MenuView defaultFont:menuDef value.

"/        PullDownMenu defaultFont:menuDef value.

"/        TextView defaultFont:textDef value.

"/        EditTextView defaultFont:textDef value.

"/        CodeView defaultFont:textDef value.

"/    ].

"/    box destroy.

"/    ^ box accepted

    "Modified: / 15.9.1998 / 22:04:56 / cg"

!

reopenLauncher

    "reopen a new launcher.

     for now (since style & language settings currently do

     not affect living views ...)

     WARNING: bad design: Message known in LauncherDialogs"

    |oldOrigin contents builder newLauncher|

    oldOrigin := self window origin.

    contents := transcript endEntry; list.

    builder := self class openAt:oldOrigin.

    builder window waitUntilVisible.

    builder window origin:oldOrigin.

    newLauncher := builder application.

    newLauncher transcript list:contents; hideCursor; scrollToBottom; cursorToEnd; showCursor.

    ^ newLauncher

    "Modified: / 4.8.1998 / 17:08:33 / cg"

! !

!AbstractLauncherApplication methodsFor:'queries'!

processName

    "for monitors only - my name"

    ^ 'ST/X Launcher'

!

transcript

    "my transcript"

    ^ transcript

! !

!AbstractLauncherApplication methodsFor:'startup / release'!

addTopViewsToCurrentProject

    "ignored here - the launcher is always global (i.e. not project private)."

    ^ self

!

requestForWindowClose

    "close request from windowing system (window close);

     confirm and ask if closing of launcher only or

     a smalltalk-exit is wanted"

    |answer|

    answer := Dialog 

                confirmWithCancel:(resources string:'Close %1 only or exit Smalltalk (close all)?' with:self class name)

                labels:(resources array:#('Cancel' 'Exit' 'Close'))

                default:3.

    answer isNil ifTrue:[

        "/ cancel

        ^ false

    ].

    answer == true ifTrue:[

        ^ true

    ].

    self exit

    "Modified: / 5.9.1998 / 16:40:11 / cg"

!

saveAndTerminateRequest

    "some windowManagers can send this, to shutDown an application

     but let it save its state before, for later restart. 

     Although I have not yet encountered such a windowManager,

     we are already prepared for this ;-)"

    self snapshot.

    super saveAndTerminateRequest

! !

!AbstractLauncherApplication methodsFor:'user actions - about'!

openLicenseConditions

    "open an HTML browser on the 'LICENCE' document"

    self withWaitCursorDo:[

	|lang doc|

	Smalltalk releaseIdentification = 'ST/X_free_demo_vsn' ifTrue:[

	    doc := 'english/LICENCE_DEMO_STX.html'

	] ifFalse:[

	    ((lang := Smalltalk language) = 'de'

	    or:[lang = 'german']) ifTrue:[

		doc := 'german/LICENCE_STX.html'

	    ] ifFalse:[

		doc := 'english/LICENCE_STX.html'

	    ].

	].

	doc := resources at:'LICENCEFILE' default:doc.

	self showDocumentation:('../' , doc)

    ]

    "Created: / 5.2.1998 / 21:43:19 / cg"

    "Modified: / 23.4.1998 / 11:45:53 / cg"

! !

!AbstractLauncherApplication methodsFor:'user actions - classes'!

browseAllBreakAndTracePoints

    "open a browser showing all breakPointed/traced methods

     (but, to get rid of them, there is also a menu itme to remove them all)"

    SystemBrowser 

        browseMethods: WrappedMethod allInstances