"
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 logoLabel'
classVariableNames:''
poolDictionaries:''
category:'Interface-Smalltalk'
!
Launcher comment:'
COPYRIGHT (c) 1991 by Claus Gittinger
All Rights Reserved
$Header: /cvs/stx/stx/libtool/OldLauncher.st,v 1.23 1995-03-06 21:25:48 claus Exp $
'!
!Launcher class methodsFor:'documentation'!
copyright
"
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.
"
!
version
"
$Header: /cvs/stx/stx/libtool/OldLauncher.st,v 1.23 1995-03-06 21:25:48 claus Exp $
"
!
documentation
"
Launcher allows startup of smalltalk applications.
If you like this kind of permanent menu for your applications,
create a subclass of this, and redefine #initializeLogo and
#initializeMenu (thats why those two have been implemented as
separate methods).
If you like to add more entries to the menu (or a submenu),
add an entry to the menu (in #initializeMenu) and create a corresponding
action method, to be called from the menu.
Then start a new Launcher with:
Launcher open
start a new one, BEFORE you close the old one - otherwise you may be
left without any windows on the screen ...
If you want to change the launchers menu WITHOUT closing the active one,
use #addSelector... (see MenuView).
"
! !
!Launcher class methodsFor:'defaults '!
defaultLabel
^ 'smallTalk'
! !
!Launcher methodsFor:'initialize / release'!
initialize
super initialize.
self initializeMenu.
self initializeLogo.
myMenu level:0.
"/ myMenu borderWidth:0.
myMenu origin:(0.0 @ logoLabel height).
"/ myMenu font:(self font).
"/ self extent:(myMenu extent).
!
initializeLogo
logoLabel := Label in:self.
logoLabel form:(Image fromFile:'bitmaps/SmalltalkX.xbm').
logoLabel origin:0.0 @ 0.0.
logoLabel borderWidth:0.
logoLabel viewBackground:viewBackground.
logoLabel backgroundColor:viewBackground.
!
initializeMenu
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'
'View inspect'
'View destroy'
'Class tree'
'-'
'Event monitor'
'Process monitor'
'Memory monitor'
'Memory usage'
'-'
'collect Garbage'
'collect Garbage & compress'
'-'
'full screen hardcopy'
'screen area hardcopy'
'view hardcopy'
'-'
'ScreenSaver'
))
selectors:#(
startTranscript
nil
startWindowTreeView
viewInspector
viewKiller
startClassTreeView
nil
startEventMonitor
startProcessMonitor
startMemoryMonitor
startMemoryUsage
nil
garbageCollect
compressingGarbageCollect
nil
fullScreenHardcopy
screenHardcopy
viewHardcopy
nil
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) ifTrue:[
myMenu subMenuAt:#gamesMenu put:(
PopUpMenu labels:(resources array:#(
'Tetris'
'TicTacToe'
'-'
'PenDemo'
'CommanderDemo'
'-'
'Animation'
'Globe'
'-'
'GL 3D demos'
'-'
'LogicTool'
))
selectors:#(
startTetris
startTicTacToe
nil
startPenDemo
startCommanderDemo
nil
startAnimation
startGlobeDemo
nil
glDemos
nil
startLogicTool
)
receiver:self
for:self
).
(myMenu subMenuAt:#gamesMenu) subMenuAt:#glDemos put:(
PopUpMenu labels:(resources array:#(
'plane'
'tetra'
'cube (wireframe)'
'cube (solid)'
'cube (light)'
'cube (light & texture)'
'sphere (wireframe)'
'sphere (light)'
'planet'
'teapot'
'logo'
))
selectors:#(
startGLPlaneDemo
startGLTetraDemo
startGLWireCubeDemo
startGLCubeDemo
startGLCubeDemo2
startGLBrickCubeDemo
startGLWireSphereDemo
startGLSphereDemo
startGLPlanetDemo
startGLTeapotDemo
startGLLogoDemo1
)
receiver:self
for:self
).
] ifFalse:[
myMenu subMenuAt:#gamesMenu put:(
PopUpMenu labels:(resources array:#(
'Tetris'
'TicTacToe'
'-'
'PenDemo'
'CommanderDemo'
'-'
'Animation'
'Globe'
'-'
'LogicTool'
))
selectors:#(
startTetris
startTicTacToe
nil
startPenDemo
startCommanderDemo
nil
startAnimation
startGlobeDemo
nil
startLogicTool
)
receiver:self
for:self
)
].
Project notNil ifTrue:[
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'
'Round Clock'
"
'Address Book'
"
'-'
'Calendar'
'Directory View'
'MailTool'
'NewsTool'
'-'
'DrawTool'
))
selectors:#(
startClock
startRoundClock
"
startAddressBook
"
nil
startCalendar
startDirectoryView
startMailTool
startNewsTool
nil
startDrawTool
)
receiver:self
for:self
).
myMenu subMenuAt:#helpMenu put:(
PopUpMenu labels:(resources array:#(
'About'
'-'
'Overview'
'Getting started'
'Customizing'
'Tools'
'programming'
'other topics'
'-'
"
'Help Browser'
"
'Manual Browser'
))
selectors:#(
showAbout
nil
showOverview
showGettingStarted
showCustomizing
tools
programming
otherTopics
nil
"
startHelpView
"
startManualBrowser
)
receiver:self
for:self
).
(myMenu subMenuAt:#helpMenu) subMenuAt:#tools put:(
PopUpMenu labels:(resources array:#(
'System Browser'
'File Browser'
'Changes Browser'
'Debugger'
'Inspector'
))
selectors:#(
showSystemBrowserDocumentation
showFileBrowserDocumentation
showChangesBrowserDocumentation
showDebuggerDocumentation
showInspectorDocumentation
)
receiver:self
for:self
).
(myMenu subMenuAt:#helpMenu) subMenuAt:#otherTopics put:(
PopUpMenu labels:(resources array:#(
'ST/X history'
'Garbage collection'
'Language & primitives'
'Error messages'
'-'
'stc manual page'
'smalltalk manual page'
))
selectors:#(
showHistoryDocumentation
showGCDocumentation
showLanguageDocumentation
showErrorMessageDocumentation
nil
showSTCManualPage
showSmalltalkManualPage
)
receiver:self
for:self
).
(myMenu subMenuAt:#helpMenu) subMenuAt:#programming put:(
PopUpMenu labels:(resources array:#(
'useful selectors'
'views - quick intro'
'breakpoints & tracing'
'processes'
'timers & delays'
'exceptions & signals'
'GL 3D graphics'
))
selectors:#(
showUsefulSelectors
showQuickViewIntro
showDebuggingInfo
showProcessInfo
showTimerInfo
showExceptionInfo
showGLDocumentation
)
receiver:self
for:self
).
!
realize
|myExtent|
myExtent := (myMenu extent + (0 @ (logoLabel height))).
self extent:myExtent.
self minExtent:myExtent.
self maxExtent:myExtent.
super realize.
"
catch errors - dont want a debugger here ...
(this must be done here, since #initialize runs under another process)
"
Processor activeProcess emergencySignalHandler:[:ex |
|box|
"/ old:
"/ box := YesNoBox title:('Error while launching ...\' , ex errorString , '\\debug ?') withCRs.
"/ "
"/ icon should be whatever WarnBoxes use as icon
"/ "
"/ box formLabel form:(WarningBox new formLabel label).
"/ box yesAction:[Debugger
"/ enter:ex suspendedContext
"/ withMessage:ex errorString].
"/ new:
box := OptionBox
title:('Error while launching ...\' , ex errorString , '\\') withCRs
numberOfOptions:3.
box label:'Warning'.
"
icon should be whatever WarnBoxes use as icon
"
box form:(WarningBox new formLabel label).
box buttonTitles:(resources array:#('abort' 'continue' 'debug')).
box actions:(Array with:[AbortSignal raise]
with:[ex resume]
with:[Debugger
enter:ex suspendedContext
withMessage:ex errorString.
ex resume.]
).
box showAtPointer.
AbortSignal raise.
].
!
reinitialize
"sent after snapin - first reinit menuview,
then adjust my size"
super reinitialize.
"/ myMenu reinitialize.
"/ self extent:(myMenu extent).
!
destroy
"re-confirm when closing Launcher - we do this,
since if you close the last launcher, you might loose the possibility to
communicate with the system ..."
(self confirm:(resources string:'close ' , self class name , ' ?')) ifTrue:[
super destroy
]
!
addToCurrentProject
"ignored here - the launcher is always global."
^ self
! !
!Launcher methodsFor:'accessing'!
menu
^ myMenu
! !
!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.\\check your installation.' withCRs).
^ nil
].
].
f := s pathName.
isRTF ifTrue:[
DocumentView openOn:f.
^ self
].
(Workspace openOn:f) readOnly
!
saveScreenImage:anImage
"save an image into a file
- ask user for filename using a fileSelectionBox."
|fileName|
fileName := Dialog
requestFileName:'save image in:'
default:''
ok:'save'
abort:'abort'
pattern:'*.tiff'.
fileName notNil ifTrue:[
anImage saveOn:fileName
].
!
closeDownViews
"tell each topview that we are going to terminate and give it chance
to save its contents."
ObjectMemory changed:#aboutToExit
! !
!Launcher methodsFor:'event handling'!
saveAndTerminate
"
some windowManagers can send this, to shutDown an application
but let it save its state before, for restart. We are already
prepared for this ;-)"
ObjectMemory snapShotOn:name
! !
!Launcher methodsFor:'menu actions'!
startSystemBrowser
SystemBrowser open
!
startHierarchyBrowser
|enterBox|
enterBox := EnterBox title:(resources at:'name of class:') withCRs.
" enterBox abortText:(resources at:'abort')." "this is the default anyway"
enterBox okText:(resources at:'browse').
enterBox action:[:className |
|class|
class := Smalltalk at:className asSymbol ifAbsent:[nil].
class isBehavior ifFalse:[
self warn:'no such class'
] ifTrue:[
SystemBrowser browseClassHierarchy:class
]
].
enterBox showAtPointer
!
startImplementorsBrowser
|enterBox|
enterBox := EnterBox title:(resources at:'selector:') withCRs.
" enterBox abortText:(resources at:'abort')." "this is the default anyway"
enterBox okText:(resources at:'browse').
enterBox action:[:selectorName |
SystemBrowser browseImplementorsOf:selectorName
].
enterBox showAtPointer
!
startSendersBrowser
|enterBox|
enterBox := EnterBox title:(resources at:'selector:') withCRs.
" enterBox abortText:(resources at:'abort')." "this is the default anyway"
enterBox okText:(resources at:'browse').
enterBox action:[:selectorName |
SystemBrowser browseAllCallsOn:selectorName
].
enterBox showAtPointer
!
startChangesBrowser
ChangesBrowser open
!
startFileBrowser
FileBrowser open
!
startDirectoryBrowser
DirectoryBrowser open
!
startDirectoryView
DirectoryView open
!
startWorkspace
Workspace open
!
saveImage
|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.)
Do NOT exit in this case.
"
self warn:(resources string:'failed to save snapshot image (disk full or not writable)').
]
].
saveBox initialText:(ObjectMemory nameForSnapshot).
saveBox label:'save image'.
saveBox showAtPointer
!
exitSmalltalk
|exitBox|
exitBox := EnterBox2 title:(resources at:'save state before exiting ?\\filename for image:') withCRs.
exitBox okText:(resources at:'exit').
exitBox okText2:(resources at:'save & exit').
exitBox label:'exit Smalltalk'.
exitBox action:[:dummyName |
self closeDownViews.
Smalltalk exit
].
exitBox action2:[:fileName |
(ObjectMemory snapShotOn:fileName) ifFalse:[
"
snapshot failed for some reason (disk full, no permission etc.)
Do NOT exit in this case.
"
self warn:(resources string:'failed to save snapshot image (disk full or not writable)').
] ifTrue:[
"
closeDownViews tells all views to shutdown neatly
(i.e. offer a chance to save the contents to a file).
This is NOT required - all data should be in the snapshot ...
... however, if remote disks/mountable filesystems are involved,
which may not be present the next time, it may make sense to
uncomment it and query for saving - time will show which is better.
"
"
self closeDownViews.
"
Smalltalk exit
]
].
exitBox initialText:(ObjectMemory nameForSnapshot).
exitBox showAtPointer
! !
!Launcher methodsFor:'utility menu actions'!
viewHardcopy
"after a second (to allow redraw of views under menu ...),
let user specify a view and save its contents."
Processor addTimedBlock:[
|v|
v := Display viewFromUser.
v notNil ifTrue:[
self saveScreenImage:(Image fromView:(v topView))
]
] afterSeconds:1
!
fullScreenHardcopy
"after a second (to allow redraw of views under menu ...),
save the contents of the whole screen."
Processor addTimedBlock:[
self saveScreenImage:(Image fromScreen)
] afterSeconds:1
!
screenHardcopy
"after a second (to allow redraw of views under menu ...),
let user specify a rectangular area on the screen
and save its contents."
|area|
Processor addTimedBlock:[
area := Rectangle fromUser.
(area width > 0 and:[area height > 0]) ifTrue:[
self saveScreenImage:(Image fromScreen:area)
]
] afterSeconds:1
!
viewKiller
|v|
(Delay forSeconds:1) wait.
v := Display viewFromUser.
v isNil ifTrue:[
self warn:'sorry, this is not a smalltalk view'
] ifFalse:[
v topView destroy
]
!
viewInspector
|v|
(Delay forSeconds:1) wait.
v := Display viewFromUser.
v isNil ifTrue:[
self warn:'sorry, this is not a smalltalk view'
] ifFalse:[
v topView inspect
]
!
startWindowTreeView
WindowTreeView open
!
startClassTreeView
ClassTreeGraphView open
!
startEventMonitor
EventMonitor open
!
startProcessMonitor
ProcessMonitor open
!
startMemoryMonitor
MemoryMonitor open
!
startMemoryUsage
MemoryUsageView open
!
startTranscript
(Transcript isKindOf:TextCollector) ifTrue:[
"there is only one transcript"
Transcript topView isCollapsed ifTrue:[
"it is iconified"
Transcript topView unrealize.
Transcript topView realize.
].
Transcript topView raise
] ifFalse:[
Transcript := TextCollector newTranscript
]
!
startScreenSaver1
ScreenSaver open
!
startScreenSaver2
LightInTheDark open
!
startScreenSaver3
LightInTheDark2 open
!
garbageCollect
ObjectMemory markAndSweep
!
compressingGarbageCollect
ObjectMemory verboseGarbageCollect
! !
!Launcher methodsFor:'project menu actions'!
projectMenu
"this is sent, if ST/X has been built without Projects/ChangeSets."
self warn:'The system has been built without support for projects'.
!
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
! !
!Launcher methodsFor:'goody menu actions'!
startXterm
OperatingSystem executeCommand:'xterm &'
!
startAddressBook
AddressBook open
!
startNewsTool
NewsView open
!
startMailTool
MailView open
!
startClock
Clock open
!
startCalendar
Calendar open
!
startRoundClock
RoundClock2 open
! !
!Launcher methodsFor:'demo menu actions'!
startAnimation
Animation open
!
startGlobeDemo
GlobeDemo open
!
startPenDemo
PenDemo open
!
startCommanderDemo
CommanderDemo open
!
startRoundGlobeDemo
RoundGlobeDemo open
!
startGLSphereDemo
GLSphereDemoView2 open
!
startGLTeapotDemo
GLTeapotDemo open
!
startGLPlaneDemo
GLPlaneDemoView2 open
!
startGLWireCubeDemo
GLWireCubeDemoView open
!
startGLWireSphereDemo
GLWireSphereDemoView open
!
startGLPlanetDemo
GLPlanetDemoView open
!
startGLCubeDemo
GLCubeDemoView open
!
startGLCubeDemo2
GLCubeDemoView2 open
!
startGLBrickCubeDemo
GLBrickCubeDemoView open
!
startGLTetraDemo
GLTetraDemoView open
!
startGLLogoDemo1
Logo3DView1 open
!
startTetris
Tetris open
!
startTicTacToe
TicTacToe open
!
startDrawTool
DrawTool open
!
startLogicTool
LogicTool open
! !
!Launcher methodsFor:'doc menu actions'!
warnIfAbsent:aPath
|s|
s := Smalltalk systemFileStreamFor:aPath.
s isNil ifTrue:[
self warn:('document ' , aPath , ' not available').
^ nil
].
^ s pathName
!
showAbout
|box dark green lbl|
device hasColors ifTrue:[
green := (Color red:0 green:80 blue:20) darkened.
] ifFalse:[
green := White.
].
device hasGreyscales ifTrue:[
dark := Color grey:10.
] ifFalse:[
dark := Black.
].
box := InfoBox new.
box viewBackground:dark; allSubViewsDo:[:s | s viewBackground:dark].
box form:(Form fromFile:'SmalltalkX.xbm' resolution:100).
(lbl := box formLabel) viewBackground:dark.
lbl foregroundColor:green backgroundColor:dark.
(lbl := box textLabel) viewBackground:dark.
lbl foregroundColor:White backgroundColor:dark.
box title:
'Smalltalk/X
Version ......... ' , Smalltalk versionString , ' (' , Smalltalk versionDate printString , ')
Configuration ... ' , Smalltalk configuration , '
Running on ...... ' , OperatingSystem getHostName , '
' , Smalltalk copyrightString.
box okText:'close'.
box autoHideAfter:10 with:[].
box showAt:device center - (box extent // 2).
!
showOverview
self showDocumentFile:'doc/overview'
!
showCustomizing
self showDocumentFile:'doc/manuals/customizing'
!
showGettingStarted
self showDocumentFile:'doc/manuals/gettingStarted'
!
showSystemBrowserDocumentation
self showDocumentFile:'doc/misc/sbrowser'
!
showFileBrowserDocumentation
self showDocumentFile:'doc/misc/fbrowser'
!
showChangesBrowserDocumentation
self showDocumentFile:'doc/misc/cbrowser'
!
showDebuggerDocumentation
self showDocumentFile:'doc/misc/debugger'
!
showInspectorDocumentation
self showDocumentFile:'doc/misc/inspector'
!
showHistoryDocumentation
self showDocumentFile:'doc/misc/history'
!
showGCDocumentation
self showDocumentFile:'doc/misc/GC'
!
showGLDocumentation
self showDocumentFile:'doc/misc/GL'
!
showLanguageDocumentation
self showDocumentFile:'doc/misc/language'
!
showErrorMessageDocumentation
self showDocumentFile:'doc/misc/errormsg'
!
showSTCManualPage
self showDocumentFile:'doc/misc/stc'
!
showSmalltalkManualPage
self showDocumentFile:'doc/misc/smalltalk'
!
showUsefulSelectors
self showDocumentFile:'doc/misc/beginner'
!
showQuickViewIntro
self showDocumentFile:'doc/misc/quick_view_intro'
!
showDebuggingInfo
self showDocumentFile:'doc/misc/debugging'
!
showProcessInfo
self showDocumentFile:'doc/misc/processes'
!
showExceptionInfo
self showDocumentFile:'doc/misc/exceptions'
!
showTimerInfo
self showDocumentFile:'doc/misc/timing'
!
startHelpView
self warn:'The HelpSystem is still under construction.
You will see a pre-pre release.'.
HelpView start
!
startManualBrowser
ManualBrowser isLoaded ifFalse:[
ManualBrowser autoload.
"
did it load ?
"
ManualBrowser isLoaded ifFalse:[
self warn:'The ManualBrowser is a Tomcat add-on; not included in this package.'.
^self
]
].
self warn:'The HelpSystem is still under construction.
You will see a pre release.'.
ManualBrowser new
! !