OldLauncher.st
author claus
Thu, 10 Aug 1995 20:38:26 +0200
changeset 111 b4ef3e799345
parent 110 570a38362ae1
child 165 df29ee4514c1
permissions -rw-r--r--
,

"
 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.32 1995-08-10 18:37:56 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.32 1995-08-10 18:37:56 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 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'.
! !