"

 COPYRIGHT (c) 1995 by Claus Gittinger

              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.

"

ApplicationModel subclass:#Launcher

	instanceVariableNames:'myMenu buttonPanel transcript infoView infoProcess helpIsOn

		isMainLauncher'

	classVariableNames:'CachedAboutIcon OpenLaunchers NotifyingEmergencyHandler'

	poolDictionaries:''

	category:'Interface-Smalltalk'

!

!Launcher class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1995 by Claus Gittinger

              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.

"

!

customization

"

    Of course, it is possible to change the Launcher class itself

    as appropriate, however, we suggest you create a subclass (say MyLauncher),

    define it as autoloaded in the patches file, and redefine some methods

    in that class. 

    That way, your changes are easier to reintroduce in case of an ST/X upgrade.

    adding more buttons to the button-panel:

      see the method #buttonPanelSpec;

        it defines a list of selectors and icons, which is used by 

        #setupButtonPanelIn:. 

        There, for each entry, a button with that icon is created, 

        which sends a selector-message to the launcher.

        Add entries to that list, and define appropriate methods.

        For example, to add a button which opens a drawTool,

        change #buttonPanelSpec to:

        buttonPanelSpec

            ^ #(

                #(startSystemBrowser  'SBrowser32x32.xbm')

                #(startFileBrowser    'FBrowser32x32.xbm')

                #(nil nil)

                #(startChangesBrowser 'CBrowser32x32.xbm')

                #(nil nil)

                #(nil nil)

                #(startDrawTool       'DrawTool.xbm')

             )

        the panel adjusts its height as appropriate - you may want to

        create new (small) icons for a good look.

    adding an entry to a menu:

        see the #setupMenu method; either add another top-menu, or

        add entries to an existing menu.

        All menu setup has been extracted into separate init-methods,

        so there is often only a need to redefine one of those

        (for example, to add your own demos, only redefine setupDemoMenu).

        To add a new master-item with its own pullDown, redefine setupMainMenu

        to include another selector and add the correspoonding menu there.

"

!

documentation

"

    a new launcher, combining old Launchers menu and transcript into

    one view. (you no longer have to move two views around all the time ...).

    Also, this app makes first use of the new compatibility framework;

    you will notice, that this is a subclass of ApplicationModel.

    New applications will no longer be built as subclasses of standardSystemView.

    See #customization for information regarding your own private

    launcher functions.

    Notice:

        Since there can only be one SystemTranscript, opening a new launcher

        will automatically close the current one (except for a remote launcher,

        opened on another display).

    [author:]

        Claus Gittinger

    [see also:]

        Examples_misc::MyLauncher

    [start with:]

        Launcher open

"

!

examples

"

    As ST/X can handle multiple screens, there is nothing (except fear ;-)

    from preventing you to work with your friend in the same image.

    To do this, evaluate (replace localhost by whatever):

                                                                        [exBegin]

        |display2|

        display2 := XWorkstation new initializeFor:'localhost:0'.

        display2 isNil ifTrue:[

            self warn:'cannot connect.'.

        ] ifFalse:[

            display2 startDispatch.

            display2 keyboardMap:(Display keyboardMap).

            Launcher openOnDevice:display2.

        ]

                                                                        [exEnd]

    But you should be somewhat careful, the other guy may change things so

    that you are blocked (start high prio processes, change classes etc.)

    Anyway, a nice demo ....

"

! !

!Launcher class methodsFor:'accessing'!

current

    "return the launcher running on the current screen.

     (for access via addMenu/ removeMenu)"

    OpenLaunchers do:[:aLauncher |

        aLauncher window graphicsDevice == Screen current ifTrue:[

            ^ aLauncher

        ]

    ].

    ^ nil.

    "

     Launcher current

    "

    "Modified: 5.7.1996 / 17:55:28 / cg"

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

! !

!Launcher class methodsFor:'defaults'!

