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

'From Smalltalk/X, Version:2.10.5 on 29-apr-1995 at 12:42:53 pm'!

ApplicationModel subclass:#NewLauncher
	 instanceVariableNames:'myMenu buttonPanel transcript infoView infoProcess helpIsOn'
	 classVariableNames:'CachedAboutIcon'
	 poolDictionaries:''
	 category:'Interface-Smalltalk'
!

!NewLauncher class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) 1995 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/Launcher.st,v 1.21 1995-08-10 13:14:38 claus Exp $
$Revision: 1.21 $
"
!

documentation
"
    a new launcher, combining old Launchers menu and transcript into
    one view. (you no longer have to move two views around all the time ...).

    Also, this app makes first use of the new compatibility framework;
    you will notice, that this is a subclass of ApplicationModel.
    New applications will no longer be built as subclasses of standardSystemView.
"
!

customization
"
    Of course, it is possible to change the NewLauncher class itself
    as appropriate, however, we suggest you create a subclass (say MyLauncher),
    define it as autoloaded in the patches file, and redefined some methods
    there. That way, your changes are easier to reintroduce in case of
    an ST/X upgrade.


    adding more buttons to the button-panel:

      see the method #buttonPanelSpec;
	it defines a list of selectors and icons, which is used by 
	#setupButtonPanelIn:. 
	There, for each entry, a button with that icon is created, 
	which sends a selector-message to the launcher.

	Add entries to that list, and define appropriate methods.
	For example, to add a button which opens a drawTool,
	change #buttonPanelSpec to:

	buttonPanelSpec
	    ^ #(
		#(startSystemBrowser  'SBrowser32x32.xbm')
		#(startFileBrowser    'FBrowser32x32.xbm')
		#(nil nil)
		#(startChangesBrowser 'CBrowser32x32.xbm')
		#(nil nil)
		#(nil nil)
		#(startDrawTool       'DrawTool.xbm')
	     )

	the panel adjusts its height as appropriate - you may want to
	create new (small) icons for a good look.

    adding an entry to a menu:

	see the #setupMenu method; either add another top-menu, or
	add entries to an existing menu.
"
! !

!NewLauncher class methodsFor:'defaults'!

smallAboutIcon
    |image|

    image := self aboutIcon.
    image notNil ifTrue:[
	image := image magnifiedBy:0.4.
    ].
    ^ image

    "
     CachedAboutIcon := nil.
     NewLauncher aboutIcon.
     NewLauncher smallAboutIcon.
    "
!

aboutIcon
    |image|

    CachedAboutIcon notNil ifTrue:[^ CachedAboutIcon].

    image := Image fromFile:'SmalltalkX.xbm'.
    image notNil ifTrue:[
	|green dark|

	Display hasColors ifTrue:[
	    green := (Color red:0 green:80 blue:20) "darkened".
	    dark := Color grey:10.
	    image photometric:#palette.
	] ifFalse:[
	    dark := Color black.
	    green := Color white.
	    image photometric:#blackIs0.
	].
	image colorMap:(Array with:dark with:green).
	Display depth > 2 ifTrue:[
	    image := (Image implementorForDepth:Display depth) fromImage:image.
	]
    ].
    CachedAboutIcon := image.
    ^ image

    "
     CachedAboutIcon := nil.
     NewLauncher aboutIcon
    "
! !

!NewLauncher methodsFor:'queries'!

processName
    "for monitors only - my name"

    ^ 'ST/X Launcher'
! !

!NewLauncher methodsFor:'initialize / release'!

restarted
    "image restart - since WindowGroup recreates the process with
     default prio, we have to raise the prio again.
     Mhmh - this looks like a bug to me ..."

    Processor activeProcess priority:(Processor userSchedulingPriority + 1).
    super restarted
!

openInterface
    "sent by my superclass to open up my interface"

    |top icn w|

    top := StandardSystemView new.
    top label:'Smalltalk/X'.
    top extent:(400@300 ).

    "
     temporary kludge for SGI;
     this will be moved into StandardSystemView and be done
     automatically soon ...
    "
    Screen current serverVendor = 'Silicon Graphics' ifTrue:[
	icn := self class aboutIcon.
	icn notNil ifTrue:[
	    icn := icn magnifiedTo:86@68.
	    w := View extent:86@68. "/ icn extent.
	    w viewBackground:icn.
	    top iconView:w
	]
    ].

    self setupViewsIn:top.

    top application:self.   
    builder window:top.

    "
     open with higher prio to allow interaction even while things
     are running ...
    "
    top openWithPriority:(Processor userSchedulingPriority + 1).
!

addTopViewsToCurrentProject
    "ignored here - the launcher is always global (i.e. not project private)."

    ^ self
!

