"

 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

"

"

!

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.

    (ObjectFileLoader notNil and:[ObjectFileLoader isLoaded]) ifTrue:[

	l := #(

		    'file browser'

		    '-'

		    'modules'

		    '-'

		    'snapshot'

		    'snapshot & exit'

		    'exit smalltalk'

	     ).

	s := #(

		    #startFileBrowser

		    nil

		    #objectModuleDialog 

		    nil

		    #snapshot

		    #snapshotAndExit

		    #exit

	     )

    ] ifFalse:[

	l := #(

		    'file browser'

		    '-'

		    'snapshot'

		    'snapshot & exit'

		    'exit smalltalk'

	     ).

	s := #(

		    #startFileBrowser

		    nil

		    #snapshot

		    #snapshotAndExit

		    #exit

	     )

    ].

    myMenu at:#file

	   putLabels:(resources array:l)

	   selectors:s

	   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.

		    @ 

		    ((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|