"
 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.
"

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.2 1995-03-26 17:35:27 claus Exp $
"
! !

!NewLauncher class methodsFor:'defaults'!

aboutIcon
    |image|

    CachedAboutIcon notNil ifTrue:[^ CachedAboutIcon].

    image := Image fromFile:'SmalltalkX.xbm'.
    image isNil ifTrue:[
	^ 'about'
    ] ifFalse:[
	|green dark|

	Display hasColors ifTrue:[
	    green := (Color red:0 green:80 blue:20) darkened.
	] ifFalse:[
	    green := White.
	].
	Display hasGreyscales ifTrue:[
	    dark := Color grey:10.
	] ifFalse:[
	    dark := Black.
	].
	image colorMap:(Array with:dark with:green); photometric:#palette.
	image := image magnifyBy:0.4.
	Display depth > 2 ifTrue:[
	    image := (Image implementorForDepth:Display depth) fromImage:image.
	]
    ].
    CachedAboutIcon := image.
    ^ image

    "
     CachedAboutIcon := nil
    "
! !

!NewLauncher class methodsFor:'startup'!

open
    |top launcher|

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

    launcher := self new setupViewsIn:top.

    top open.
    "
     raise its prio ...
    "
    top windowGroup process priority:(Processor userSchedulingPriority + 1).

    "
     self open
    "
! !

!NewLauncher methodsFor:'actions - settings'!

viewStyleSetting 
    |listOfStyles resourceDir dir box|

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

    resourceDir := Smalltalk getSystemFileName:'resources'.
    dir := FileDirectory directoryNamed:resourceDir.

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

    box := ListSelectionBox new.
    box title:'select a style

The style change will not affect views 
which are already open.
'.
    box label:'Style selection'.
    box list:listOfStyles.
    box initialText:View defaultStyle.
    box action:[:newStyle |
	transcript topView withCursor:Cursor wait do:[
	    Transcript showCr:'change style to ' , newStyle , ' ...'.
	    View defaultStyle:newStyle asSymbol.
	]
    ].    
    box showAtPointer
!

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 new.
    box title:'select a language

This requires that the resource files have the corresponding
language strings available; this may be not the case in the
current version for all languages.

The change will not affect views/applictions which are already open.
'.
    box label:'Language selection'.
    box list:listOfLanguages.
    box initialText:(Language).
    box action:[:newLanguage |
	transcript topView withCursor:Cursor wait do:[
	    Transcript showCr:'change language to ' , newLanguage , ' ...'.
	    Smalltalk at:#Language put:newLanguage asSymbol.
	    Smalltalk changed:#Language.
	    ResourcePack flushCachedResourcePacks
	]
    ].    
    box showAtPointer
!

compilerSetting
! !

!NewLauncher methodsFor:'initialize / release'!

setupMenu
    "setup the pulldown menu"

    |l s|

    myMenu labels:(resources array:#(
				     'about'
				     'file'
				     'classes'
				     'tools'
				     'projects'
				     'settings'
				     'goodies'
				     'demos'
				     'help')).
    myMenu labels at:1 put:(self class aboutIcon).

    myMenu selectors:#(
				     #about
				     #file
				     #classes 
				     #tools 
				     #projects 
				     #settings
				     #goodies
				     #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'
				       ))
	   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:#tools 
	   putLabels:(resources array:#(
					'workspace'
					'-'
					'process monitor'
					'memory monitor'
					'-'
					'memory usage'
					'-'
					'window tree'
					'inspect view'
					'destroy view'
					))
	   selectors:#(
					#startWorkspace 
					nil
					#startProcessMonitor
					#startMemoryMonitor 
					nil
					#startMemoryUsageView 
					nil
					#startWindowTreeView 
					#viewInspect 
					#viewDestroy 
		      )
	   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'
					'view style'
					'compilation'
					))
	   selectors:#(
					#languageSetting 
					#viewStyleSetting 
					#compilerSetting 
		      )
	   receiver:self.

    myMenu at:#goodies 
	   putLabels:(resources array:#(
					'clock'
					'calendar'
					'-'
					'mail tool'
					'news tool'
					'-'
					'draw tool'
					))
	   selectors:#(
					#startClock 
					#startCalendar 
					nil
					#startMailTool 
					#startNewsTool
					nil
					#startDrawTool
		      )
	   receiver:self.

    myMenu at:#demos 
	   putLabels:(resources array:#(
					))
	   selectors:#(
		      )
	   receiver:self.

    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.
