OldLauncher.st
author claus
Fri, 16 Jul 1993 11:44:07 +0200
changeset 0 571fd5eee315
child 3 9ff3765f06d0
permissions -rw-r--r--
Initial revision

"
 COPYRIGHT (c) 1991-93 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.
"

StandardSystemView subclass:#Launcher
       instanceVariableNames:'myMenu exitBox saveBox'
       classVariableNames:''
       poolDictionaries:''
       category:'Interface-Smalltalk'
!

Launcher comment:'

COPYRIGHT (c) 1991-93 by Claus Gittinger
              All Rights Reserved

allows startup of smalltalk applications

%W% %E%
written spring 91 by claus
'!

!Launcher class methodsFor:'instance creation'!

new
    ^ super
        extent:(100 @ 100)
        label:'Smalltalk'
        icon:(Form fromFile:'Smalltalk.xbm' resolution:100)

    "Launcher start"
! !

!Launcher methodsFor:'initialization'!

initialize
    super initialize.

    resources := ResourcePack fromFile:'Launcher.rs'.

    myMenu := ClickMenuView 
                labels:#('System Browser'
                         'Changes Browser'
                         'File Browser'
                         'Directory Browser'
                         'Workspace'
                         'Transcript'
                         'Project'
                         '-'
                         'Utilities'
                         'Goodies'
                         'Games & Demos'
                         '-'
                         'info & help'
                         '-'
                         'snapshot'
                         '-'
                         'exit'
                        )
                selectors:#(startSystemBrowser
                            startChangesBrowser
                            startFileBrowser
                            startDirectoryBrowser
                            startWorkspace
                            startTranscript
                            newProject
                            nil
                            utilityMenu
                            goodyMenu
                            gamesMenu
                            nil
                            helpMenu
                            nil
                            saveImage
                            nil
                            exitSmalltalk
                           )
                receiver:self
                      in:self.

    myMenu subMenuAt:#utilityMenu put:(
        PopUpMenu labels:#(
                            'Window tree'
                            'Class tree'
                            '-'
                            'Event monitor'
                            'Memory monitor'
                            'Memory usage'
                            '-'
                            'collect Garbage'
                            'ScreenSaver'
                           )
               selectors:#(
                            startWindowTreeView
                            startClassTreeView
                            nil
                            startEventMonitor
                            startMemoryMonitor
                            startMemoryUsage
                            nil
                            garbageCollect
                            startScreenSaver
                           )
                receiver:self
                     for:self

    ).

    myMenu subMenuAt:#gamesMenu put:(
        PopUpMenu labels:#(
                            'Tetris'
                            'TicTacToe'
                            '-'
                            'Animation'
                            'Globe'
                            '-'
                            'LogicTool'
                           )
               selectors:#(
                            startTetris
                            startTicTacToe
                            nil
                            startAnimation
                            startGlobeDemo
                            nil
                            startLogicTool
                          )
                receiver:self
                     for:self

    ).

    myMenu subMenuAt:#goodyMenu put:(
        PopUpMenu labels:#(
                            'Clock'
                            'Address Book'
                            '-'
                            'Directory View'
                            'MailTool'
                            'NewsTool'
                            '-'
                            'DrawTool'
                           )
               selectors:#(
                            startClock
                            startAddressBook
                            nil
                            startDirectoryView
                            startMailTool
                            startNewsTool
                            nil
                            startDrawTool
                          )
                receiver:self
                     for:self

    ).

    myMenu subMenuAt:#helpMenu put:(
        PopUpMenu labels:#(
                            'Overview'
                            'Getting started'
                            '-'
                            'Help Browser'
                           )
               selectors:#(
                            showOverview
                            showGettingStarted
                            nil
                            startHelpView
                          )
                receiver:self
                     for:self

    ).

    myMenu borderWidth:0.
    myMenu origin:(0 @ 0).
    myMenu font:(self font).
    self extent:(myMenu extent)   
!

realize
    self extent:(myMenu extent).
    self minExtent:(myMenu extent).
    self maxExtent:(myMenu extent).
    super realize
!

reinitialize
    "sent after snapin - first reinit menuview,
     then adjust my size"

    super reinitialize.
    myMenu reinitialize.
    self extent:(myMenu extent).
!

addToCurrentProject
    "ignored here"

    ^ self
! !

!Launcher methodsFor:'events'!

saveAndTerminate
    ObjectMemory snapShotOn:name