setupMenu
    "setup the pulldown menu"

    |l s icon|

    myMenu labels:(resources array:#(
				     'about'
				     'file'
				     'classes'
				     'tools'
				     'projects'
				     'settings'
				     'demos'
				     'help')).
    "
     if there is a bitmap, change 'about' to the ST/X icon
    "
    icon := self class smallAboutIcon.
    icon notNil ifTrue:[
	myMenu labels at:1 put:icon.
	myMenu height:(myMenu height max:(icon height + (View viewSpacing * 2)))
    ].

    myMenu selectors:#(
				     #about
				     #file
				     #classes 
				     #tools 
				     #projects 
				     #settings
				     #demos
				     #help).

    myMenu at:#about 
	   putLabels:(resources array:#(
					'about Smalltalk/X ...'
				       ))
	   selectors:#(
					#about 
		      )
	   receiver:self.

    myMenu at:#file
	   putLabels:(resources array:#(
					'file browser'
					'-'
					'snapshot'
					'snapshot & exit'
					'exit smalltalk'
				       ))
	   selectors:#(
					#startFileBrowser
					nil
					#snapshot
					#snapshotAndExit
					#exit
		      )
	   receiver:self.

    myMenu at:#classes 
	   putLabels:(resources array:#(
					'system browser'
					'class browser'
					'full class browser'
					'class hierarchy browser'
					'class tree'
					'-'
					'implementors'
					'senders'
					'-'
					'change browser'
					))
	   selectors:#(
					#startSystemBrowser 
					#startClassBrowser 
					#startFullClassBrowser 
					#startClassHierarchyBrowser 
					#startClassTreeView 
					nil
					#browseImplementors 
					#browseSenders 
					nil
					#startChangesBrowser 
		      )
	   receiver:self.

    myMenu at:#projects 
	   putLabels:(resources array:#(
					'new project'
					'-'
					'select project ...'
					))
	   selectors:#(
					#newProject 
					nil
					#selectProject 
		      )
	   receiver:self.

    myMenu at:#settings 
	   putLabels:(resources array:#(
					'language'
					'show keyboard mappings'
					'view style'
					'messages'
					'compilation'
					'misc'
					))
	   selectors:#(
					#languageSetting 
					#keyboardSetting 
					#viewStyleSetting 
					#messageSettings 
					#compilerSettings 
					#miscSettings 
		      )
	   receiver:self.

    self setupToolsMenu.
    self setupDemoMenu.

    ActiveHelp notNil ifTrue:[
	l := #(
		'\c active help'
		'ST/X documentation'
	      ).
	s := #(
		#toggleActiveHelp:
		#startDocumentationTool
	      )
    ] ifFalse:[
	l := #(
		'ST/X documentation'
	      ).
	s := #(
		#startDocumentationTool
	      )
    ].

    myMenu at:#help 
	   putLabels:(resources array:l)
	   selectors:s
	   receiver:self.
!

setupTranscriptIn:aView 
    |v|

    (Transcript notNil and:[Transcript ~~ Stderr]) ifTrue:[
	Transcript topView destroy.
    ].

    v := HVScrollableView 
		for:TextCollector
		miniScrollerH:true 
		miniScrollerV:false 
		in:aView.

    v origin:(0.0 @ (buttonPanel corner y + View viewSpacing)) 
      corner:(1.0 @ 1.0).
    transcript := v scrolledView.
    transcript beTranscript.
!

setupInfoViewIn:topView 
    |spc halfSpc|

    spc := View viewSpacing.
    infoView := Label label:'' in:topView.
    infoView adjust:#left; borderWidth:0.
    infoView level:-1.
    transcript superView bottomInset:(infoView height + spc).

    infoView is3D ifTrue:[
	halfSpc := spc // 2.
    ] ifFalse:[
	halfSpc := 0
    ].
    infoView topInset:(infoView height negated - spc + transcript borderWidth);
	     bottomInset:halfSpc;
	     leftInset:halfSpc; 
	     rightInset:halfSpc.
    infoView origin:0.0 @ 1.0 corner:1.0 @ 1.0.
    infoView model:self; aspect:#info; labelMessage:#info.

    Project notNil ifTrue:[
	Project addDependent:self.
    ]

    "
     NewLauncher open
    "
!

focusSequence
    ^ (Array with:myMenu) 
      , 
      (buttonPanel subViews select:[:element | element isKindOf:Button])
"/      , (Array with:Transcript)
!

setupViewsIn:topView 
    "create the pulldown menu, buttonPanel and transcript view"

    |tFont|

    topView model:self.

    myMenu := PullDownMenu in:topView.
    myMenu origin:0.0 @ 0.0 corner:(1.0 @ myMenu height).

    self setupMenu.
    self setupButtonPanelIn:topView.
    self setupTranscriptIn:topView.
    self setupInfoViewIn:topView.
    self setupOtherViewsIn:topView.

    tFont := transcript font.
    topView extent:((tFont widthOf:'3')*60) 
		    @ 
		    ((tFont height) * 20).

    "
     NewLauncher open
    "