aboutIcon

    "return the icon shown in the about menu-item and used

     as ST/X about icon"

    |image|

    CachedAboutIcon notNil ifTrue:[^ CachedAboutIcon].

    image := Image fromFile:'SmalltalkX.xbm'.

    image notNil ifTrue:[

        |green dark|

        Screen current hasColors ifTrue:[

            green := (Color redPercent:0 greenPercent:80 bluePercent:20) "darkened".

            dark := Color grayPercent:10.

            image photometric:#palette.

        ] ifFalse:[

            dark := Color black.

            green := Color white.

            image photometric:#blackIs0.

        ].

        image colorMap:(Array with:dark with:green).

"/        Screen current depth > 2 ifTrue:[

"/            image := (Image implementorForDepth:Screen current depth) fromImage:image.

"/        ]

    ].

    CachedAboutIcon := image.

    ^ image

    "

     CachedAboutIcon := nil.

     Launcher aboutIcon

    "

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

    "Modified: 8.1.1997 / 15:01:30 / cg"

!

buttonImageSize

    "images in buttonPanel are sized to this.

     Can be redefined in subclasses to return nil (no scaling)

     or any other useful size"

    <resource: #style (#launcherButtonSize)>

    ^ View styleSheet at:#launcherButtonSize default:(32@32)

    "Modified: 9.1.1997 / 13:48:09 / cg"

!

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"

!

smallAboutIcon

    "return the icon shown in the about menu-item"

    |image|

    image := self aboutIcon.

    image notNil ifTrue:[

        image := image magnifiedBy:0.4.

    ].

    ^ image

    "

     CachedAboutIcon := nil.

     Launcher aboutIcon.

     Launcher smallAboutIcon.

    "

    "Modified: 9.9.1996 / 22:42:12 / stefan"

    "Modified: 8.1.1997 / 15:02:56 / cg"

! !

!Launcher methodsFor:'actions - about & help'!

about

    "show an about box"

    |box|

    box := AboutBox new.

    box autoHideAfter:10 with:[].

    box showAtCenter

    "Modified: 8.1.1997 / 14:37:07 / cg"

!

showBookPrintDocument

    "open an HTML browser on the 'book'-printing document"

    self showDocumentation:'BOOK.html'

    "Modified: 31.8.1995 / 13:11:28 / claus"

    "Created: 12.9.1996 / 01:53:30 / cg"

    "Modified: 8.1.1997 / 14:42:59 / cg"

!

