"

 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:#NewLauncher

!

!NewLauncher 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 NewLauncher class itself

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

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

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

"

! !

!NewLauncher class methodsFor:'defaults'!

aboutIcon

    |image|

    CachedAboutIcon notNil ifTrue:[^ CachedAboutIcon].

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

    image notNil ifTrue:[

	|green dark|

	Display hasColors ifTrue:[

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

	    dark := Color grey:10.

	    image photometric:#palette.

	] ifFalse:[

	    dark := Color black.

	    green := Color white.

	    image photometric:#blackIs0.

	].

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

"/        Display depth > 2 ifTrue:[

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

"/        ]

    ].

    CachedAboutIcon := image.

    ^ image

    "

     CachedAboutIcon := nil.

     NewLauncher aboutIcon

    "

    "Modified: 20.10.1995 / 21:54:58 / cg"

!

smallAboutIcon

    |image|

    image := self aboutIcon.

    image notNil ifTrue:[

	image := image magnifiedBy:0.4.

    ].

    ^ image

    "

     CachedAboutIcon := nil.

     NewLauncher aboutIcon.

     NewLauncher smallAboutIcon.

    "

! !

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

about

    |box|

    box := AboutBox new.

    box autoHideAfter:10 with:[].

    box showAtCenter

!

showDocumentation:aRelativeDocFilePath

    "

     although that one is not yet finished,

     its better than nothing ...

    "

    XtHTML notNil ifTrue:[

	"

	 temporary kludge;

	 not all machines can autoload binaries;

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

	 to load automatically.

	"

	XtHTML isLoaded ifFalse:[

	    (OperatingSystem getSystemType = 'iris') ifTrue:[

		ErrorSignal catch:[XtHTML autoload]

	    ]

	].

	XtHTML isLoaded ifTrue:[

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

!

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

	]

    ].

! !

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

!

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

!

startSystemBrowser

    self withWaitCursorDo:[SystemBrowser open]

!

startWorkspace

    Workspace open

! !

!NewLauncher methodsFor:'actions - demos'!

openDemo:className

    (Smalltalk at:className) open

!

startTetris

    Tetris open

!

startTicTacToe

    TicTacToeGame open

!

startTicTacToe2

    TicTacToeGame open2UserGame