!

setupOtherViewsIn:aTopView
    "a hook - allows redefinition in your personal subclass.
     For example, add a clock:"

"
    |sz clock space halfSpace|

    sz := buttonPanel innerHeight - (buttonPanel level abs*2).
    space := View viewSpacing.
    halfSpace := space // 2.

    buttonPanel rightInset:sz+(space  * 2).

    clock := ClockView in:buttonPanel topView.
    clock borderWidth:1.
    clock showSeconds:false.
    clock extent:(sz @ sz).
    clock origin:(1.0 @ (buttonPanel origin y + halfSpace)).
    clock leftInset:sz negated - 2 - halfSpace.
    clock rightInset:halfSpace.
    clock level:1.
"
!

setupButtonPanelIn:aTopView
    "create the buttonPanel"

    |spc mh|

    spc := View viewSpacing // 2.
    buttonPanel := HorizontalPanelView in:aTopView.
    buttonPanel level:-1; borderWidth:0.
    buttonPanel horizontalLayout:#leftSpace.

    self buttonPanelSpec do:[:entry |
	|sel b sep|

	sel := entry at:1.
	sel isNil ifTrue:[
	    sep := View in:buttonPanel.
	    sep extent:32@1; borderWidth:0.
	] ifFalse:[
	    b := Button in:buttonPanel.
	    b form:(Image fromFile:(entry at:2)).
	    b model:self; changeMessage:sel
	]
    ].

    mh := myMenu height.
    buttonPanel origin:0.0 @ (mh + spc)
		corner:(1.0 @ (mh + spc + buttonPanel preferredExtent y)).

    buttonPanel leftInset:spc; rightInset:spc.
!

setupDemoMenu
    "setup the demo pulldown menu"

    |m|

    myMenu at:#demos 
	   putLabels:(resources array:#(
					'goodies'
					'games'
					'geometric designs'
					'simple animations'
					'3D graphics'
					'graphic editors'
				       ))
	   selectors:#(
					goodies
					games
					geometricDesigns
					simpleAnimations
					#'3Dgraphics'
					#graphicEditors
		      )
	   receiver:self.

    "
     only to show two different ways of defining a popUpMenu,
     we use labels:selectors:receiver: here:
    "
    m := myMenu menuAt:#demos.
    m subMenuAt:#games
      put:(PopUpMenu
		labels:(resources array:#(
					   'Tetris'
					   'Tic Tac Toe'
					 ))
		selectors:#(
					   startTetris
					   startTicTacToe
			   )
		receiver:self).

    "
     and labels:selector:args:receiver: here:
    "
    m subMenuAt:#geometricDesigns
      put:(PopUpMenu
		labels:(resources array:#(
					   'Pen demo'
					   'Commander demo'
					 ))
		selector:#openDemo:
		args:#(
					   PenDemo
					   CommanderDemo
		      )
		receiver:self).

    m subMenuAt:#simpleAnimations 
      put:(PopUpMenu
		labels:(resources array:#(
					   'Animation'
					   'Globe demo'
					 ))
		selector:#openDemo:
		args:#(
					   Animation
					   GlobeDemo
		      )
		receiver:self).

    m subMenuAt:#'3Dgraphics' 
      put:(PopUpMenu
		labels:(resources 
			    array:#(
				'plane'
				'tetra'
				'cube (wireframe)'
				'cube (solid)'
				'cube (light)'
				'cube (light & texture)'
				'sphere (wireframe)'
				'sphere (light)'
				'planet'
				'teapot'
				'logo'
				'x/y graph'
			     ))
		selector:#openDemo:
		args:#(
				GLPlaneDemoView2
				GLTetraDemoView
				GLWireCubeDemoView
				GLCubeDemoView
				GLCubeDemoView2
				GLBrickCubeDemoView
				GLWireSphereDemoView
				GLSphereDemoView2
				GLPlanetDemoView
				GLTeapotDemo
				Logo3DView1
				GLXYGraph
		      )
		receiver:self).

    m subMenuAt:#graphicEditors 
      put:(PopUpMenu
		labels:(resources array:#(
					   'DrawTool'
					   'LogicTool'
					 ))
		selector:#openDemo:
		args:#(
					   DrawTool
					   LogicTool
		      )
		receiver:self).

    m subMenuAt:#goodies 
      put:(PopUpMenu
		labels:(resources array:#(
					'clock'
					'calendar'
					'-'
					'mail tool'
					'news tool'
					))
		selector:#openDemo:
		args:#(
					Clock 
					Calendar 
					nil
					MailView 
					NewsView
		      )
		receiver:self).