!

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

    |frame|

    topView model:self.

    myMenu := PullDownMenu in:topView.
    myMenu origin:0.0@0.0 corner:[1.0@nil].

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

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

    "
     NewLauncher open
    "
!

setupInfoViewIn:topView 
    |spc|

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

    infoView topInset:(infoView height negated - spc);
	     bottomInset:spc // 2;
	     leftInset:spc//2; 
	     rightInset:spc//2.
    infoView origin:0.0 @ 1.0 corner:1.0@1.0.
    infoView model:self; aspect:#info.

    Project addDependent:self.

    "
     NewLauncher open
    "
!

setupButtonPanelIn:aTopView
    "create the buttonPanel"

    |sep spc|

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

    #(
	#(startSystemBrowser 'SBrowser32x32.xbm')
	#(startFileBrowser   'FBrowser32x32.xbm')
     ) do:[:entry |
	|b|

	b := Button in:buttonPanel.
	b form:(Image fromFile:(entry at:2)).
	b model:self; change:(entry at:1)
    ].
    sep := View in:buttonPanel.
    sep extent:32@32; borderWidth:0.

    "
     ... add more buttons here ...
    "

    buttonPanel origin:0.0 @ myMenu height 
		corner:(1.0 @ (myMenu height + buttonPanel preferedExtent y)).

    buttonPanel leftInset:spc; rightInset:spc.
!

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

focusSequence
    ^ (Array with:myMenu) , buttonPanel subViews , (Array with:Transcript)
! !

!NewLauncher methodsFor:'actions - classes'!

startFileBrowser
    FileBrowser open
!

startSystemBrowser
    SystemBrowser open
!

startChangesBrowser
    ChangesBrowser open
!

startWorkspace
    Workspace open
!

startClassBrowser
    self getClassThenDo:[:cls | SystemBrowser browseClass:cls].
!

startClassHierarchyBrowser
    self getClassThenDo:[:cls | SystemBrowser browseClassHierarchy:cls].
!

startFullClassBrowser
    self getClassThenDo:[:cls | SystemBrowser browseFullClassProtocol:cls].
!

browseImplementors
    |enterBox|

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

	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|

	SystemBrowser browseAllCallsOn:selectorName  
    ].
    enterBox showAtPointer
!

startClassTreeView
    ClassTreeGraphView open
! !

!NewLauncher methodsFor:'infoview update'!

info
    |project projectName projectDir|

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

    ^ resources
	string:'project: ''%1''  fileOut to: ''%2'''
	  with:projectName
	  with:(projectDir contractTo:30)
! !

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

about
    |box|

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

toggleActiveHelp
    ActiveHelp notNil ifTrue:[
	helpIsOn isNil ifTrue:[helpIsOn := false].
	helpIsOn := helpIsOn not.
	helpIsOn ifTrue:[
	    ActiveHelp start
	] ifFalse:[
	    ActiveHelp stop
	]
    ].
! !

!NewLauncher methodsFor:'actions - tools'!

startProcessMonitor
    ProcessMonitor open
!

startMemoryMonitor
    MemoryMonitor open
!

startMemoryUsageView
    MemoryUsageView open
!

startWindowTreeView
    WindowTreeView open

!

viewInspect
    |v|

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

!

viewInspector
    |v|

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

!

viewDestroy
    |v|

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

! !

!NewLauncher methodsFor:'actions - goodies'!

startNewsTool
    NewsView open
!

startMailTool
    MailView open
!

startClock
    RoundClock open
!

startDrawTool
    DrawTool 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 closeDownViews.
	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:[
	    "
	     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
	]
    ].

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

! !

!NewLauncher methodsFor:'actions - 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

! !

!NewLauncher methodsFor:'private'!

getClassThenDo:aBlock
    |enterBox|

    enterBox := EnterBox title:(resources at:'Browse which class:') withCRs.
    enterBox okText:(resources at:'browse').
    enterBox action:[:className |
	|cls|

	cls := Smalltalk classNamed:className.
	cls isNil ifTrue:[
	    self warn:'no such class'.
	] ifFalse:[
	    aBlock value:cls  
	]
    ].
    enterBox showAtPointer
!

closeDownViews
    "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 := Display viewFromUser.
    v isNil ifTrue:[
	self warn:'sorry, this is not a smalltalk view'.
	^ nil
    ].
    ^ v
! !

!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 changeSymbol.
	sel == #startSystemBrowser ifTrue:[
	    ^ resources string:'opens a\SystemBrowser'
	].
	sel == #startFileBrowser ifTrue:[
	    ^ resources string:'opens a\FileBrowser'
	].
    ].
    ^ nil
! !