! !

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

     box l unloadButton

     list1 list2 listView1 listView2

     y panel showBuiltIn showModules showMethods moduleListUpdater check|

    showBuiltIn := true asValue. 

    showModules := ObjectFileLoader notNil asValue. 

    showMethods := ObjectFileLoader notNil asValue.

    moduleListUpdater := Plug new.

    moduleListUpdater 

        respondTo:#getModules 

        with:[

            |l|

            l := 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.

            ].

            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.

            ].

            list1 list:l.

            unloadButton disable.

        ].

    list1 := SelectionInList new.

    list2 := SelectionInList new.

    showBuiltIn onChangeSend:#getModules to:moduleListUpdater.

    showModules onChangeSend:#getModules to:moduleListUpdater.

    showMethods onChangeSend:#getModules to:moduleListUpdater.

    box := Dialog new.

    box label:(resources string:'Module dialog').

    listView1 := HVScrollableView for:SelectionInListView miniScrollerH:true.

    listView1 model:list1.

    listView1 origin:0.0@0.0 corner:1.0@0.4. "/ ; inset:2.

    listView1 action:[:sel |

        |info classNames tabs|

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

            info := allModules at:sel ifAbsent:nil.

        ].

        info isNil ifTrue:[

            "/ selected a method

            list2 list:#().

            unloadButton enable.

        ] ifFalse:[

            "/ selected a package

            tabs := TabulatorSpecification unit:#inch positions:#(0 2.6).

            "/ fill bottom list with class-info

            classNames := (info at:#classNames) asSortedCollection.

            classNames := classNames collect:[:cName |

                            |cls entry rev listEntry|

                            listEntry := MultiColListEntry new:2 tabulatorSpecification:tabs.

                            listEntry colAt:1 put:cName.

                            cls := Smalltalk classNamed:cName.

                            cls isNil ifTrue:[

                                listEntry colAt:2 put:'(class removed)'.

                            ] ifFalse:[

                                rev := cls binaryRevision.

                                rev notNil ifTrue:[

                                    entry :='(bin: ' , rev.

                                    cls revision ~= rev ifTrue:[

                                        entry := entry , ' / src: ' , cls revision    

                                    ].

                                    listEntry colAt:2 put:entry , ')'

                                ] ifFalse:[

                                   cls revision notNil ifTrue:[

                                        listEntry colAt:2 put:'(overloaded by: ' , cls revision , ')' 

                                   ]

                                ]

                            ].

                            listEntry

                          ].

            list2 list:classNames.

            (info at:#dynamic) ifTrue:[

                unloadButton enable.

            ] ifFalse:[

                unloadButton disable.

            ].

        ]

    ].

    panel := HorizontalPanelView new.

    panel add:(l := Label label:'modules shown:').

    l adjust:#left; borderWidth:0.

    panel add:(CheckBox label:'builtin' model:showBuiltIn).

    panel add:(check := CheckBox label:'modules' model:showModules).

    ObjectFileLoader isNil ifTrue:[check disable].

    panel add:(check := CheckBox label:'methods' model:showMethods).

    ObjectFileLoader isNil ifTrue:[check disable].

    panel horizontalLayout:#fitSpace.

    box addComponent:panel tabable:true.

    box addComponent:listView1 tabable:true.

    listView1 topInset:(View viewSpacing + panel preferredExtent y).

    listView1 origin:0.0@0.0 corner:1.0@0.4. "/ ; inset:2.

    l := box addTextLabel:(resources string:'contained classes/subsets:').

    l adjust:#left; borderWidth:0.

    l origin:0.0@0.4 corner:1.0@0.4.

    l topInset:(View viewSpacing).

    l bottomInset:((l preferredExtent y) negated - View viewSpacing).

    listView2 := HVScrollableView for:SelectionInListView  miniScrollerH:true.

    listView2 model:list2; printItems:false.

    box addComponent:listView2 tabable:true.

    listView2 origin:0.0@0.4 corner:1.0@1.0. "/ ; inset:2.

    listView2 disable.

    unloadButton := Button label:(resources string:'unload').

    unloadButton action:[

        self withWaitCursorDo:[

            box withWaitCursorDo:[

                |info idx pathName|

                idx := list1 selectionIndex.

                info := allModules at:idx ifAbsent:nil.

                info isNil ifTrue:[

                    "/ selected a method

                    idx := idx - allModules size.

                    pathName := (methodObjects at:idx) pathName.

                ] ifFalse:[

                    "/ selected a package

                    pathName := (info at:#pathName).

                ].

                ObjectFileLoader unloadObjectFile:pathName.

                moduleListUpdater getModules.

                unloadButton disable.

            ]

        ]

    ].

    moduleListUpdater getModules.

    box addButton:unloadButton.

    box addAbortButtonLabelled:(resources string:'close').

    y := box yPosition.

    listView2 topInset:(l preferredExtent y + 5).

    listView2 bottomInset:(box preferredExtent y - y).

    box width:(350 min:(box device width * 2 // 3)); 

        height:(450 min:(box device height - 50)); 

        sizeFixed:true.

    box showAtPointer.

    box destroy.

    "Modified: 17.9.1995 / 16:47:50 / claus"

    "Modified: 9.12.1995 / 21:08:35 / cg"

!

snapshot

    |saveBox|

    saveBox := EnterBox title:(resources at:'filename for image:') withCRs.

    saveBox okText:(resources at:'save').

    saveBox action:[:fileName | 

	(ObjectMemory snapShotOn:fileName) ifFalse:[

	    "

	     snapshot failed for some reason (disk full, no permission etc.)

	    "

	    self warn:(resources string:'failed to save snapshot image (disk full or not writable)').

	]

    ].