!

buttonPanelSpec
    "return a spec for the buttons in the panel;
     entries consists of selector and bitmap-filename.
     nil selectors are taken as separators (see setupButtonPanel)"

    ^ #(
	#(startSystemBrowser 'SBrowser32x32.xbm')
	#(startFileBrowser   'FBrowser32x32.xbm')
	#(nil nil)
	#(startChangesBrowser 'CBrowser32x32.xbm')
"/        #(nil nil)
"/        #(nil nil)
"/        #(startDocumentationTool 'book11.ico')
     )
!

release
    infoProcess notNil ifTrue:[
	infoProcess terminate.
	infoProcess := nil.
    ].
    super release
!

closeRequest
    (self confirm:(resources string:'really close %1 ?' with:self class name)) ifTrue:[
	super closeRequest
    ]
!

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 ;-)"

    self snapshot.
    super saveAndTerminate
!

setupToolsMenu
    "setup the tools pulldown menu"

    |m|

    myMenu at:#tools 
	   putLabels:(resources array:#(
					'workspace'
					'-'
					'monitors'
					'-'
					'view tree (all views)'
					'view tree'
					'inspect view'
					'destroy view'
					'-'
					'hardcopy'
					))
	   selectors:#(
					#startWorkspace 
					nil
					#monitors
					nil
					#startFullWindowTreeView 
					#startWindowTreeView 
					#viewInspect 
					#viewDestroy 
					nil
					#hardcopy 
		      )
	   receiver:self.


    m := myMenu menuAt:#tools.
    m subMenuAt:#monitors 
      put:(PopUpMenu
		labels:(resources array:#(
					   'process'
					   'memory'
					   'event'
					   '-'
					   'memory usage'
					 ))
		selectors:#(
					#startProcessMonitor
					#startMemoryMonitor 
					#startEventMonitor 
					nil
					#startMemoryUsageView 
			   )
		receiver:self).

    m subMenuAt:#hardcopy 
      put:(PopUpMenu
		labels:(resources array:#(
					   'screen'
					   'area'
					   'view'
					 ))
		selectors:#(
					#fullScreenHardcopy
					#screenHardcopy
					#viewHardcopy
			   )
		receiver:self).

! !

!NewLauncher methodsFor:'actions - classes'!

startFileBrowser
    self withWaitCursorDo:[FileBrowser open]
!

startChangesBrowser
    self withWaitCursorDo:[ChangesBrowser open]
!

startSystemBrowser
    self withWaitCursorDo:[SystemBrowser open]
!

startWorkspace
    Workspace open
!

startClassBrowser
    SystemBrowser askThenBrowseClass
!

startFullClassBrowser
    SystemBrowser askThenBrowseFullClassProtocol
!

startClassHierarchyBrowser
    SystemBrowser askThenBrowseClassHierarchy
!

browseImplementors
    |enterBox|

    enterBox := EnterBox title:(resources at:'Browse implementors of:') withCRs.
    enterBox okText:(resources at:'browse').
    enterBox action:[:selectorName |
	|cls|

	self withWaitCursorDo:[SystemBrowser browseImplementorsOf:selectorName]  
    ].
    enterBox showAtPointer
!

browseSenders
    |enterBox|

    enterBox := EnterBox title:(resources at:'Browse senders of:') withCRs.
    enterBox okText:(resources at:'browse').
    enterBox action:[:selectorName |
	|cls|

	self withWaitCursorDo:[SystemBrowser browseAllCallsOn:selectorName]  
    ].
    enterBox showAtPointer
!

startClassTreeView
    self withWaitCursorDo:[ClassTreeGraphView open]
! !

!NewLauncher methodsFor:'actions - settings'!

viewStyleSetting 
    |listOfStyles resourceDir dir box 
     list listView infoLabel infoForwarder newStyle|

    "
     search resources directory for a list of .style files ...
    "

    resourceDir := Smalltalk getSystemFileName:'resources'.
    resourceDir isNil ifTrue:[
	self warn:'no styles found (missing ''resources'' directory)'.
	^ self
    ].
    dir := FileDirectory directoryNamed:resourceDir.

    listOfStyles := dir select:[:aFileName | aFileName endsWith:'.style'].
    listOfStyles := listOfStyles collect:[:aFileName | aFileName copyWithoutLast:6].
    listOfStyles sort.

"/ old code: used a standard ListSelectionBox
"/ changed to intercept selection and add info-output.

"/    box := ListSelectionBox title:(resources string:'STYLE_MSG') withCRs.
"/    box label:(resources string:'Style selection').
"/    box list:listOfStyles.
"/    box initialText:View defaultStyle.
"/    box selectAction:[:newStyle |
"/    ].    
"/    box action:[:newStyle |
"/        transcript topView withCursor:Cursor wait do:[
"/            Transcript showCr:'change style to ' , newStyle , ' ...'.
"/            View defaultStyle:newStyle asSymbol.
"/        ]
"/    ].    
"/    box showAtPointer

