"

 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'

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

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 ifNil:[ (OpenLaunchers := IdentitySet 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 := NoHandlerError notifyingEmergencyHandler

    ].

    ^ NotifyingEmergencyHandler

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

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

! !

!AbstractLauncherApplication class methodsFor:'queries'!

isVisualStartable

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

    ^ self isSubclassOf:AbstractLauncherApplication

! !

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

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

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

    transcript notNil ifTrue:[contents := transcript endEntry; list].

    builder := self class openAt:oldOrigin.

    builder window waitUntilVisible.

    builder window origin:oldOrigin.

    newLauncher := builder application.

    transcript notNil ifTrue:[

        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 ifNil:[Transcript current]

! !

!AbstractLauncherApplication methodsFor:'startup / release'!

addTopViewsToCurrentProject

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

    ^ self

!