! !

!Launcher methodsFor:'user interaction'!

startScreenSaver
    ScreenSaver start
!

startSystemBrowser
    SystemBrowser start
!

startChangesBrowser
    ChangesBrowser start
!

startFileBrowser
    FileBrowser start
!

startDirectoryBrowser
    DirectoryBrowser start
!

startDirectoryView
    DirectoryView start
!

startWorkspace
    Workspace start
!

startWindowTreeView
    WindowTreeView start
!

startClassTreeView
    ClassTreeGraphView start
!

startEventMonitor
    EventMonitor start
!

startMemoryUsage
    MemoryDebugger start
!

startMemoryMonitor
    Monitor start
!

startTranscript
    ((Smalltalk at:#Transcript) isKindOf:TextCollector) ifTrue:[
        "there is only one transcript !!"
        Transcript realize. "maybe it was iconified"
        Transcript raise
    ] ifFalse:[
        Smalltalk at:#Transcript put:(TextCollector newTranscript)
    ]
!

newProject
    (ProjectView for:(Project new)) realize
!

startXterm
    OperatingSystem executeCommand:'xterm &'
!

startAddressBook
    AddressBook start
!

startNewsTool
    NewsView start
!

startMailTool
    MailView start
!

startClock
    Clock start
!

startRoundClock
    RoundClock start
!

startAnimation
    Animation start
!

startGlobeDemo
    GlobeDemo start
!

startRoundGlobeDemo
    RoundGlobeDemo start
!

startTetris
    Tetris start
!

startTicTacToe
    TicTacToe start
!

startDrawTool
    DrawTool start
!

startLogicTool
    LogicTool start
!

garbageCollect
    |nBytesBefore nReclaimed|

    nBytesBefore := ObjectMemory oldSpaceUsed.
    ObjectMemory garbageCollect.
    nReclaimed := nBytesBefore - ObjectMemory oldSpaceUsed.
    nReclaimed > 0 ifTrue:[
        Transcript show:'reclaimed '.
        nReclaimed > 1024 ifTrue:[
            nReclaimed > (1024 * 1024) ifTrue:[
                Transcript show:(nReclaimed // (1024 * 1024)) printString.
                Transcript showCr:' Mb.'
            ] ifFalse:[
                Transcript show:(nReclaimed // 1024) printString.
                Transcript showCr:' Kb.'
            ]
        ] ifFalse:[
            Transcript show:nReclaimed printString.
            Transcript showCr:' bytes.'
        ]
    ]
!

showOverview
    |v|

    v := EditTextView startOn:(Smalltalk systemFileStreamFor:'doc/overview.doc') pathName.
    v readOnly
!

showGettingStarted
    |v|

    v := DocumentView startOn:
             (Smalltalk systemFileStreamFor:'doc/manuals/gettingStarted.rtf') pathName.
!

startHelpView
    self warn:'The HelpSystem is still under construction.

You will see a pre-pre release.'.
    HelpView start
!

saveImage
    saveBox isNil ifTrue:[
        saveBox := EnterBox new.
        saveBox title:(resources at:'filename for image:') withCRs.
        saveBox abortText:(resources at:'abort').
        saveBox okText:(resources at:'save')
    ].
    "this is a kludge - put into above if when
     stack contexts survive a snapout/snapin"

    saveBox action:[:name | 
        ObjectMemory snapShotOn:name.
        Class addChangeRecordForSnapshot
    ].

    (ImageName isNil or:[ImageName isBlank]) ifTrue:[
        saveBox initialText:'st.img'
    ] ifFalse:[
        saveBox initialText:ImageName
    ].
    saveBox showAtPointer
!

exitSmalltalk
    exitBox isNil ifTrue:[
        exitBox := EnterBox2 new.
        exitBox title:(resources at:'save state before exiting ?\\filename for image:') withCRs.
        exitBox abortText:(resources at:'abort').
        exitBox okText:(resources at:'exit').
        exitBox okText2:(resources at:'save & exit').
    ].

    exitBox action:[:name | Smalltalk exit].
    exitBox action2:[:name | 
        ObjectMemory snapShotOn:name. 
        Class addChangeRecordForSnapshot.
        Smalltalk exit
    ].

    (ImageName isNil or:[ImageName isBlank]) ifTrue:[
        exitBox initialText:'st.img'
    ] ifFalse:[
        exitBox initialText:ImageName
    ].
    exitBox showAtPointer
! !