showDocumentation:aRelativeDocFilePath

    "open an HTML browser on some document"

    "

     although that one is not yet finished,

     its better than nothing ...

    "

    HTMLDocumentView notNil ifTrue:[

        "

         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 (yet) 

included in this architectures 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: 31.8.1995 / 13:11:08 / claus"

    "Modified: 8.1.1997 / 14:42:42 / cg"

!

showLicenceConditions

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

    |lang doc|

    ((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: 14.9.1996 / 12:35:00 / cg"

    "Modified: 23.9.1996 / 17:03:15 / stefan"

    "Modified: 8.1.1997 / 14:39:57 / cg"

!

startClassDocumentation

    "open an HTML browser on the 'classDoc/TOP' document"

    self showDocumentation:'classDoc/TOP.html'

    "Modified: 31.8.1995 / 13:11:28 / claus"

    "Created: 22.4.1996 / 21:03:56 / cg"

    "Modified: 8.1.1997 / 14:42:04 / cg"

!

startDocumentationIndex

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

    self showDocumentation:'index.html'

    "Modified: 31.8.1995 / 13:11:28 / claus"

    "Created: 17.4.1996 / 22:08:55 / cg"

    "Modified: 8.1.1997 / 14:41:23 / cg"

!

startDocumentationTool

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

    self showDocumentation:'TOP.html'

    "Modified: 31.8.1995 / 13:11:28 / claus"

    "Modified: 8.1.1997 / 14:41:38 / cg"

!

startWhatsNewDocumentation

    "open an HTML browser on the 'whatsNew.html' document"

    self showDocumentation:'whatsNew.html'

    "Modified: 31.8.1995 / 13:11:28 / claus"

    "Created: 18.10.1996 / 14:00:35 / cg"

    "Modified: 8.1.1997 / 14:39:32 / cg"

!

toggleActiveHelp:aBoolean

    "turn on/off active help"

    ActiveHelp notNil ifTrue:[

        helpIsOn := aBoolean.

        helpIsOn ifTrue:[

            ActiveHelp start

        ] ifFalse:[

            ActiveHelp stop

        ]

    ].

    "Modified: 8.1.1997 / 14:37:30 / cg"

! !

!Launcher methodsFor:'actions - classes'!

browseImplementors

    "open an implementors- browser after asking for a selector"

    |enterBox|

    enterBox := EnterBox title:(resources at:'Browse implementors of:') withCRs.

    enterBox okText:(resources at:'browse').

    enterBox action:[:selectorName |

        |cls|

        self withWaitCursorDo:[SystemBrowser browseImplementorsOf:selectorName]  

    ].

    enterBox showAtPointer

    "Modified: 8.1.1997 / 14:44:09 / cg"

!

browseResources

    "open a resource- browser after asking for a resource string"

    |box resourceHolder valueHolder component rsrc value t anyString|

    anyString := resources string:'* any *'.

    resourceHolder := ValueHolder newString.

    valueHolder := '*' asValue.

    box := DialogBox new.

    box label:(resources at:'Resource search:').

    component := box addTextLabel:(resources at:'Search for methods which contain a\particular resource specification') withCRs.

    component adjust:#left.

    box addVerticalSpace:10.

    component := box addTextLabel:(resources at:'Resource symbol (empty for any; no matchPattern allowed):') withCRs.

    component adjust:#left.

    component :=  box addComboBoxOn:resourceHolder tabable:true.

    component list:((Array with:anyString) , #('canvas' 'menu' 'keyboard' 'style' 'image' 'programMenu' nil 'needsFix')).

    component := box addTextLabel:(resources at:'Resource value (* for any; matchPattern is allowed):') withCRs.

    component adjust:#left.

    box addInputFieldOn:valueHolder tabable:true.

    box addVerticalSpace:10.

    box addHelpButtonFor:'programming/language.html#RESOURCEDEFS'.

    box addAbortButton; addOkButton.

    box showAtPointer.

    box destroy.

    box accepted ifTrue:[

        rsrc := resourceHolder value.

        value := valueHolder value.

        (rsrc isNil or:[rsrc isEmpty or:[rsrc = '*' or:[rsrc = anyString]]]) ifTrue:[

            t := 'methods with any resource'.

            rsrc := nil

        ] ifFalse:[

            t := 'methods with #' , rsrc , '-resource'.

            rsrc := rsrc withoutSeparators asSymbol

        ].

        (value isNil or:[value isEmpty or:[value = '*']]) ifTrue:[

            t := t , ' and any value'.

            value := nil

        ] ifFalse:[

            t := t , ' and value ' , value.

        ].

        self withWaitCursorDo:[

            SystemBrowser browseForResource:rsrc

                          containing:value

                          in:(Smalltalk allClasses)

                          title:t

        ]  

    ].

    "Created: 28.5.1996 / 13:15:16 / cg"

    "Modified: 3.7.1997 / 14:15:37 / cg"

!

browseSenders

    "open a senders- browser after asking for a selector"

    |enterBox|

    enterBox := EnterBox title:(resources at:'Browse senders of:') withCRs.

    enterBox okText:(resources at:'browse').

    enterBox action:[:selectorName |

        |cls|

        self withWaitCursorDo:[SystemBrowser browseAllCallsOn:selectorName]  

    ].

    enterBox showAtPointer

    "Modified: 8.1.1997 / 14:46:46 / cg"

!

startChangesBrowser

    "open a changebrowser"

    self withWaitCursorDo:[ChangesBrowser open]

    "Modified: 8.1.1997 / 14:47:07 / cg"

!

startClassBrowser

    "open a classBrowser; asks for class"