"/ new code: build box 'by 'hand'
"/
    infoForwarder := Plug new.
    infoForwarder respondTo:#showInfo
		  with:[
			|nm sheet comment|
			nm := list selection.
			sheet := ViewStyle fromFile:(nm , '.style').
			comment := sheet at:#comment ifAbsent:''.
			infoLabel label:comment withCRs asStringCollection
		       ].

    list := SelectionInList with:listOfStyles.
    list onChangeSend:#showInfo to:infoForwarder.

    box := Dialog new.
    box label:(resources string:'Style selection').

    box addTextLabel:(resources string:'STYLE_MSG') withCRs.
    listView := SelectionInListView on:list.
    listView doubleClickAction:[:sel | box accept value:true. box hide].
    listView height:200.
    box addComponent:(ScrollableView forView:listView) tabable:true.
    box addVerticalSpace.

    (infoLabel := box addTextLabel:'\\' withCRs) adjust:#centerLeft.

    box addAbortButton; addOkButton.
    list selection:(View defaultStyle).
    box extent:(box preferredExtent).
    box minExtent:box extent.
    box maxExtent:box extent.

    box showAtPointer.

    box accepted ifTrue:[
	newStyle := list selection.
	newStyle notNil ifTrue:[
	    self withWaitCursorDo:[
		Transcript showCr:'change style to ' , newStyle , ' ...'.
		View defaultStyle:newStyle asSymbol.
	    ].
	    self reopenLauncher.
	]
    ]
!

languageSetting 
    |listOfLanguages box|

    "
     hardwiring here is stupid - need a resource file
     which lists languagenames which have all texts available
     in resource files ...
    "
    listOfLanguages := #('english'
			 'german'
			 'french'
			 'spanish'
			 'italian'
			).

    box := ListSelectionBox title:(resources string:'LANG_MSG') withCRs.
    box label:(resources string:'Language selection').
    box list:listOfLanguages.
    box initialText:(Language).
    box action:[:newLanguage |
	self withWaitCursorDo:[
	    Transcript showCr:'change language to ' , newLanguage , ' ...'.
	    Smalltalk at:#Language put:newLanguage asSymbol.
	    Smalltalk changed:#Language.
	    ResourcePack flushCachedResourcePacks
	].
	self reopenLauncher.
    ].    
    box showAtPointer
!

keyboardSetting 
    |mappings listOfRawKeys listOfFunctions
     box l
     list1 list2 listView1 listView2 
     frame infoLabel selectionForwarder macroForwarder macroTextView y|

    mappings := Screen current keyboardMap.

    listOfRawKeys := (mappings keys asArray collect:[:key | key asString]) sort.
    listOfFunctions := (mappings values asSet asArray collect:[:key | key asString]) sort.

    selectionForwarder := Plug new.
    selectionForwarder respondTo:#showFunction
		  with:[
			|raw|
			raw := list1 selection.
			list2 retractInterrestFor:selectionForwarder.
			list2 selection:(mappings at:raw asSymbol) asString.
			list2 onChangeSend:#showRawKey to:selectionForwarder.
		       ].
    selectionForwarder respondTo:#showRawKey
		  with:[
			|f raw|

			f := list2 selection.
			list1 retractInterrestFor:selectionForwarder.
			raw := mappings keyAtValue:f asString.
			raw isNil ifTrue:[
			    raw := mappings keyAtValue:f first.
			    raw isNil ifTrue:[
				raw := mappings keyAtValue:f asSymbol.
			    ]
			].
			list1 selection:raw.
			list1 onChangeSend:#showFunction to:selectionForwarder.
		       ].

    macroForwarder := Plug new.
    macroForwarder respondTo:#showMacro
		  with:[
			|f macro indent|
			f := list2 selection.
			(f startsWith:'Cmd') ifTrue:[
			    f := f copyFrom:4
			].
			macro := FunctionKeySequences at:(f asSymbol) ifAbsent:nil.
			macro notNil ifTrue:[
			    macro := macro asStringCollection.
			    indent := macro
					 inject:99999 into:[:min :element |
					     |stripped|

					     stripped := element withoutLeadingSeparators.
					     stripped size == 0 ifTrue:[
						 min
					     ] ifFalse:[
						 min min:(element size - stripped size)
					     ]
					 ].
			    indent ~~ 0 ifTrue:[
				macro := macro collect:[:line | 
					     line size > indent ifTrue:[
						line copyFrom:indent+1
					     ] ifFalse:[
						line
					     ].
					]
			    ].                        
			].
			macroTextView contents:macro.
		       ].

    list1 := SelectionInList with:listOfRawKeys.
    list1 onChangeSend:#showFunction to:selectionForwarder.
    list2 := SelectionInList with:listOfFunctions.
    list2 onChangeSend:#showRawKey to:selectionForwarder.
    list2 onChangeSend:#showMacro to:macroForwarder.

    box := Dialog new.
    box label:(resources string:'Keyboard mappings').

    l := box addTextLabel:(resources string:'KEY_MSG') withCRs.
    l adjust:#left.

    frame := View new.
    frame extent:300 @ 300.

    listView1 := ScrollableView for:SelectionInListView in:frame.
    listView1 model:list1.
    listView1 origin:0.0@0.0 corner:0.5@1.0; inset:2.

    listView2 := ScrollableView for:SelectionInListView in:frame.
    listView2 model:list2.
    listView2 origin:0.5@0.0 corner:1.0@1.0; inset:2.

    frame topInset:box yPosition.
    box addComponent:frame withExtent:350@200.
    box makeTabable:listView1. 
    box makeTabable:listView2. 
    frame origin:0.0@0.0 corner:1.0@0.6.

    box addVerticalSpace.

    l := box addTextLabel:(resources string:'Macro text (if any):') withCRs.
    l adjust:#left.
    l origin:0.0@0.6 corner:1.0@0.6.
    l topInset:(View viewSpacing).
    l bottomInset:(l preferredExtent y negated - View viewSpacing).

    macroTextView := HVScrollableView for:TextView miniScroller:true.
    box addComponent:macroTextView tabable:true.
    macroTextView origin:0.0@0.6 corner:1.0@1.0.
    y := box yPosition.

    box "addAbortButton;" addOkButton.
    macroTextView topInset:(l preferredExtent y).
    macroTextView bottomInset:(box preferredExtent y - y).

    box showAtPointer.

    box accepted ifTrue:[
    ]
