"
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 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.33 1995-11-11 15:40:19 cg 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 resize.
"/ 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
).
(Screen current 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'
))
selector:#openDemo:
args:#(
GLPlaneDemoView2
GLTetraDemoView
GLWireCubeDemoView
GLCubeDemoView
GLCubeDemoView2
GLBrickCubeDemoView
GLWireSphereDemoView
GLSphereDemoView2
GLPlanetDemoView
GLTeapotDemo
Logo3DView1
)
receiver:self
for:self
).
] ifFalse:[
myMenu subMenuAt:#gamesMenu put:(
PopUpMenu labels:(resources array:#(
'Tetris'
'TicTacToe'
'-'
'PenDemo'
'CommanderDemo'
'-'
'Animation'
'Globe'
'-'
'LogicTool'
))
selector:#openDemo:
args:#(
Tetris
TicTacToe
nil
PenDemo
CommanderDemo
nil
Animation
GlobeDemo
nil
LogicTool
)
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'
))
selectors:#(
showAbout
nil
showOverview
showGettingStarted
showCustomizing
tools
programming
otherTopics
nil
startOnlineHelpView
)
receiver:self
for:self
).
(myMenu subMenuAt:#helpMenu) subMenuAt:#tools put:(
PopUpMenu labels:(resources array:#(
'System Browser'
'File Browser'
'Changes Browser'
'Debugger'
'Inspector'
))
selector:#showOnlineHelp:
args:#('tools/sbrowser/TOP'
'tools/fbrowser/TOP'
'tools/cbrowser/TOP'
'tools/debugger/TOP'
'tools/inspector/misc/TOP')
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'
))
selector:#showOnlineHelp:
args:#('misc/history'
'programming/GC'
'programming/language'
'programming/errormsg'
nil
'misc/stc'
'misc/smalltalk')
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'
))
selector:#showOnlineHelp:
args:#('programming/selectors'
'programming/viewintro'
'programming/debugging'
'programming/processes'
'programming/timing'
'programming/exceptions'
'misc/GL')
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 := Screen current 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 := Screen current viewFromUser.
v isNil ifTrue:[
self warn:'sorry, this is not a smalltalk view'
] ifFalse:[
v topView destroy
]
!
viewInspector
|v|
(Delay forSeconds:1) wait.
v := Screen current 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 - rais it"
Transcript topView raiseDeiconified.
] 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
!
startDrawTool
DrawView open
!
startMailTool
MailView open
!
startClock
Clock open
!
startCalendar
Calendar open
!
startRoundClock
RoundClock2 open
! !
!Launcher methodsFor:'demo menu actions'!
openDemo:className
(Smalltalk at:className) open
!
startLogicTool
self openDemo:#LogicTool
!
startAnimation
self openDemo:#Animation
!
startGlobeDemo
self openDemo:#GlobeDemo
!
startPenDemo
self openDemo:#PenDemo
!
startCommanderDemo
self openDemo:#CommanderDemo
!
startTicTacToe
self openDemo:#TicTacToe
!
startTetris
self openDemo:#Tetris
! !
!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
AboutBox new show
!
showOverview
self showDocumentFile:'misc/overview'
!
showCustomizing
self showOnlineHelp:'custom/TOP'
!
showGettingStarted
self showOnlineHelp:'getstart/TOP'
!
showOnlineHelp:baseName
self warn:'HTML online help support is is not included in this package.
Use any HTML viewer on the files found in doc/online.
Starting view on ascii version of the text ....
'.
self showDocumentFile:'doc/online/english/' , baseName
! !
!Launcher methodsFor:'misc'!
processName
"the name of my process - for the processMonitor only"
^ 'Launcher'.
! !