"
COPYRIGHT (c) 1991 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 enterBox'
classVariableNames:''
poolDictionaries:''
category:'Interface-Smalltalk'
!
Launcher comment:'
COPYRIGHT (c) 1991 by Claus Gittinger
All Rights Reserved
allows startup of smalltalk applications
$Header: /cvs/stx/stx/libtool/OldLauncher.st,v 1.5 1993-12-16 11:03:10 claus Exp $
written spring 91 by claus
'!
!Launcher class methodsFor:'instance creation'!
new
^ super
extent:(100 @ 100)
label:'smallTalk'
icon:(Form fromFile:'SmalltalkX.xbm' resolution:100)
"Launcher start"
! !
!Launcher methodsFor:'initialize / release'!
initialize
super initialize.
myMenu := ClickMenuView
labels:(resources array:#(
'Browsers ...'
'Workspace'
'File Browser'
'Projects ...'
'-'
'Utilities ...'
'Goodies ...'
'Games & Demos ...'
'-'
'info & help ...'
'-'
'snapshot'
'-'
'exit'
))
selectors:#(browserMenu
startWorkspace
startFileBrowser
projectMenu
nil
utilityMenu
goodyMenu
gamesMenu
nil
helpMenu
nil
saveImage
nil
exitSmalltalk
)
receiver:self
in:self.
myMenu subMenuAt:#browserMenu put:(
PopUpMenu labels:(resources array:#(
'System Browser'
'Class Hierarchy Browser'
'Implementors'
'Senders'
'-'
'Changes Browser'
'-'
'Directory Browser'
))
selectors:#(
startSystemBrowser
startHierarchyBrowser
startImplementorsBrowser
startSendersBrowser
nil
startChangesBrowser
nil
startDirectoryBrowser
)
receiver:self
for:self
).
myMenu subMenuAt:#utilityMenu put:(
PopUpMenu labels:(resources array:#(
'Transcript'
'-'
'Window tree'
'Class tree'
'-'
'Event monitor'
'Process monitor'
'Memory monitor'
'Memory usage'
'-'
'collect Garbage'
'collect Garbage & compress'
'ScreenSaver ...'
))
selectors:#(
startTranscript
nil
startWindowTreeView
startClassTreeView
nil
startEventMonitor
startProcessMonitor
startMemoryMonitor
startMemoryUsage
nil
garbageCollect
compressingGarbageCollect
screenSaverMenu
)
receiver:self
for:self
).
(myMenu subMenuAt:#utilityMenu) subMenuAt:#screenSaverMenu put:(
PopUpMenu labels:(resources array:#(
'simple'
'spotlight'
'moving spotlight'
))
selectors:#(
startScreenSaver1
startScreenSaver2
startScreenSaver3
)
receiver:self
for:self
).
((Display isKindOf:GLXWorkstation)
and:[OperatingSystem getSystemType = 'iris']) ifTrue:[
myMenu subMenuAt:#gamesMenu put:(
PopUpMenu labels:(resources array:#(
'Tetris'
'TicTacToe'
'-'
'Animation'
'Globe'
'-'
'GL-rotating plane'
'GL-light around sphere'
'GL-teapot'
'-'
'LogicTool'
))
selectors:#(
startTetris
startTicTacToe
nil
startAnimation
startGlobeDemo
nil
startGLPlaneDemo
startGLSphereDemo
startGLTeapotDemo
nil
startLogicTool
)
receiver:self
for:self
).
] ifFalse:[
myMenu subMenuAt:#gamesMenu put:(
PopUpMenu labels:(resources array:#(
'Tetris'
'TicTacToe'
'-'
'Animation'
'Globe'
'-'
'LogicTool'
))
selectors:#(
startTetris
startTicTacToe
nil
startAnimation
startGlobeDemo
nil
startLogicTool
)
receiver:self
for:self
)
].
myMenu subMenuAt:#projectMenu put:(
PopUpMenu labels:(resources array:#(
'new project'
'-'
'select project'
))
selectors:#(
newProject
nil
selectProject
)
receiver:self
for:self
).
myMenu subMenuAt:#goodyMenu put:(
PopUpMenu labels:(resources array:#(
'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:(resources array:#(
'Overview'
'Getting started'
'Customizing'
'Tools ...'
'-'
'Help Browser'
))
selectors:#(
showOverview
showGettingStarted
showCustomizing
tools
nil
startHelpView
)
receiver:self
for:self
).
(myMenu subMenuAt:#helpMenu) subMenuAt:#tools put:(
PopUpMenu labels:(resources array:#(
'System Browser'
))
selectors:#(
showSystemBrowserDocumentation
)
receiver:self
for:self
).
myMenu borderWidth:0.
myMenu origin:(0 @ 0).
myMenu font:(self font).
self extent:(myMenu extent).
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').
saveBox := EnterBox new.
saveBox title:(resources at:'filename for image:') withCRs.
saveBox abortText:(resources at:'abort').
saveBox okText:(resources at:'save').
enterBox := EnterBox new.
enterBox abortText:(resources at:'abort').
enterBox okText:(resources at:'browse').
!
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).
!
destroy
exitBox notNil ifTrue:[
exitBox destroy.
exitBox := nil
].
saveBox notNil ifTrue:[
saveBox destroy.
saveBox := nil
].
enterBox notNil ifTrue:[
enterBox destroy.
enterBox := nil
].
super destroy
!
addToCurrentProject
"ignored here"
^ self
! !
!Launcher methodsFor:'private'!
showDocumentFile:name
|s f isRTF|
isRTF := true.
s := Smalltalk systemFileStreamFor:name , '.rtf'.
s isNil ifTrue:[
isRTF := false.
s := Smalltalk systemFileStreamFor:name , '.doc'.
s isNil ifTrue:[
self warn:('document ' , name , ' (.rtf/.doc) not available.').
^ nil
].
].
f := s pathName.
isRTF ifTrue:[
DocumentView startOn:f.
^ self
].
(EditTextView startOn:f) readOnly
! !
!Launcher methodsFor:'events'!
saveAndTerminate
ObjectMemory snapShotOn:name
! !
!Launcher methodsFor:'user interaction'!
startSystemBrowser
SystemBrowser start
!
startHierarchyBrowser
enterBox title:(resources at:'name of class:') withCRs.
enterBox okText:(resources at:'browse').
enterBox action:[:name |
|class|
class := Smalltalk at:name asSymbol ifAbsent:[nil].
class isBehavior ifFalse:[
self warn:(resources at:'no such class')
] ifTrue:[
SystemBrowser browseClassHierarchy:class
]
].
enterBox showAtPointer
!
startImplementorsBrowser
enterBox title:(resources at:'selector:') withCRs.
enterBox okText:(resources at:'browse').
enterBox action:[:selectorName |
SystemBrowser browseImplementorsOf:selectorName
].
enterBox showAtPointer
!
startSendersBrowser
enterBox title:(resources at:'selector:') withCRs.
enterBox okText:(resources at:'browse').
enterBox action:[:selectorName |
SystemBrowser browseAllCallsOn:selectorName
].
enterBox showAtPointer
!
startChangesBrowser
ChangesBrowser start
!
startFileBrowser
FileBrowser start
!
startDirectoryBrowser
DirectoryBrowser start
!
startDirectoryView
DirectoryView start
!
startWorkspace
Workspace start
!
startWindowTreeView
WindowTreeView start
!
startClassTreeView
ClassTreeGraphView start
!
startEventMonitor
EventMonitor start
!
startProcessMonitor
ProcessMonitor start
!
startMemoryMonitor
MemoryMonitor start
!
startMemoryUsage
MemoryUsageView 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)
]
!
startScreenSaver1
ScreenSaver start
!
startScreenSaver2
LightInTheDark start
!
startScreenSaver3
LightInTheDark2 start
!
newProject
(ProjectView for:(Project new)) open
!
selectProject
|list box|
list := Project allInstances.
box := ListSelectionBox new.
box list:(list collect:[:p | p name]).
box title:(resources string:'select a project').
box action:[:selection |
|project|
project := list detect:[:p | p name = selection] ifNone:[nil].
project isNil ifTrue:[
Transcript showCr:'no such project'
] ifFalse:[
project showViews.
Project current:project
]
].
box showAtPointer
!
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
!
startGLSphereDemo
Class updateChanges:false.
Smalltalk fileIn:'clients/IRIS-specials/GLSphereDemo1.st'.
Smalltalk fileIn:'clients/IRIS-specials/GLSphereDemo2.st'.
Class updateChanges:true.
GLSphereDemoView2 start
!
startGLTeapotDemo
Class updateChanges:false.
Smalltalk fileIn:'clients/IRIS-specials/GLTeapotView.st'.
Smalltalk fileIn:'clients/IRIS-specials/GLTeapotDemo.st'.
Class updateChanges:true.
GLTeapotDemo start
!
startGLPlaneDemo
Class updateChanges:false.
Smalltalk fileIn:'source/GLPlaneDemo1.st'.
Smalltalk fileIn:'source/GLPlaneDemo2.st'.
Class updateChanges:true.
GLPlaneDemoView2 start
!
startTetris
Tetris start
!
startTicTacToe
TicTacToe start
!
startDrawTool
DrawTool start
!
startLogicTool
LogicTool start
!
garbageCollect
ObjectMemory markAndSweep
!
compressingGarbageCollect
|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.'
]
]
!
warnIfAbsent:aPath
|s|
s := Smalltalk systemFileStreamFor:aPath.
s isNil ifTrue:[
self warn:('document ' , aPath , ' not available').
^ nil
].
^ s pathName
!
showOverview
self showDocumentFile:'doc/overview'
!
showCustomizing
self showDocumentFile:'doc/manuals/customizing'
!
showGettingStarted
self showDocumentFile:'doc/manuals/gettingStarted'
!
showSystemBrowserDocumentation
self showDocumentFile:'doc/misc/browser'
!
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')." "this is the default anyway ..."
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.
].
(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')." "this is the default anyway ..."
exitBox okText:(resources at:'exit').
exitBox okText2:(resources at:'save & exit').
].
exitBox action:[:name | Smalltalk exit].
exitBox action2:[:name |
ObjectMemory snapShotOn:name.
Smalltalk exit
].
exitBox initialText:(ObjectMemory nameForSnapshot).
exitBox showAtPointer
! !