!

compilerSettings
    |box warnings warnSTX warnUnderscore warnOldStyle allowUnderscore immutableArrays
     warnSTXBox warnUnderscoreBox warnOldStyleBox 
     stcCompilation compilationList stcCompilationOptions
     enabler|

    warnings := Compiler warnings asValue.

    warnSTX := Compiler warnSTXSpecials asValue.
    warnUnderscore := Compiler warnUnderscoreInIdentifier asValue.
    warnOldStyle := Compiler warnOldStyleAssignment asValue.
    allowUnderscore := Compiler allowUnderscoreInIdentifier asValue.
    immutableArrays := Compiler arraysAreImmutable asValue.
    stcCompilationOptions := #( always default never).
    stcCompilation := SelectionInList new list:(resources array:#('always' 'primitive code only' 'never')).
    stcCompilation selectionIndex:2.

    enabler := Plug new.
    enabler 
	respondTo:#check 
	with:[warnings value ifTrue:[
		warnSTXBox enable. 
		warnOldStyleBox enable.
		allowUnderscore value ifTrue:[
		    warnUnderscoreBox enable.
		] ifFalse:[
		    warnUnderscoreBox disable.
		].
	      ] ifFalse:[
		warnSTXBox disable. 
		warnUnderscoreBox disable.
		warnOldStyleBox disable.
	      ]].

    warnings onChangeSend:#check to:enabler.
    allowUnderscore onChangeSend:#check to:enabler.

    box := DialogBox new.
    box label:(resources string:'Compiler settings').
"/    box extent:200@300.

    box addCheckBox:(resources string:'allow underscore in identifiers') on:allowUnderscore.
    box addVerticalSpace.
    box addCheckBox:(resources string:'literal arrays are immutable') on:immutableArrays.
"/    box addVerticalSpace.
    box addHorizontalLine.
"/    box addVerticalSpace.

    "/ kludge for now (to get size computation right)

    compilationList := box addPopUpList:(resources string:'compilation to machine code') on:stcCompilation.
    stcCompilation selectionIndex:( stcCompilationOptions indexOf:(Compiler stcCompilation) ifAbsent:2).
    box addVerticalSpace.
"/    box addVerticalSpace.
    box addHorizontalLine.
"/    box addVerticalSpace.

    "/ if there is no compiler around,
    "/ change to compile nothing, and disable the checkBoxes
    Compiler canCreateMachineCode ifFalse:[
	stcCompilation selectionIndex:3.
	compilationList disable.
    ].

    box addCheckBox:(resources string:'warnings') on:warnings.
    box addVerticalSpace.
    box leftIndent:30.
    warnSTXBox := box addCheckBox:(resources string:'ST/X language extensions') on:warnSTX.
    box addVerticalSpace.
    warnUnderscoreBox := box addCheckBox:(resources string:'underscores in identifiers') on:warnUnderscore.
    box addVerticalSpace.
    warnOldStyleBox := box addCheckBox:(resources string:'oldStyle assignment') on:warnOldStyle.
    box addVerticalSpace.
    box leftIndent:0.

    box addAbortButton; addOkButton.

    enabler check.
    box showAtPointer.

    box accepted ifTrue:[
	Compiler warnings:warnings value.
	Compiler warnSTXSpecials:warnSTX value.
	Compiler warnOldStyleAssignment:warnOldStyle value.
	Compiler warnUnderscoreInIdentifier:warnUnderscore value.
	Compiler allowUnderscoreInIdentifier:allowUnderscore value.
	Compiler arraysAreImmutable:immutableArrays value.
	Compiler stcCompilation:(stcCompilationOptions at:stcCompilation selectionIndex)
    ]
!

messageSettings
    |box vmInfo vmErrors classInfos|

    vmInfo := ObjectMemory infoPrinting asValue.
    vmErrors := ObjectMemory debugPrinting asValue.
    classInfos := Object infoPrinting asValue.

    box := DialogBox new.
    box label:(resources string:'Messages').
"/    box extent:200@300.

    box addCheckBox:(resources string:'VM info messages') on:vmInfo.
    box addCheckBox:(resources string:'VM error messages') on:vmErrors.
    box addHorizontalLine.

    box addCheckBox:(resources string:'Other info messages') on:classInfos.

    box addAbortButton; addOkButton.
    box showAtPointer.

    box accepted ifTrue:[
	ObjectMemory infoPrinting:vmInfo value.
	ObjectMemory debugPrinting:vmErrors value.
	Object infoPrinting:classInfos value.
    ]
!

miscSettings
    |box logDoits compileLazy shadows updChanges catchRedefs|

    logDoits := Smalltalk logDoits asValue.
    compileLazy := Autoload compileLazy asValue.
    shadows := PopUpView shadows asValue.
    updChanges := Class updatingChanges asValue.
    catchRedefs := Class catchMethodRedefinitions asValue.

    box := DialogBox new.
    box label:(resources string:'Other settings').
"/    box extent:200@300.

    box addCheckBox:(resources string:'log compiles in changes file') on:updChanges.
    box addCheckBox:(resources string:'log doIts in changes file') on:logDoits.
    box addHorizontalLine.

    box addCheckBox:(resources string:'lazy compilation when autoloading') on:compileLazy.
    box addCheckBox:(resources string:'catch method redefinitions') on:catchRedefs.

    box addHorizontalLine.
    box addCheckBox:(resources string:'shadows under popup views') on:shadows.

    box addAbortButton; addOkButton.
    box showAtPointer.

    box accepted ifTrue:[
	Smalltalk logDoits:logDoits value.
	Autoload compileLazy:compileLazy value.
	PopUpView shadows:shadows value.
	Class updateChanges:updChanges value.
	Class catchMethodRedefinitions:catchRedefs value.
    ]
! !

!NewLauncher methodsFor:'infoview update'!

info
    |project projectName projectDir packageName|

    (Project isNil or:[(project := Project current) isNil]) ifTrue:[
	projectName := '* none *'.
	projectDir := '.'.
	packageName := '* none *'.
    ] ifFalse:[
	projectName := project name.
	projectDir := project directory.
	packageName := project packageName.
    ].

    ^ resources
	string:'project: ''%1''  fileOut to: ''%3''  package: ''%2'''
	  withArgs:(Array 
			with:projectName
			with:packageName 
			with:(projectDir contractTo:30))
! !

!NewLauncher methodsFor:'actions - about & help'!

toggleActiveHelp:aBoolean
    ActiveHelp notNil ifTrue:[
	helpIsOn := aBoolean.
	helpIsOn ifTrue:[
	    ActiveHelp start
	] ifFalse:[
	    ActiveHelp stop
	]
    ].
!

about
    |box|

    box := AboutBox new.
    box autoHideAfter:10 with:[].
    box showAtCenter
!

startDocumentationTool
    "
     although that one is not yet finished,
     its better than nothing ...
    "
    XtHTML notNil ifTrue:[
	"
	 temporary kludge;
	 not all machines can autoload binaries;
	 however, on my SGI (which can) we want it
	 to load automatically.
	"
	XtHTML isLoaded ifFalse:[
	    (OperatingSystem getSystemType = 'iris') ifTrue:[
		XtHTML autoload
	    ]
	].
	XtHTML isLoaded ifTrue:[
	    XtHTML openFull.
	    ^ self
	].
    ].

    self warn:'Sorry, the ST/X HTML reader is not (yet) 
included in this architectures release

Please use Mosaic, netscape, chimera or any
other HTML viewer to see the documentation.'.
! !

!NewLauncher methodsFor:'actions - tools'!

startProcessMonitor
    ProcessMonitor open
!

startMemoryMonitor
    MemoryMonitor open
!

startEventMonitor
    EventMonitor open
!

startMemoryUsageView
    MemoryUsageView open
!

startWindowTreeView
    |v|

    v := self pickAView.
    v notNil ifTrue:[
	WindowTreeView openOn:v topView
    ]
!

fullScreenHardcopy
    "after a second (to allow redraw of views under menu ...),
     save the contents of the whole screen."

    Processor addTimedBlock:[
	self saveScreenImage:(Image fromScreen) defaultName:'screen'
    ] afterSeconds:1
!

startFullWindowTreeView
    WindowTreeView open
!

viewInspect
    |v|

    v := self pickAView.
    v notNil ifTrue:[
	v topView inspect
    ]

!

viewDestroy
    |v|

    v := self pickAView.
    v notNil ifTrue:[
	v topView destroy
    ]
!

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) defaultName:'hardcopy'
	]
    ] afterSeconds:1
