"

 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'

	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.

"

!

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.

    [author:]

        Claus Gittinger

"

! !

!Launcher  class methodsFor:'accessing'!

current

    "return the launcher running on the current screen.

     (for access via addMenu/ removeMenu)"

    |screen|

    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

    |image|

    CachedAboutIcon notNil ifTrue:[^ CachedAboutIcon].

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

    image notNil ifTrue:[

        |green dark|

        Screen current hasColors ifTrue:[

            green := (Color red:0 green:80 blue:20) "darkened".

            dark := Color gray: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: 28.5.1996 / 20:55:15 / cg"

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

!

buttonImageSize

    "images in buttonPanel are sized to this.

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

     or any other useful size"

    ^ 32@32

    "Modified: 19.4.1996 / 16:36:17 / cg"

!

smallAboutIcon

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

! !

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

about

    |box|

    box := AboutBox new.

    box autoHideAfter:10 with:[].

    box showAtCenter

!

showBookPrintDocument

    self showDocumentation:'BOOK.html'

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

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

!

showDocumentation:aRelativeDocFilePath

    "

     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: 21.5.1996 / 14:15:57 / cg"

!

showLicenceConditions

    self showDocumentation:'../german/LICENCE.STX.html'

    "Created: 14.9.1996 / 12:35:00 / cg"

    "Modified: 14.9.1996 / 13:28:51 / cg"

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

!

startClassDocumentation

    self showDocumentation:'classDoc/TOP.html'

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

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

!

startDocumentationIndex

    self showDocumentation:'index.html'

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

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

!

startDocumentationTool

    self showDocumentation:'TOP.html'

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

!

toggleActiveHelp:aBoolean

    ActiveHelp notNil ifTrue:[

	helpIsOn := aBoolean.

	helpIsOn ifTrue:[

	    ActiveHelp start

	] ifFalse:[

	    ActiveHelp stop

	]

    ].

! !

!Launcher methodsFor:'actions - classes'!

browseImplementors

    |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

!

browseResources

    |enterBox t|

    enterBox := EnterBox title:(resources at:'Resource symbol (nil for any):') withCRs.

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

    enterBox action:[:resourceName |

        |rsc|

        (resourceName isNil or:[resourceName isEmpty]) ifTrue:[

            t := 'methods with any resource'.

            rsc := nil

        ] ifFalse:[

            t := 'methods with ' , resourceName , '-resource'.

            rsc := resourceName asSymbolIfInterned.

        ].

        self withWaitCursorDo:[

            SystemBrowser browseForResource:rsc

                          in:(Smalltalk allClasses)

                          title:t

        ]  

    ].

    enterBox showAtPointer

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

    "Modified: 29.5.1996 / 17:30:38 / cg"

!

browseSenders

    |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

!

startChangesBrowser

    self withWaitCursorDo:[ChangesBrowser open]

!

startClassBrowser

    SystemBrowser askThenBrowseClass

!

startClassHierarchyBrowser

    SystemBrowser askThenBrowseClassHierarchy

!

startClassTreeView

    self withWaitCursorDo:[ClassTreeGraphView open]

!

startFileBrowser

    self withWaitCursorDo:[FileBrowser open]

!

startFullClassBrowser

    SystemBrowser askThenBrowseFullClassProtocol

!

startJavaBrowser

    JavaBrowser notNil ifTrue:[

        self withWaitCursorDo:[JavaBrowser open]

    ]

    "Created: 18.4.1996 / 15:55:44 / cg"

    "Modified: 19.4.1996 / 16:39:08 / cg"

!

startSystemBrowser

    self withWaitCursorDo:[SystemBrowser open]

!

startWorkspace

    Workspace open

! !

!Launcher methodsFor:'actions - demos'!

openDemo:className

    |cls|

    cls := Smalltalk at:className.

    cls isNil ifTrue:[

        self warn:'sorry, the ' , className , ' class is not available.'.

    ] ifFalse:[

        Autoload autoloadFailedSignal handle:[:ex |

            self warn:'sorry, the ' , className , ' class seems to be not available.'

        ] do:[

            (Smalltalk at:className) open

        ]

    ]

    "Modified: 10.5.1996 / 15:56:47 / cg"

!

startTetris

    Tetris open

!

startTicTacToe

    TicTacToeGame open

!

startTicTacToe2

    TicTacToeGame open2UserGame

! !

!Launcher methodsFor:'actions - file'!

exit

    (self confirm:(resources string:'Are you certain you want to exit without saving ?'))

    ifTrue:[

	self saveAllViews.

	Smalltalk exit

    ]

!

objectModuleDialog

    |allModules moduleNames

     allObjects methodObjects methodNames 

     cObjects cObjectNames cFunctionNames

     otherObjects otherObjectNames

     box l handles unloadButton

     list1 list2 listView1 listView2

     y panel 

     showBuiltIn showModules showMethods showCObjects showOthers

     moduleListUpdater check canDoIt menu|

    showBuiltIn := true asValue. 

    canDoIt := ObjectFileLoader notNil and:[ObjectFileLoader canLoadObjectFiles].

    showModules := canDoIt asValue. 

    showMethods := canDoIt asValue.

    showCObjects := canDoIt asValue.

    showOthers := canDoIt asValue.

    moduleListUpdater := [

            |l|

            list2 list:nil.

            l := Array new.

            handles := Array new.

            (showModules value or:[showBuiltIn value]) ifTrue:[

                allModules := ObjectMemory binaryModuleInfo asOrderedCollection.

                (showBuiltIn value and:[showModules value]) ifFalse:[

                    allModules := allModules select:[:i |

                        |wantToSee|

                        wantToSee := (i at:#dynamic).

                        showBuiltIn value ifTrue:[

                            wantToSee := wantToSee not

                        ].

                        wantToSee

                    ]

                ].

                "/ sorting by reverse id brings newest ones to the top (a side effect)

                allModules sort:[:a :b | (a at:#id) > (b at:#id)].

                moduleNames := allModules collect:[:entry | (entry at:#name)].

                l := l , moduleNames.

                handles := handles , allModules.

            ].

            showMethods value ifTrue:[

                allObjects := ObjectFileLoader loadedObjectHandles.

                methodObjects := (allObjects select:[:h | h isMethodHandle]) asArray.

                methodNames := methodObjects collect:[:mH | mH method isNil ifTrue:[

                                                                'compiled method - removed' , ' (in ' , mH pathName , ')'

                                                            ] ifFalse:[

                                                                'compiled method ' , mH method whoString , ' (in ' , mH pathName , ')'

                                                            ].

                                                     ].

                l := l , methodNames.

                handles := handles , methodObjects.

            ].

            showCObjects value ifTrue:[

                allObjects := ObjectFileLoader loadedObjectHandles.

                cObjects := (allObjects select:[:h | h isFunctionObjectHandle]) asArray.

                cObjectNames := cObjects collect:[:entry | entry pathName].

                l := l , cObjectNames.

                handles := handles , cObjects.

            ].

            showOthers value ifTrue:[

                allObjects := ObjectFileLoader loadedObjectHandles.

                otherObjects := (allObjects select:[:h | (h isFunctionObjectHandle

                                                         or:[h isMethodHandle

                                                         or:[h isClassLibHandle]]) not]) asArray.

                otherObjectNames := otherObjects collect:[:entry | entry pathName].

                l := l , otherObjectNames.

                handles := handles , otherObjects.

            ].

            list1 list:l.

            unloadButton disable.

        ].

    list1 := SelectionInList new.