--- a/Launcher.st Tue Apr 11 18:31:23 1995 +0200
+++ b/Launcher.st Wed May 03 03:13:28 1995 +0200
@@ -10,7 +10,7 @@
hereby transferred.
"
-'From Smalltalk/X, Version:2.10.5 on 31-mar-1995 at 12:35:15 pm'!
+'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'
@@ -37,12 +37,28 @@
version
"
-$Header: /cvs/stx/stx/libtool/Launcher.st,v 1.6 1995-04-11 16:31:17 claus Exp $
+$Header: /cvs/stx/stx/libtool/Launcher.st,v 1.7 1995-05-03 01:12:52 claus Exp $
"
! !
!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|
@@ -74,28 +90,14 @@
CachedAboutIcon := nil.
NewLauncher aboutIcon
"
-!
-
-smallAboutIcon
- |image|
-
- image := self aboutIcon.
- image notNil ifTrue:[
- image := image magnifyBy:0.4.
- ].
- ^ image
-
- "
- CachedAboutIcon := nil.
- NewLauncher aboutIcon.
- NewLauncher smallAboutIcon.
- "
! !
-!NewLauncher class methodsFor:'startup'!
+!NewLauncher methodsFor:'initialize / release'!
-open
- |top launcher icn w|
+openInterface
+ "sent by my superclass top open up my interface"
+
+ |top icn w|
top := StandardSystemView new.
top label:'Smalltalk/X'.
@@ -107,47 +109,29 @@
automatically soon ...
"
Display serverVendor = 'Silicon Graphics' ifTrue:[
- icn := self aboutIcon.
+ icn := self class aboutIcon.
icn notNil ifTrue:[
- icn := icn magnifyTo:86@68.
+ icn := icn magnifiedTo:86@68.
w := View extent:86@68. "/ icn extent.
w viewBackground:icn.
top iconView:w
]
].
- launcher := self new setupViewsIn:top.
+ self setupViewsIn:top.
+ top application:self.
"
open with higher prio to allow interaction even while things
are running ...
"
top openWithPriority:(Processor userSchedulingPriority + 1).
-
- "
- self open
- "
-! !
-
-!NewLauncher methodsFor:'initialize / release'!
-
-setupTranscriptIn:aView
- |v|
+!
- (Transcript notNil and:[Transcript ~~ Stderr]) ifTrue:[
- Transcript topView destroy.
- ].
+addTopViewsToCurrentProject
+ "ignored here - the launcher is always global (i.e. not project private)."
- 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.
+ ^ self
!
setupMenu
@@ -235,33 +219,6 @@
)
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'
@@ -279,15 +236,16 @@
putLabels:(resources array:#(
'language'
'view style'
-"/ 'compilation'
+ 'compilation'
))
selectors:#(
#languageSetting
#viewStyleSetting
-"/ #compilerSetting
+ #compilerSetting
)
receiver:self.
+ self setupToolsMenu.
self setupDemoMenu.
ActiveHelp notNil ifTrue:[
@@ -296,7 +254,7 @@
'ST/X documentation'
).
s := #(
- #toggleActiveHelp
+ #toggleActiveHelp:
#startDocumentationTool
)
] ifFalse:[
@@ -314,8 +272,27 @@
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|
+ |spc halfSpc|
spc := View viewSpacing.
infoView := Label label:'' in:topView.
@@ -323,20 +300,27 @@
infoView level:-1.
transcript superView bottomInset:(infoView height + spc).
+ halfSpc := spc // 2.
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.
+ 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 addDependent:self.
+ Project notNil ifTrue:[
+ Project addDependent:self.
+ ]
"
NewLauncher open
"
!
+focusSequence
+ ^ (Array with:myMenu) , buttonPanel subViews , (Array with:Transcript)
+!
+
setupViewsIn:topView
"create the pulldown menu, buttonPanel and transcript view"
@@ -361,10 +345,6 @@
"
!
-focusSequence
- ^ (Array with:myMenu) , buttonPanel subViews , (Array with:Transcript)
-!
-
setupButtonPanelIn:aTopView
"create the buttonPanel"
@@ -395,14 +375,6 @@
buttonPanel leftInset:spc; rightInset:spc.
!
-release
- infoProcess notNil ifTrue:[
- infoProcess terminate.
- infoProcess := nil.
- ].
- super release
-!
-
setupDemoMenu
"setup the demo pulldown menu"
@@ -549,6 +521,98 @@
#(nil nil)
#(startChangesBrowser 'CBrowser32x32.xbm')
)
+!
+
+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'!
@@ -672,6 +736,30 @@
!
compilerSetting
+ |box warnSTX allowUnderscore immutableArrays ok|
+
+ warnSTX := Compiler warnSTXSpecials asValue.
+ allowUnderscore := Compiler allowUnderscoreInIdentifier asValue.
+ immutableArrays := Compiler arraysAreImmutable asValue.
+
+ box := DialogBox new.
+ box label:'Compiler settings'.
+ box extent:200@300.
+
+ box addCheckBox:'warn about ST/X language extensions' on:warnSTX.
+ box addCheckBox:'allow underscore in identifiers' on:allowUnderscore.
+ box addCheckBox:'literal arrays are immutable' on:immutableArrays.
+
+ box addAbortButton; addOkButton:[ok := true].
+
+ ok := false.
+ box showAtPointer.
+
+ ok ifTrue:[
+ Compiler warnSTXSpecials:warnSTX value.
+ Compiler allowUnderscoreInIdentifier:allowUnderscore value.
+ Compiler arraysAreImmutable:immutableArrays value.
+ ]
! !
!NewLauncher methodsFor:'infoview update'!
@@ -679,7 +767,7 @@
info
|project projectName projectDir|
- (project := Project current) isNil ifTrue:[
+ (Project isNil or:[(project := Project current) isNil]) ifTrue:[
projectName := '* none *'.
projectDir := '.'.
] ifFalse:[
@@ -695,6 +783,17 @@
!NewLauncher methodsFor:'actions - about & help'!
+toggleActiveHelp:aBoolean
+ ActiveHelp notNil ifTrue:[
+ helpIsOn := aBoolean.
+ helpIsOn ifTrue:[
+ ActiveHelp start
+ ] ifFalse:[
+ ActiveHelp stop
+ ]
+ ].
+!
+
about
|box|
@@ -722,7 +821,7 @@
self warn:'no documentation files available'.
^ self.
].
- whereIsDoc := s pathName asFilename directory asString.
+ whereIsDoc := s pathName asFilename directoryName.
s close.
#('Mosaic' 'mosaic' 'netscape' 'chimera')
@@ -740,18 +839,6 @@
you should get one of Mosaic, netscape, chimera ...
... or wait till HTML support in ST/X is complete.'.
]
-!
-
-toggleActiveHelp
- ActiveHelp notNil ifTrue:[
- helpIsOn isNil ifTrue:[helpIsOn := false].
- helpIsOn := helpIsOn not.
- helpIsOn ifTrue:[
- ActiveHelp start
- ] ifFalse:[
- ActiveHelp stop
- ]
- ].
! !
!NewLauncher methodsFor:'actions - tools'!
@@ -764,26 +851,37 @@
MemoryMonitor open
!
+startEventMonitor
+ EventMonitor open
+!
+
startMemoryUsageView
MemoryUsageView open
!
startWindowTreeView
- WindowTreeView open
-
-!
-
-viewInspect
|v|
v := self pickAView.
v notNil ifTrue:[
- v topView inspect
+ WindowTreeView openOn:v topView
]
-
!
-viewInspector
+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.
@@ -800,7 +898,35 @@
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 := Display viewFromUser.
+ v notNil ifTrue:[
+ self saveScreenImage:(Image fromView:(v topView)) defaultName:'hardcopy'
+ ]
+ ] afterSeconds:1
! !
!NewLauncher methodsFor:'actions - goodies'!
@@ -899,30 +1025,32 @@
!NewLauncher methodsFor:'actions - projects'!
newProject
- (ProjectView for:(Project new)) open
-
+ Project notNil ifTrue:[
+ (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 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
-
+ 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'!
@@ -944,6 +1072,24 @@
^ 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'!