!

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)) defaultName:'hardcopy'
	]
    ] afterSeconds:1
! !

!NewLauncher methodsFor:'actions - goodies'!

startNewsTool
    NewsView open
!

startMailTool
    MailView open
!

startClock
    RoundClock open
!

startCalendar
    Calendar open
! !

!NewLauncher methodsFor:'change & update'!

update:something with:aParameter from:changedObject
    ((something == #currentProject)
    or:[changedObject == Project]) ifTrue:[
	self changed:#info.
	^ self
    ].
! !

!NewLauncher methodsFor:'actions - file'!

snapshot
    |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.)
	    "
	    self warn:(resources string:'failed to save snapshot image (disk full or not writable)').
	]
    ].

    saveBox initialText:(ObjectMemory nameForSnapshot).
    saveBox label:'save image'.
    saveBox showAtPointer

!

exit
    (self confirm:(resources string:'Are you certain you want to exit without saving ?'))
    ifTrue:[
	self saveAllViews.
	Smalltalk exit
    ]
!

snapshotAndExit
    |saveBox|

    saveBox := EnterBox title:(resources at:'filename for image:') withCRs.
    saveBox okText:(resources at:'save & exit').
    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)').
	] ifTrue:[
	    "
	     saveAllViews 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 saveAllViews.
"
	    Smalltalk exit
	]
    ].

    saveBox initialText:(ObjectMemory nameForSnapshot).
    saveBox label:'save image & exit'.
    saveBox showAtPointer

! !

!NewLauncher methodsFor:'actions - projects'!

newProject 
    Project notNil ifTrue:[
	(ProjectView for:(Project new)) open
    ]
!

selectProject
    |list box|

    Project notNil ifTrue:[
	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
    ]
! !

!NewLauncher methodsFor:'private'!

reopenLauncher
    "for now (since style & language settings currently do
     not affect living views ...)"

    |contents|

    contents := Transcript endEntry; contents.
    self class open.
    Transcript contents:contents; hideCursor; scrollToBottom; cursorToEnd; showCursor
!

saveAllViews
    "tell each topview that we are going to terminate and give it chance
     to save its contents."

    ObjectMemory changed:#aboutToExit
!

pickAView
    |v|

    (Delay forSeconds:1) wait.
    v := Screen current viewFromUser.
    v isNil ifTrue:[
	self warn:'sorry, this is not a smalltalk view'.
	^ nil
    ].
    ^ v
!

saveScreenImage:anImage defaultName:defaultName
    "save an image into a file 
     - ask user for filename using a fileSelectionBox."

    |fileName|

    fileName := Dialog
		    requestFileName:'save image in:'
		    default:(defaultName , '.tiff')
		    ok:'save'
		    abort:'abort'
		    pattern:'*.tiff'.

    fileName notNil ifTrue:[
	anImage saveOn:fileName
    ].
! !

!NewLauncher methodsFor:'actions - demos'!

openDemo:className
    (Smalltalk at:className) open

!

startTicTacToe
    TicTacToe open
!

startTetris
    Tetris open
! !

!NewLauncher methodsFor:'help'!

helpTextFor:aComponent
    |sel|

    aComponent == transcript ifTrue:[
	^ resources string:'this is the Transcript.\It is used to send\messages to the user.'
    ].

    aComponent == infoView ifTrue:[
	^ resources string:'this shows the name of the current\project and the directory\where a fileOut operation writes the file.'
    ].

    (buttonPanel subViews includes:aComponent) ifTrue:[
	"kludge: look for its change selector"
	sel := aComponent changeMessage.
	sel == #startSystemBrowser ifTrue:[
	    ^ resources string:'opens a\SystemBrowser'
	].
	sel == #startFileBrowser ifTrue:[
	    ^ resources string:'opens a\FileBrowser'
	].
    ].
    ^ nil
! !