--- a/Launcher.st Sat Apr 25 16:07:21 1998 +0200
+++ b/Launcher.st Sat Apr 25 16:23:15 1998 +0200
@@ -1,6 +1,6 @@
"
COPYRIGHT (c) 1995 by Claus Gittinger
- All Rights Reserved
+ 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
@@ -18,12 +18,19 @@
category:'Interface-Smalltalk'
!
+Object subclass:#SettingsDialogs
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:Launcher
+!
+
!Launcher class methodsFor:'documentation'!
copyright
"
COPYRIGHT (c) 1995 by Claus Gittinger
- All Rights Reserved
+ 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
@@ -46,38 +53,38 @@
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.
+ 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.
- All menu setup has been extracted into separate init-methods,
- so there is often only a need to redefine one of those
- (for example, to add your own demos, only redefine setupDemoMenu).
- To add a new master-item with its own pullDown, redefine setupMainMenu
- to include another selector and add the correspoonding menu there.
+ see the #setupMenu method; either add another top-menu, or
+ add entries to an existing menu.
+ All menu setup has been extracted into separate init-methods,
+ so there is often only a need to redefine one of those
+ (for example, to add your own demos, only redefine setupDemoMenu).
+ To add a new master-item with its own pullDown, redefine setupMainMenu
+ to include another selector and add the correspoonding menu there.
"
!
@@ -94,18 +101,18 @@
launcher functions.
Notice:
- Since there can only be one SystemTranscript, opening a new launcher
- will automatically close the current one (except for a remote launcher,
- opened on another display).
+ Since there can only be one SystemTranscript, opening a new launcher
+ will automatically close the current one (except for a remote launcher,
+ opened on another display).
[author:]
- Claus Gittinger
+ Claus Gittinger
[see also:]
- Examples_misc::MyLauncher
+ Examples_misc::MyLauncher
[start with:]
- Launcher open
+ Launcher open
"
!
@@ -114,18 +121,18 @@
As ST/X can handle multiple screens, there is nothing (except fear ;-)
from preventing you to work with your friend in the same image.
To do this, evaluate (replace localhost by whatever):
- [exBegin]
- |display2|
-
- display2 := XWorkstation new initializeFor:'localhost:0'.
- display2 isNil ifTrue:[
- self warn:'cannot connect.'.
- ] ifFalse:[
- display2 startDispatch.
- display2 keyboardMap:(Display keyboardMap).
- Launcher openOnDevice:display2.
- ]
- [exEnd]
+ [exBegin]
+ |display2|
+
+ display2 := XWorkstation new initializeFor:'localhost:0'.
+ display2 isNil ifTrue:[
+ self warn:'cannot connect.'.
+ ] ifFalse:[
+ display2 startDispatch.
+ display2 keyboardMap:(Display keyboardMap).
+ Launcher openOnDevice:display2.
+ ]
+ [exEnd]
But you should be somewhat careful, the other guy may change things so
that you are blocked (start high prio processes, change classes etc.)
Anyway, a nice demo ....
@@ -139,9 +146,9 @@
(for access via addMenu/ removeMenu)"
OpenLaunchers do:[:aLauncher |
- aLauncher window graphicsDevice == Screen current ifTrue:[
- ^ aLauncher
- ]
+ aLauncher window graphicsDevice == Screen current ifTrue:[
+ ^ aLauncher
+ ]
].
^ nil.
@@ -171,18 +178,18 @@
image := Image fromFile:'SmalltalkX.xbm'.
image notNil ifTrue:[
- |green dark|
-
- Screen current hasColors ifTrue:[
- green := (Color redPercent:0 greenPercent:80 bluePercent:20) "darkened".
- dark := Color grayPercent:10.
- image photometric:#palette.
- ] ifFalse:[
- dark := Color black.
- green := Color white.
- image photometric:#blackIs0.
- ].
- image colorMap:(Array with:dark with:green).
+ |green dark|
+
+ Screen current hasColors ifTrue:[
+ green := (Color redPercent:0 greenPercent:80 bluePercent:20) "darkened".
+ dark := Color grayPercent:10.
+ image photometric:#palette.
+ ] ifFalse:[
+ dark := Color black.
+ green := Color white.
+ image photometric:#blackIs0.
+ ].
+ image colorMap:(Array with:dark with:green).
"/ Screen current depth > 2 ifTrue:[
"/ image := (Image implementorForDepth:Screen current depth) fromImage:image.
"/ ]
@@ -220,7 +227,7 @@
handler is the notifying one."
NotifyingEmergencyHandler isNil ifTrue:[
- NotifyingEmergencyHandler := Exception notifyingEmergencyHandler
+ NotifyingEmergencyHandler := Exception notifyingEmergencyHandler
].
^ NotifyingEmergencyHandler
@@ -235,7 +242,7 @@
image := self aboutIcon.
image notNil ifTrue:[
- image := image magnifiedBy:0.4.
+ image := image magnifiedBy:0.4.
].
^ image
@@ -281,19 +288,19 @@
its better than nothing ...
"
HTMLDocumentView notNil ifTrue:[
- "
- temporary kludge;
- not all machines can autoload binaries;
- however, on my SGI (which can) we want it
- to load automatically.
- "
- HTMLDocumentView isLoaded ifFalse:[
- ErrorSignal catch:[HTMLDocumentView autoload]
- ].
- HTMLDocumentView isLoaded ifTrue:[
- HTMLDocumentView openFullOnDocumentationFile:aRelativeDocFilePath.
- ^ self
- ].
+ "
+ temporary kludge;
+ not all machines can autoload binaries;
+ however, on my SGI (which can) we want it
+ to load automatically.
+ "
+ HTMLDocumentView isLoaded ifFalse:[
+ ErrorSignal catch:[HTMLDocumentView autoload]
+ ].
+ HTMLDocumentView isLoaded ifTrue:[
+ HTMLDocumentView openFullOnDocumentationFile:aRelativeDocFilePath.
+ ^ self
+ ].
].
self warn:'Sorry, the ST/X HTML reader is not
@@ -384,12 +391,12 @@
"turn on/off active help"
ActiveHelp notNil ifTrue:[
- helpIsOn := aBoolean.
- helpIsOn ifTrue:[
- ActiveHelp start
- ] ifFalse:[
- ActiveHelp stop
- ]
+ helpIsOn := aBoolean.
+ helpIsOn ifTrue:[
+ ActiveHelp start
+ ] ifFalse:[
+ ActiveHelp stop
+ ]
].
"Modified: 8.1.1997 / 14:37:30 / cg"
@@ -416,15 +423,15 @@
|enterBox selector|
enterBox := EnterBox
- title:(resources at:'Browse implementors of:') withCRs
- okText:(resources at:'browse')
- action:[:acceptedString | selector := acceptedString].
+ title:(resources at:'Browse implementors of:') withCRs
+ okText:(resources at:'browse')
+ action:[:acceptedString | selector := acceptedString].
enterBox showAtPointer.
selector notNil ifTrue:[
- self withWaitCursorDo:[
- SystemBrowser browseImplementorsOf:selector
- ]
+ self withWaitCursorDo:[
+ SystemBrowser browseImplementorsOf:selector
+ ]
].
"Modified: / 31.10.1997 / 15:43:45 / cg"
@@ -463,28 +470,28 @@
box destroy.
box accepted ifTrue:[
- rsrc := resourceHolder value.
- value := valueHolder value.
-
- (rsrc isNil or:[rsrc isEmpty or:[rsrc = '*' or:[rsrc = anyString]]]) ifTrue:[
- t := 'methods with any resource'.
- rsrc := nil
- ] ifFalse:[
- t := 'methods with #' , rsrc , '-resource'.
- rsrc := rsrc withoutSeparators asSymbol
- ].
- (value isNil or:[value isEmpty or:[value = '*']]) ifTrue:[
- t := t , ' and any value'.
- value := nil
- ] ifFalse:[
- t := t , ' and value ' , value.
- ].
- self withWaitCursorDo:[
- SystemBrowser browseForResource:rsrc
- containing:value
- in:(Smalltalk allClasses)
- title:t
- ]
+ rsrc := resourceHolder value.
+ value := valueHolder value.
+
+ (rsrc isNil or:[rsrc isEmpty or:[rsrc = '*' or:[rsrc = anyString]]]) ifTrue:[
+ t := 'methods with any resource'.
+ rsrc := nil
+ ] ifFalse:[
+ t := 'methods with #' , rsrc , '-resource'.
+ rsrc := rsrc withoutSeparators asSymbol
+ ].
+ (value isNil or:[value isEmpty or:[value = '*']]) ifTrue:[
+ t := t , ' and any value'.
+ value := nil
+ ] ifFalse:[
+ t := t , ' and value ' , value.
+ ].
+ self withWaitCursorDo:[
+ SystemBrowser browseForResource:rsrc
+ containing:value
+ in:(Smalltalk allClasses)
+ title:t
+ ]
].
"Created: 28.5.1996 / 13:15:16 / cg"
@@ -497,15 +504,15 @@
|enterBox selector|
enterBox := EnterBox
- title:(resources at:'Browse senders of:') withCRs
- okText:(resources at:'browse')
- action:[:acceptedString | selector := acceptedString].
+ title:(resources at:'Browse senders of:') withCRs
+ okText:(resources at:'browse')
+ action:[:acceptedString | selector := acceptedString].
enterBox showAtPointer.
selector notNil ifTrue:[
- self withWaitCursorDo:[
- SystemBrowser browseAllCallsOn:selector
- ]
+ self withWaitCursorDo:[
+ SystemBrowser browseAllCallsOn:selector
+ ]
].
"Modified: / 31.10.1997 / 15:44:11 / cg"
@@ -515,10 +522,10 @@
"open a browser on methods refering to undeclared variables"
self withWaitCursorDo:[
- SystemBrowser
- browseReferendsOf:(Smalltalk underclaredPrefix , '*')
- title:(resources string:'references to undeclared variables')
- warnIfNone:true
+ SystemBrowser
+ browseReferendsOf:(Smalltalk underclaredPrefix , '*')
+ title:(resources string:'references to undeclared variables')
+ warnIfNone:true
]
"Modified: / 31.10.1997 / 15:43:18 / cg"
@@ -584,7 +591,7 @@
"open a javaBrowser (not included in the standard distribution)"
JavaBrowser notNil ifTrue:[
- self withWaitCursorDo:[JavaBrowser open]
+ self withWaitCursorDo:[JavaBrowser open]
]
"Created: 18.4.1996 / 15:55:44 / cg"
@@ -661,8 +668,8 @@
(self confirm:(resources string:'Are you certain you want to exit without saving ?'))
ifTrue:[
- self saveAllViews.
- Smalltalk exit
+ self saveAllViews.
+ Smalltalk exit
]
"Modified: 8.1.1997 / 14:50:00 / cg"
@@ -693,69 +700,69 @@
list2 := SelectionInList new.
moduleListUpdater := [
- |l|
-
- list2 list:nil.
-
- l := Array new.
- handles := Array new.
-
- (showModules value or:[showBuiltIn value]) ifTrue:[
- allModules := ObjectMemory binaryModuleInfo asOrderedCollection.
- (showBuiltIn value and:[showModules value]) ifFalse:[
- allModules := allModules select:[:i |
- |wantToSee|
-
- wantToSee := i dynamic.
- showBuiltIn value ifTrue:[
- wantToSee := wantToSee not
- ].
- wantToSee
- ]
- ].
-
- "/ sorting by reverse id brings newest ones to the top (a side effect)
- allModules sort:[:a :b | (a id) > (b id)].
- moduleNames := allModules collect:[:entry | entry name].
- l := l , moduleNames.
- handles := handles , allModules.
- ].
-
- showMethods value ifTrue:[
- allObjects := ObjectFileLoader loadedObjectHandles.
- methodObjects := (allObjects select:[:h | h isMethodHandle]) asArray.
- methodNames := methodObjects collect:[:mH | mH method isNil ifTrue:[
- 'compiled method - removed' , ' (in ' , mH pathName , ')'
- ] ifFalse:[
- 'compiled method ' , mH method whoString , ' (in ' , mH pathName , ')'
- ].
- ].
- l := l , methodNames.
- handles := handles , methodObjects.
- ].
-
- showCObjects value ifTrue:[
- allObjects := ObjectFileLoader loadedObjectHandles.
- cObjects := (allObjects select:[:h | h isFunctionObjectHandle]) asArray.
- cObjectNames := cObjects collect:[:entry | entry pathName].
- l := l , cObjectNames.
- handles := handles , cObjects.
- ].
-
- showOthers value ifTrue:[
- allObjects := ObjectFileLoader loadedObjectHandles.
- otherObjects := (allObjects select:[:h | (h isFunctionObjectHandle
- or:[h isMethodHandle
- or:[h isClassLibHandle]]) not]) asArray.
- otherObjectNames := otherObjects collect:[:entry | entry pathName].
- l := l , otherObjectNames.
- handles := handles , otherObjects.
- ].
-
- list1 list:l.
- unloadButton disable.
- unloadAndRemoveButton disable.
- ].
+ |l|
+
+ list2 list:nil.
+
+ l := Array new.
+ handles := Array new.
+
+ (showModules value or:[showBuiltIn value]) ifTrue:[
+ allModules := ObjectMemory binaryModuleInfo asOrderedCollection.
+ (showBuiltIn value and:[showModules value]) ifFalse:[
+ allModules := allModules select:[:i |
+ |wantToSee|
+
+ wantToSee := i dynamic.
+ showBuiltIn value ifTrue:[
+ wantToSee := wantToSee not
+ ].
+ wantToSee
+ ]
+ ].
+
+ "/ sorting by reverse id brings newest ones to the top (a side effect)
+ allModules sort:[:a :b | (a id) > (b id)].
+ moduleNames := allModules collect:[:entry | entry name].
+ l := l , moduleNames.
+ handles := handles , allModules.
+ ].
+
+ showMethods value ifTrue:[
+ allObjects := ObjectFileLoader loadedObjectHandles.
+ methodObjects := (allObjects select:[:h | h isMethodHandle]) asArray.
+ methodNames := methodObjects collect:[:mH | mH method isNil ifTrue:[
+ 'compiled method - removed' , ' (in ' , mH pathName , ')'
+ ] ifFalse:[
+ 'compiled method ' , mH method whoString , ' (in ' , mH pathName , ')'
+ ].
+ ].
+ l := l , methodNames.
+ handles := handles , methodObjects.
+ ].
+
+ showCObjects value ifTrue:[
+ allObjects := ObjectFileLoader loadedObjectHandles.
+ cObjects := (allObjects select:[:h | h isFunctionObjectHandle]) asArray.
+ cObjectNames := cObjects collect:[:entry | entry pathName].
+ l := l , cObjectNames.
+ handles := handles , cObjects.
+ ].
+
+ showOthers value ifTrue:[
+ allObjects := ObjectFileLoader loadedObjectHandles.
+ otherObjects := (allObjects select:[:h | (h isFunctionObjectHandle
+ or:[h isMethodHandle
+ or:[h isClassLibHandle]]) not]) asArray.
+ otherObjectNames := otherObjects collect:[:entry | entry pathName].
+ l := l , otherObjectNames.
+ handles := handles , otherObjects.
+ ].
+
+ list1 list:l.
+ unloadButton disable.
+ unloadAndRemoveButton disable.
+ ].
showBuiltIn onChangeSend:#value to:moduleListUpdater.
showModules onChangeSend:#value to:moduleListUpdater.
@@ -770,133 +777,133 @@
listView1 model:list1.
listView1 origin:0.0@0.0 corner:1.0@0.4. "/ ; inset:2.
listView1 action:[:sel |
- |info classNames tabs module|
-
- listView1 middleButtonMenu:nil.
-
- box withWaitCursorDo:[
- |nm fileName addr entry1 entry2 entry3 method|
-
- tabs := TabulatorSpecification unit:#inch positions:#(0 2.6).
-
- (showModules value or:[showBuiltIn value]) ifTrue:[
- info := allModules at:sel ifAbsent:nil.
- ].
- info isNil ifTrue:[
- "/ selected a method, cObject or unknown
-
- module := handles at:sel.
- fileName := module pathName.
-
- module isMethodHandle ifTrue:[
-
- (method := module method) isNil ifTrue:[
- nm := '** removed **'.
- ] ifFalse:[
- menu := PopUpMenu
- labels:#('inspect' 'browse')
- selectors:#(inspect browse).
- menu actionAt:#inspect put:[ method inspect ].
- menu actionAt:#browse put:[ |who|
- who := method who.
- SystemBrowser
- openInClass:(who methodClass)
- selector:(who methodSelector)
- ].
- listView1 middleButtonMenu:menu.
-
- nm := (method whoString) asText emphasizeAllWith:(#color->Color blue).
- ].
- entry1 := MultiColListEntry new:2 tabulatorSpecification:tabs.
- entry1 colAt:1 put:'compiled method'; colAt:2 put:nm.
-
- entry2 := MultiColListEntry new:2 tabulatorSpecification:tabs.
- entry2 colAt:1 put:'path'; colAt:2 put:fileName.
-
- entry3 := MultiColListEntry new:2 tabulatorSpecification:tabs.
- entry3 colAt:1 put:'address'; colAt:2 put:('(16r) ' , (method code hexPrintString leftPaddedTo:8 with:$0)).
-
- list2 list:(Array with:entry1 with:entry2 with:entry3).
- ] ifFalse:[
- (module isFunctionObjectHandle
- and:[module functions notEmpty]) ifTrue:[
-
- menu := PopUpMenu
- labels:#('inspect')
- selectors:#(inspect).
- menu actionAt:#inspect put:[ module functions inspect ].
- listView1 middleButtonMenu:menu.
-
- list2 list:((module functions select:[:f | f notNil])
- collect:[:f | |entry|
- entry := MultiColListEntry new:2 tabulatorSpecification:tabs.
- entry colAt:1 put:(f name asText emphasizeAllWith:(#color->Color blue)).
- entry colAt:2 put:('address: (16r) ' , (f code hexPrintString leftPaddedTo:8 with:$0)).
- entry
- ]).
- ] ifFalse:[
- list2 list:#('nothing known about contents (no functions have been extracted)').
- ]
- ].
-
- unloadButton enable.
- unloadAndRemoveButton disable.
- ] ifFalse:[
- "/ selected a package
-
- "/ fill bottom list with class-info
-
- classNames := info classNames asSortedCollection.
- classNames := classNames select:[:cName |
- |cls|
-
- cls := Smalltalk classNamed:cName.
- cls isNil ifTrue:[
- true "a removed class"
- ] ifFalse:[
- cls isPrivate not
- ].
- ].
-
- classNames := classNames collect:[:cName |
- |cls entry rev listEntry|
-
- listEntry := MultiColListEntry new:2 tabulatorSpecification:tabs.
- listEntry colAt:1 put:cName.
-
- cls := Smalltalk classNamed:cName.
- cls isNil ifTrue:[
- listEntry colAt:2 put:'(class removed)'.
- ] ifFalse:[
- rev := cls binaryRevision.
- rev notNil ifTrue:[
- cls isLoaded ifFalse:[
- entry := '(stub for: ' , rev.
- ] ifTrue:[
- entry :='(bin: ' , rev.
- ].
- cls revision ~= rev ifTrue:[
- entry := entry , ' / src: ' , cls revision
- ].
- listEntry colAt:2 put:entry , ')'
- ] ifFalse:[
- cls revision notNil ifTrue:[
- listEntry colAt:2 put:'(overloaded by: ' , cls revision , ')'
- ]
- ]
- ].
- listEntry
- ].
- list2 list:classNames.
- info dynamic ifTrue:[
- unloadButton enable.
- unloadAndRemoveButton enable.
- ] ifFalse:[
- unloadButton disable.
- unloadAndRemoveButton disable.
- ].
- ]
- ]
+ |info classNames tabs module|
+
+ listView1 middleButtonMenu:nil.
+
+ box withWaitCursorDo:[
+ |nm fileName addr entry1 entry2 entry3 method|
+
+ tabs := TabulatorSpecification unit:#inch positions:#(0 2.6).
+
+ (showModules value or:[showBuiltIn value]) ifTrue:[
+ info := allModules at:sel ifAbsent:nil.
+ ].
+ info isNil ifTrue:[
+ "/ selected a method, cObject or unknown
+
+ module := handles at:sel.
+ fileName := module pathName.
+
+ module isMethodHandle ifTrue:[
+
+ (method := module method) isNil ifTrue:[
+ nm := '** removed **'.
+ ] ifFalse:[
+ menu := PopUpMenu
+ labels:#('inspect' 'browse')
+ selectors:#(inspect browse).
+ menu actionAt:#inspect put:[ method inspect ].
+ menu actionAt:#browse put:[ |who|
+ who := method who.
+ SystemBrowser
+ openInClass:(who methodClass)
+ selector:(who methodSelector)
+ ].
+ listView1 middleButtonMenu:menu.
+
+ nm := (method whoString) asText emphasizeAllWith:(#color->Color blue).
+ ].
+ entry1 := MultiColListEntry new:2 tabulatorSpecification:tabs.
+ entry1 colAt:1 put:'compiled method'; colAt:2 put:nm.
+
+ entry2 := MultiColListEntry new:2 tabulatorSpecification:tabs.
+ entry2 colAt:1 put:'path'; colAt:2 put:fileName.
+
+ entry3 := MultiColListEntry new:2 tabulatorSpecification:tabs.
+ entry3 colAt:1 put:'address'; colAt:2 put:('(16r) ' , (method code hexPrintString leftPaddedTo:8 with:$0)).
+
+ list2 list:(Array with:entry1 with:entry2 with:entry3).
+ ] ifFalse:[
+ (module isFunctionObjectHandle
+ and:[module functions notEmpty]) ifTrue:[
+
+ menu := PopUpMenu
+ labels:#('inspect')
+ selectors:#(inspect).
+ menu actionAt:#inspect put:[ module functions inspect ].
+ listView1 middleButtonMenu:menu.
+
+ list2 list:((module functions select:[:f | f notNil])
+ collect:[:f | |entry|
+ entry := MultiColListEntry new:2 tabulatorSpecification:tabs.
+ entry colAt:1 put:(f name asText emphasizeAllWith:(#color->Color blue)).
+ entry colAt:2 put:('address: (16r) ' , (f code hexPrintString leftPaddedTo:8 with:$0)).
+ entry
+ ]).
+ ] ifFalse:[
+ list2 list:#('nothing known about contents (no functions have been extracted)').
+ ]
+ ].
+
+ unloadButton enable.
+ unloadAndRemoveButton disable.
+ ] ifFalse:[
+ "/ selected a package
+
+ "/ fill bottom list with class-info
+
+ classNames := info classNames asSortedCollection.
+ classNames := classNames select:[:cName |
+ |cls|
+
+ cls := Smalltalk classNamed:cName.
+ cls isNil ifTrue:[
+ true "a removed class"
+ ] ifFalse:[
+ cls isPrivate not
+ ].
+ ].
+
+ classNames := classNames collect:[:cName |
+ |cls entry rev listEntry|
+
+ listEntry := MultiColListEntry new:2 tabulatorSpecification:tabs.
+ listEntry colAt:1 put:cName.
+
+ cls := Smalltalk classNamed:cName.
+ cls isNil ifTrue:[
+ listEntry colAt:2 put:'(class removed)'.
+ ] ifFalse:[
+ rev := cls binaryRevision.
+ rev notNil ifTrue:[
+ cls isLoaded ifFalse:[
+ entry := '(stub for: ' , rev.
+ ] ifTrue:[
+ entry :='(bin: ' , rev.
+ ].
+ cls revision ~= rev ifTrue:[
+ entry := entry , ' / src: ' , cls revision
+ ].
+ listEntry colAt:2 put:entry , ')'
+ ] ifFalse:[
+ cls revision notNil ifTrue:[
+ listEntry colAt:2 put:'(overloaded by: ' , cls revision , ')'
+ ]
+ ]
+ ].
+ listEntry
+ ].
+ list2 list:classNames.
+ info dynamic ifTrue:[
+ unloadButton enable.
+ unloadAndRemoveButton enable.
+ ] ifFalse:[
+ unloadButton disable.
+ unloadAndRemoveButton disable.
+ ].
+ ]
+ ]
].
@@ -908,27 +915,27 @@
box makeTabable:check.
panel add:(check := CheckBox label:'classLibs' model:showModules).
canDoIt ifFalse:[
- check disable
+ check disable
] ifTrue:[
- box makeTabable:check.
+ box makeTabable:check.
].
panel add:(check := CheckBox label:'methods' model:showMethods).
canDoIt ifFalse:[
- check disable
+ check disable
] ifTrue:[
- box makeTabable:check.
+ box makeTabable:check.
].
panel add:(check := CheckBox label:'c-objects' model:showCObjects).
canDoIt ifFalse:[
- check disable
+ check disable
] ifTrue:[
- box makeTabable:check.
+ box makeTabable:check.
].
panel add:(check := CheckBox label:'others' model:showOthers).
canDoIt ifFalse:[
- check disable
+ check disable
] ifTrue:[
- box makeTabable:check.
+ box makeTabable:check.
].
panel horizontalLayout:#fitSpace.
@@ -955,56 +962,56 @@
unloadButton := Button label:(resources string:'unload').
unloadButton action:[
- self withWaitCursorDo:[
- box withWaitCursorDo:[
- |info idx pathName|
-
- idx := list1 selectionIndex.
- info := allModules at:idx ifAbsent:nil.
-
- list1 selectionIndex:nil.
-
- info isNil ifTrue:[
- "/ selected a method
- "/ idx := idx - allModules size.
- pathName := (handles at:idx) pathName.
-
- ] ifFalse:[
- "/ selected a package
- pathName := info pathName.
- ].
- ObjectFileLoader unloadObjectFile:pathName.
- moduleListUpdater value.
- unloadButton disable.
- ]
- ]
+ self withWaitCursorDo:[
+ box withWaitCursorDo:[
+ |info idx pathName|
+
+ idx := list1 selectionIndex.
+ info := allModules at:idx ifAbsent:nil.
+
+ list1 selectionIndex:nil.
+
+ info isNil ifTrue:[
+ "/ selected a method
+ "/ idx := idx - allModules size.
+ pathName := (handles at:idx) pathName.
+
+ ] ifFalse:[
+ "/ selected a package
+ pathName := info pathName.
+ ].
+ ObjectFileLoader unloadObjectFile:pathName.
+ moduleListUpdater value.
+ unloadButton disable.
+ ]
+ ]
].
unloadAndRemoveButton := Button label:(resources string:'remove classes & unload').
unloadAndRemoveButton action:[
- self withWaitCursorDo:[
- box withWaitCursorDo:[
- |info idx pathName|
-
- idx := list1 selectionIndex.
- info := allModules at:idx ifAbsent:nil.
-
- list1 selectionIndex:nil.
-
- info isNil ifTrue:[
- "/ selected a method
- "/ idx := idx - allModules size.
- pathName := (handles at:idx) pathName.
-
- ] ifFalse:[
- "/ selected a package
- pathName := info pathName.
- ].
- ObjectFileLoader unloadObjectFileAndRemoveClasses:pathName.
- moduleListUpdater value.
- unloadAndRemoveButton disable.
- ]
- ]
+ self withWaitCursorDo:[
+ box withWaitCursorDo:[
+ |info idx pathName|
+
+ idx := list1 selectionIndex.
+ info := allModules at:idx ifAbsent:nil.
+
+ list1 selectionIndex:nil.
+
+ info isNil ifTrue:[
+ "/ selected a method
+ "/ idx := idx - allModules size.
+ pathName := (handles at:idx) pathName.
+
+ ] ifFalse:[
+ "/ selected a package
+ pathName := info pathName.
+ ].
+ ObjectFileLoader unloadObjectFileAndRemoveClasses:pathName.
+ moduleListUpdater value.
+ unloadAndRemoveButton disable.
+ ]
+ ]
].
moduleListUpdater value.
@@ -1034,24 +1041,24 @@
|fileName|
fileName := DialogBox
- request:(resources at:'filename for image:') withCRs
- initialAnswer:(ObjectMemory nameForSnapshot)
- okLabel:(resources at:'save')
- title:(resources string:'save image')
- onCancel:nil.
+ request:(resources at:'filename for image:') withCRs
+ initialAnswer:(ObjectMemory nameForSnapshot)
+ okLabel:(resources at:'save')
+ title:(resources string:'save image')
+ onCancel:nil.
fileName notNil ifTrue:[
- self showCursor:Cursor write.
- [
- (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)').
- ]
- ] valueNowOrOnUnwindDo:[
- self restoreCursors.
- ].
+ self showCursor:Cursor write.
+ [
+ (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)').
+ ]
+ ] valueNowOrOnUnwindDo:[
+ self restoreCursors.
+ ].
].
"Modified: 8.1.1997 / 14:50:29 / cg"
@@ -1063,41 +1070,41 @@
|fileName ok|
fileName := DialogBox
- request:(resources at:'filename for image:') withCRs
- initialAnswer:(ObjectMemory nameForSnapshot)
- okLabel:(resources at:'save & exit')
- title:(resources string:'save image & exit')
- onCancel:nil.
+ request:(resources at:'filename for image:') withCRs
+ initialAnswer:(ObjectMemory nameForSnapshot)
+ okLabel:(resources at:'save & exit')
+ title:(resources string:'save image & exit')
+ onCancel:nil.
fileName notNil ifTrue:[
- self showCursor:Cursor write.
- [
- ok := ObjectMemory snapShotOn:fileName.
- ] valueNowOrOnUnwindDo:[
- self restoreCursors.
- ].
-
- ok 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 showCursor:Cursor write.
+ [
+ ok := ObjectMemory snapShotOn:fileName.
+ ] valueNowOrOnUnwindDo:[
+ self restoreCursors.
+ ].
+
+ ok 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.
+ self saveAllViews.
"
- Smalltalk exit
- ]
+ Smalltalk exit
+ ]
].
"Modified: 8.1.1997 / 14:50:36 / cg"
@@ -1153,7 +1160,7 @@
"creates a new project & opens a projectView for it"
Project notNil ifTrue:[
- (ProjectView for:(Project new)) open
+ (ProjectView for:(Project new)) open
]
"Modified: 8.1.1997 / 14:52:07 / cg"
@@ -1165,23 +1172,23 @@
|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.
- box destroy
+ 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.
+ box destroy
]
"Modified: 8.1.1997 / 14:52:20 / cg"
@@ -1192,6 +1199,3856 @@
compilerSettings
"open a dialog on compiler related settings"
+ SettingsDialogs compilerSettingsFor:self.
+
+"/ |box warnings warnSTX warnUnderscore warnDollar warnOldStyle
+"/ allowDollar allowUnderscore immutableArrays
+"/ warnSTXBox warnUnderscoreBox warnOldStyleBox warnCommonMistakes warnCommonMistakesBox
+"/ warnCompatibility warnCompatibilityBox warnDollarBox
+"/ stcCompilation compilationList stcCompilationOptions stcIncludes stcDefines stcOptions
+"/ stcLibraries stcLibraryPath cc ccOptions historyLines fullHistoryUpdate catchRedefs keepSourceOptions keepSource
+"/ constantFoldingOptions constantFolding justInTimeCompilation
+"/ warnEnabler check component oldIndent t supportsJustInTimeCompilation y
+"/ y2 fullDebugSupport yMax
+"/ compileLazy loadBinaries canLoadBinaries strings idx thisIsADemoVersion|
+"/
+"/ canLoadBinaries := ObjectFileLoader notNil and:[ObjectFileLoader canLoadObjectFiles].
+"/ loadBinaries := Smalltalk loadBinaries asValue.
+"/ compileLazy := Autoload compileLazy asValue.
+"/
+"/ warnings := Compiler warnings asValue.
+"/
+"/ warnSTX := Compiler warnSTXSpecials asValue.
+"/ warnUnderscore := Compiler warnUnderscoreInIdentifier asValue.
+"/ warnDollar := Compiler warnDollarInIdentifier asValue.
+"/ warnOldStyle := Compiler warnOldStyleAssignment asValue.
+"/ warnCommonMistakes := Compiler warnCommonMistakes asValue.
+"/ warnCompatibility := Compiler warnPossibleIncompatibilities asValue.
+"/ allowUnderscore := Compiler allowUnderscoreInIdentifier asValue.
+"/ allowDollar := Compiler allowDollarInIdentifier asValue.
+"/ immutableArrays := Compiler arraysAreImmutable asValue.
+"/
+"/ constantFoldingOptions := #( nil #level1 #level2 #full ).
+"/ constantFolding := SelectionInList new list:(resources array:#('disabled' 'level1 (always safe)' 'level2 (usually safe)' 'full')).
+"/ constantFolding selectionIndex:3.
+"/
+"/ thisIsADemoVersion := (Smalltalk releaseIdentification = 'ST/X_free_demo_vsn').
+"/ thisIsADemoVersion ifTrue:[
+"/ stcCompilationOptions := #( never).
+"/ strings := #('never').
+"/ idx := 1.
+"/ ] ifFalse:[
+"/ stcCompilationOptions := #( always default never).
+"/ strings := #('always' 'primitive code only' 'never').
+"/ idx := 2.
+"/ ].
+"/
+"/ stcCompilation := SelectionInList new list:(resources array:strings).
+"/ stcCompilation selectionIndex:idx.
+"/ (supportsJustInTimeCompilation := ObjectMemory supportsJustInTimeCompilation)
+"/ ifTrue:[
+"/ justInTimeCompilation := ObjectMemory justInTimeCompilation:nil.
+"/ fullDebugSupport := ObjectMemory fullSingleStepSupport:nil.
+"/ ] ifFalse:[
+"/ justInTimeCompilation := false.
+"/ fullDebugSupport := (Compiler lineNumberInfo == #full) asValue.
+"/ ].
+"/ justInTimeCompilation := justInTimeCompilation asValue.
+"/ fullDebugSupport := fullDebugSupport asValue.
+"/
+"/ stcIncludes := Compiler stcCompilationIncludes asValue.
+"/ stcDefines := Compiler stcCompilationDefines asValue.
+"/ stcOptions := Compiler stcCompilationOptions asValue.
+"/ ccOptions := Compiler ccCompilationOptions asValue.
+"/ cc := Compiler ccPath asValue.
+"/
+"/ ObjectFileLoader notNil ifTrue:[
+"/ (t := ObjectFileLoader searchedLibraries) notNil ifTrue:[
+"/ stcLibraries := (String fromStringCollection:t separatedBy:' ') asValue.
+"/ ].
+"/ (t := ObjectFileLoader libPath) notNil ifTrue:[
+"/ stcLibraryPath := t asValue.
+"/ ]
+"/ ].
+"/
+"/ catchRedefs := Class catchMethodRedefinitions asValue.
+"/ historyLines := HistoryManager notNil and:[HistoryManager isLoaded and:[HistoryManager isActive]].
+"/ historyLines ifFalse:[
+"/ fullHistoryUpdate := false
+"/ ] ifTrue:[
+"/ fullHistoryUpdate := HistoryManager fullHistoryUpdate asValue.
+"/ ].
+"/ historyLines := historyLines asValue.
+"/
+"/ keepSourceOptions := #( keep reference absReference sourceReference discard ).
+"/ keepSource := SelectionInList new list:(resources array:#('keep as string' 'reference to filename' 'reference to full path' 'append and ref in `st.src''' 'discard' )).
+"/ keepSource selectionIndex:1.
+"/
+"/ warnEnabler := [
+"/ warnings value ifTrue:[
+"/ warnSTXBox enable.
+"/ warnOldStyleBox enable.
+"/ warnCommonMistakesBox enable.
+"/ warnCompatibilityBox enable.
+"/ allowUnderscore value ifTrue:[
+"/ warnUnderscoreBox enable.
+"/ ] ifFalse:[
+"/ warnUnderscoreBox disable.
+"/ ].
+"/ allowDollar value ifTrue:[
+"/ warnDollarBox enable.
+"/ ] ifFalse:[
+"/ warnDollarBox disable.
+"/ ].
+"/ ] ifFalse:[
+"/ warnSTXBox disable.
+"/ warnUnderscoreBox disable.
+"/ warnDollarBox disable.
+"/ warnOldStyleBox disable.
+"/ warnCommonMistakesBox disable.
+"/ warnCompatibilityBox disable.
+"/ ]].
+"/
+"/ warnings onChangeSend:#value to:warnEnabler.
+"/ allowUnderscore onChangeSend:#value to:warnEnabler.
+"/ allowDollar onChangeSend:#value to:warnEnabler.
+"/
+"/ box := DialogBox new.
+"/ box label:(resources string:'Compiler settings').
+"/
+"/ box addCheckBox:(resources string:'catch method redefinitions') on:catchRedefs.
+"/ y := box yPosition.
+"/ check := box addCheckBox:(resources string:'keep history line in methods') on:historyLines.
+"/ HistoryManager isNil ifTrue:[check disable].
+"/ box yPosition:y.
+"/ check := box addCheckBox:(resources string:'keep full class history') on:fullHistoryUpdate.
+"/ check left:0.5.
+"/ HistoryManager isNil ifTrue:[check disable] ifFalse:[check enableChannel:historyLines].
+"/
+"/ box addPopUpList:(resources string:'fileIn source mode:') on:keepSource.
+"/ keepSource selectionIndex:( keepSourceOptions indexOf:(ClassCategoryReader sourceMode) ifAbsent:1).
+"/
+"/ box addHorizontalLine.
+"/
+"/ box addCheckBox:(resources string:'lazy compilation when autoloading') on:compileLazy.
+"/ check := box addCheckBox:(resources string:'if present, load binary objects when autoloading') on:loadBinaries.
+"/ canLoadBinaries ifFalse:[
+"/ loadBinaries value:false.
+"/ check disable
+"/ ].
+"/ supportsJustInTimeCompilation ifTrue:[
+"/ component := box
+"/ addCheckBox:(resources string:'just in time compilation to machine code')
+"/ on:justInTimeCompilation.
+"/ ].
+"/
+"/ box addHorizontalLine.
+"/
+"/ ObjectFileLoader notNil ifTrue:[
+"/ compilationList := box addPopUpList:(resources string:'stc compilation to machine code') on:stcCompilation.
+"/
+"/ thisIsADemoVersion ifFalse:[
+"/ stcCompilation selectionIndex:( stcCompilationOptions indexOf:(Compiler stcCompilation) ifAbsent:2).
+"/
+"/ component := box
+"/ addLabelledInputField:(resources string:'include directories:')
+"/ adjust:#right
+"/ on:stcIncludes
+"/ tabable:true
+"/ separateAtX:0.3.
+"/ component immediateAccept:true; acceptOnLeave:false; cursorMovementWhenUpdating:#beginOfLine.
+"/ component preferredExtent:(250 @ component preferredExtent y).
+"/ canLoadBinaries ifFalse:[component disable].
+"/
+"/"/ box addVerticalSpace.
+"/
+"/ component := box
+"/ addLabelledInputField:(resources string:'defines:')
+"/ adjust:#right
+"/ on:stcDefines
+"/ tabable:true
+"/ separateAtX:0.3.
+"/ component immediateAccept:true; acceptOnLeave:false; cursorMovementWhenUpdating:#beginOfLine.
+"/ component preferredExtent:(250 @ component preferredExtent y).
+"/ canLoadBinaries ifFalse:[component disable].
+"/
+"/"/ box addVerticalSpace.
+"/
+"/ component := box
+"/ addLabelledInputField:(resources string:'stc options:')
+"/ adjust:#right
+"/ on:stcOptions
+"/ tabable:true
+"/ separateAtX:0.3.
+"/ component immediateAccept:true; acceptOnLeave:false; cursorMovementWhenUpdating:#beginOfLine.
+"/ component preferredExtent:(250 @ component preferredExtent y).
+"/ canLoadBinaries ifFalse:[component disable].
+"/
+"/"/ box addVerticalSpace.
+"/
+"/ component := box
+"/ addLabelledInputField:(resources string:'cc command:')
+"/ adjust:#right
+"/ on:cc
+"/ tabable:true
+"/ separateAtX:0.3.
+"/ component immediateAccept:true; acceptOnLeave:false; cursorMovementWhenUpdating:#beginOfLine.
+"/ component preferredExtent:(250 @ component preferredExtent y).
+"/ canLoadBinaries ifFalse:[component disable].
+"/
+"/ component := box
+"/ addLabelledInputField:(resources string:'cc options:')
+"/ adjust:#right
+"/ on:ccOptions
+"/ tabable:true
+"/ separateAtX:0.3.
+"/ component immediateAccept:true; acceptOnLeave:false; cursorMovementWhenUpdating:#beginOfLine.
+"/ component preferredExtent:(250 @ component preferredExtent y).
+"/ canLoadBinaries ifFalse:[component disable].
+"/
+"/ stcLibraries notNil ifTrue:[
+"/"/ box addVerticalSpace.
+"/
+"/ component := box
+"/ addLabelledInputField:(resources string:'C-libraries:')
+"/ adjust:#right
+"/ on:stcLibraries
+"/ tabable:true
+"/ separateAtX:0.3.
+"/ component immediateAccept:true; acceptOnLeave:false; cursorMovementWhenUpdating:#beginOfLine.
+"/ component preferredExtent:(250 @ component preferredExtent y).
+"/ canLoadBinaries ifFalse:[component disable].
+"/ ].
+"/
+"/ stcLibraryPath notNil ifTrue:[
+"/"/ box addVerticalSpace.
+"/
+"/ component := box
+"/ addLabelledInputField:(resources string:'stc libPath:')
+"/ adjust:#right
+"/ on:stcLibraryPath
+"/ tabable:true
+"/ separateAtX:0.3.
+"/ component immediateAccept:true; acceptOnLeave:false; cursorMovementWhenUpdating:#beginOfLine.
+"/ component preferredExtent:(250 @ component preferredExtent y).
+"/ canLoadBinaries ifFalse:[component disable].
+"/ ].
+"/ ].
+"/
+"/"/ box addVerticalSpace.
+"/ box addHorizontalLine.
+"/
+"/ "/ if there is no compiler around,
+"/ "/ change to compile nothing, and disable the checkBoxes
+"/ Compiler canCreateMachineCode ifFalse:[
+"/ stcCompilation selectionIndex:(3 min:stcCompilationOptions size).
+"/ compilationList disable.
+"/ ].
+"/ ].
+"/
+"/ y := box yPosition.
+"/
+"/ component := box addCheckBox:(resources string:'allow underscore in identifiers') on:allowUnderscore.
+"/ component width:0.4.
+"/
+"/ component := box addCheckBox:(resources string:'allow dollar in identifiers') on:allowDollar.
+"/ component width:0.4.
+"/
+"/ component := box addCheckBox:(resources string:'literal arrays are immutable') on:immutableArrays.
+"/ component width:0.4.
+"/ y2 := box yPosition.
+"/
+"/ box yPosition:y.
+"/ box leftIndent:0.
+"/
+"/ component :=box addPopUpList:(resources string:'constant folding:') on:constantFolding.
+"/ component superView left:0.5; width:0.5.
+"/ constantFolding selectionIndex:( constantFoldingOptions indexOf:(Compiler foldConstants) ifAbsent:1).
+"/
+"/ component := box addCheckBox:(resources string:'full debug info') on:fullDebugSupport.
+"/ component left:0.5; width:0.4.
+"/ box yPosition:(box yPosition max:y2).
+"/
+"/
+"/ box addHorizontalLine.
+"/
+"/ box addCheckBox:(resources string:'warnings') on:warnings.
+"/"/ box addVerticalSpace.
+"/ oldIndent := box leftIndent.
+"/ box leftIndent:30.
+"/
+"/ y := box yPosition.
+"/
+"/ warnSTXBox := box addCheckBox:(resources string:'ST/X extensions') on:warnSTX.
+"/ warnSTXBox width:0.4.
+"/
+"/ warnUnderscoreBox := box addCheckBox:(resources string:'underscores in identifiers') on:warnUnderscore.
+"/ warnUnderscoreBox width:0.4.
+"/
+"/ warnDollarBox := box addCheckBox:(resources string:'dollars in identifiers') on:warnDollar.
+"/ warnDollarBox width:0.4.
+"/
+"/ yMax := box yPosition.
+"/
+"/ box yPosition:y.
+"/ box leftIndent:0.
+"/ warnOldStyleBox := box addCheckBox:(resources string:'oldStyle assignment') on:warnOldStyle.
+"/ warnOldStyleBox left:0.5; width:0.4.
+"/
+"/ warnCommonMistakesBox := box addCheckBox:(resources string:'common mistakes') on:warnCommonMistakes.
+"/ warnCommonMistakesBox left:0.5; width:0.4.
+"/
+"/ warnCompatibilityBox := box addCheckBox:(resources string:'possible incompatibilities') on:warnCompatibility.
+"/ warnCompatibilityBox left:0.5; width:0.4.
+"/
+"/ box leftIndent:oldIndent.
+"/ box yPosition:(yMax max: box yPosition).
+"/
+"/ box
+"/ addHelpButtonFor:'Launcher/compilerSettings.html';
+"/ addAbortButton;
+"/ addOkButton.
+"/
+"/ warnEnabler value.
+"/ box open.
+"/
+"/ box accepted ifTrue:[
+"/ HistoryManager notNil ifTrue:[
+"/ HistoryManager fullHistoryUpdate:fullHistoryUpdate value.
+"/ historyLines value ifTrue:[
+"/ HistoryManager activate
+"/ ] ifFalse:[
+"/ HistoryManager deactivate
+"/ ].
+"/ ].
+"/ Class catchMethodRedefinitions:catchRedefs value.
+"/ ClassCategoryReader sourceMode:(keepSourceOptions at:keepSource selectionIndex).
+"/ Compiler warnings:warnings value.
+"/ Compiler warnSTXSpecials:warnSTX value.
+"/ Compiler warnOldStyleAssignment:warnOldStyle value.
+"/ Compiler warnUnderscoreInIdentifier:warnUnderscore value.
+"/ Compiler warnDollarInIdentifier:warnDollar value.
+"/ Compiler warnCommonMistakes:warnCommonMistakes value.
+"/ Compiler warnPossibleIncompatibilities:warnCompatibility value.
+"/ Compiler allowUnderscoreInIdentifier:allowUnderscore value.
+"/ Compiler allowDollarInIdentifier:allowDollar value.
+"/ Compiler arraysAreImmutable:immutableArrays value.
+"/ fullDebugSupport value ifTrue:[
+"/ Compiler lineNumberInfo:#full.
+"/ ] ifFalse:[
+"/ Compiler lineNumberInfo:true
+"/ ].
+"/
+"/ Compiler stcCompilation:(stcCompilationOptions at:stcCompilation selectionIndex).
+"/ thisIsADemoVersion ifFalse:[
+"/ Compiler stcCompilationIncludes:stcIncludes value.
+"/ Compiler stcCompilationDefines:stcDefines value.
+"/ Compiler stcCompilationOptions:stcOptions value.
+"/ Compiler ccCompilationOptions:ccOptions value.
+"/ Compiler ccPath:cc value.
+"/ ].
+"/ Compiler foldConstants:(constantFoldingOptions at:constantFolding selectionIndex).
+"/
+"/ supportsJustInTimeCompilation ifTrue:[
+"/ justInTimeCompilation value ifTrue:[
+"/ Method allInstancesDo:[:m | m checked:false].
+"/ ].
+"/ ObjectMemory justInTimeCompilation:justInTimeCompilation value.
+"/ ObjectMemory fullSingleStepSupport:fullDebugSupport value.
+"/ ].
+"/ ObjectFileLoader notNil ifTrue:[
+"/ stcLibraries notNil ifTrue:[
+"/ ObjectFileLoader searchedLibraries:(stcLibraries value asCollectionOfWords).
+"/ ].
+"/ stcLibraryPath notNil ifTrue:[
+"/ ObjectFileLoader libPath:(stcLibraryPath value).
+"/ ]
+"/ ].
+"/ Autoload compileLazy:compileLazy value.
+"/ Smalltalk loadBinaries:loadBinaries value.
+"/ ].
+"/ box destroy
+"/
+"/ "Modified: / 10.9.1995 / 19:19:18 / claus"
+"/ "Modified: / 9.9.1996 / 22:42:47 / stefan"
+"/ "Modified: / 23.4.1998 / 14:28:50 / cg"
+!
+
+displaySettings
+ "open a dialog on display related settings"
+
+ SettingsDialogs displaySettingsFor:self.
+
+"/ |box listOfSizes sizeInfos
+"/ sizes sizeNames sizeList sizeX sizeY deepIcons
+"/ isColorMonitor useFixPalette useFixGrayPalette idx ditherStyles ditherSyms ditherList
+"/ y component screen visual clipEncodings clipEncodingSyms clipEncodingList|
+"/
+"/ listOfSizes := resources at:'LIST_OF_OFFERED_SCREEN_SIZES' default:#default.
+"/ listOfSizes == #default ifTrue:[
+"/ "/ nothing in resource file; offer at least some.
+"/ sizeInfos := #(
+"/ ( '11.3'' (235mm x 175mm) LCD' (235 175) )
+"/ ( '17'' (325mm x 245mm)' (325 245) )
+"/ ( '19'' (340mm x 270mm)' (340 270) )
+"/ ( '20'' (350mm x 280mm)' (350 280) )
+"/ ( '21'' (365mm x 285mm)' (365 285) )
+"/ ).
+"/ ] ifFalse:[
+"/ sizeInfos := resources array:listOfSizes.
+"/ ].
+"/ sizeNames := sizeInfos collect:[:entry | entry at:1].
+"/ sizes := sizeInfos collect:[:entry | entry at:2].
+"/
+"/ screen := Screen current.
+"/ visual := screen visualType.
+"/
+"/ isColorMonitor := screen hasColors asValue.
+"/ deepIcons := screen supportsDeepIcons asValue.
+"/ useFixPalette := screen fixColors notNil asValue.
+"/ useFixGrayPalette := screen fixGrayColors notNil asValue.
+"/
+"/ sizeList := SelectionInList with:sizeNames.
+"/ sizeX := screen widthInMillimeter asValue.
+"/ sizeY := screen heightInMillimeter asValue.
+"/
+"/ clipEncodingSyms := #(nil #iso8859 #jis #jis7 #sjis #euc #big5).
+"/ clipEncodings := resources array:#('untranslated' 'iso8859' 'jis' 'jis7' 'shift-JIS' 'EUC' 'big5').
+"/ clipEncodingList := SelectionInList new.
+"/ clipEncodingList list:clipEncodings.
+"/ clipEncodingList selectionIndex:(clipEncodingSyms indexOf:screen clipBoardEncoding ifAbsent:1).
+"/
+"/ ditherList := SelectionInList new.
+"/
+"/ (visual == #StaticGray or:[visual == #GrayScale]) ifTrue:[
+"/ ditherStyles := #('threshold' 'ordered dither' 'error diffusion').
+"/ ditherSyms := #(threshold ordered floydSteinberg).
+"/ ] ifFalse:[
+"/ visual ~~ #TrueColor ifTrue:[
+"/ ditherStyles := #('nearest color' 'error diffusion').
+"/ ditherSyms := #(ordered floydSteinberg).
+"/ ]
+"/ ].
+"/ ditherSyms notNil ifTrue:[
+"/ ditherList list:ditherStyles.
+"/ ditherList selectionIndex:(ditherSyms indexOf:(Image ditherAlgorithm) ifAbsent:#threshold).
+"/ ].
+"/
+"/ box := DialogBox new.
+"/ box label:(resources string:'Display screen settings').
+"/
+"/ (box addTextLabel:(resources string:'Actual visible screen area:'))
+"/ adjust:#left.
+"/
+"/ (box addPopUpList:(resources string:'common sizes:') on:sizeList)
+"/ label:'monitor size'.
+"/
+"/ idx := sizes findFirst:[:entry |
+"/ ((entry at:1) = sizeX value)
+"/ and:[((entry at:2) = sizeY value)]
+"/ ].
+"/ idx ~~ 0 ifTrue:[
+"/ sizeList selectionIndex:idx
+"/ ].
+"/
+"/ sizeList onChangeSend:#value to:[
+"/ |idx|
+"/
+"/ idx := sizeList selectionIndex.
+"/ sizeX value:((sizes at:idx) at:1).
+"/ sizeY value:((sizes at:idx) at:2).
+"/ ].
+"/
+"/ y := box yPosition.
+"/ component := box addTextLabel:(resources string:'screen size:').
+"/ component width:0.3; adjust:#right; borderWidth:0.
+"/
+"/ box yPosition:y.
+"/ component := box addInputFieldOn:nil tabable:true.
+"/ component width:0.25; left:0.3;
+"/ immediateAccept:false; acceptOnLeave:false;
+"/ cursorMovementWhenUpdating:#beginOfLine;
+"/ converter:(PrintConverter new initForInteger);
+"/ model:sizeX.
+"/
+"/ box yPosition:y.
+"/ component := box addTextLabel:(' x ').
+"/ component width:0.1; left:0.55; adjust:#center; borderWidth:0.
+"/
+"/ box yPosition:y.
+"/ component := box addInputFieldOn:nil tabable:true.
+"/ component width:0.25; left:0.65;
+"/ immediateAccept:false; acceptOnLeave:false;
+"/ cursorMovementWhenUpdating:#beginOfLine;
+"/ converter:(PrintConverter new initForInteger);
+"/ model:sizeY.
+"/
+"/ box yPosition:y.
+"/ component := box addTextLabel:('(mm)').
+"/ component width:0.1; left:0.9; adjust:#center; borderWidth:0.
+"/
+"/ box addVerticalSpace; addHorizontalLine; addVerticalSpace.
+"/
+"/ (box addTextLabel:(resources string:'Screen: depth: %1 visual: %2 (%3)'
+"/ with:Screen current depth printString
+"/ with:Screen current visualType
+"/ with:Screen current serverVendor))
+"/ adjust:#left.
+"/
+"/ box addVerticalSpace; addHorizontalLine; addVerticalSpace.
+"/
+"/ box addCheckBox:(resources string:'color monitor') on:isColorMonitor.
+"/
+"/ visual == #PseudoColor ifTrue:[
+"/ box addVerticalSpace.
+"/ component := box addCheckBox:(resources string:'use fix color palette %1' with:'(4x8x4)') on:useFixPalette.
+"/
+"/ box addVerticalSpace.
+"/ component := box addCheckBox:(resources string:'use fix gray color palette %1' with:'(32)') on:useFixGrayPalette.
+"/ ].
+"/
+"/ ditherSyms notNil ifTrue:[
+"/ box addVerticalSpace.
+"/ component := box addPopUpList:(resources string:'image display:') on:ditherList.
+"/ component defaultLabel:'image display'.
+"/ component superView horizontalLayout:#leftSpace.
+"/ ].
+"/
+"/ box addVerticalSpace.
+"/ box addCheckBox:(resources string:'allow colored/grayscale icons') on:deepIcons.
+"/
+"/ box addVerticalSpace; addHorizontalLine; addVerticalSpace.
+"/
+"/ component := box addPopUpList:(resources string:'clipBoard encoding:') on:clipEncodingList.
+"/ component superView horizontalLayout:#leftSpace.
+"/
+"/ box
+"/ addHelpButtonFor:'Launcher/screenSettings.html';
+"/ addAbortButton; addOkButton.
+"/ box open.
+"/
+"/ box accepted ifTrue:[
+"/ Image flushDeviceImages.
+"/
+"/ screen visualType == #PseudoColor ifTrue:[
+"/ useFixPalette value ifTrue:[
+"/ Color colorAllocationFailSignal handle:[:ex |
+"/ self warn:(resources string:'Could not allocate colors.').
+"/ ] do:[
+"/ Color getColorsRed:4 green:8 blue:4 on:screen
+"/ ]
+"/ ] ifFalse:[
+"/ screen releaseFixColors
+"/ ].
+"/
+"/ useFixGrayPalette value ifTrue:[
+"/ Color colorAllocationFailSignal handle:[:ex |
+"/ self warn:(resources string:'Could not allocate colors.').
+"/ ] do:[
+"/ Color getGrayColors:32 on:screen
+"/ ]
+"/ ] ifFalse:[
+"/ screen releaseFixGrayColors
+"/ ]
+"/ ].
+"/ screen hasColors:isColorMonitor value.
+"/ screen widthInMillimeter:sizeX value.
+"/ screen heightInMillimeter:sizeY value.
+"/
+"/ screen supportsDeepIcons:deepIcons value.
+"/ ditherSyms notNil ifTrue:[
+"/ Image ditherAlgorithm:(ditherSyms at:ditherList selectionIndex).
+"/ ].
+"/
+"/ self withWaitCursorDo:[
+"/ View defaultStyle:(View defaultStyle).
+"/ ].
+"/
+"/ screen clipBoardEncoding:(clipEncodingSyms at:clipEncodingList selectionIndex).
+"/ ].
+"/ box destroy
+"/
+"/ "Modified: 9.9.1996 / 22:43:04 / stefan"
+"/ "Modified: 21.7.1997 / 19:26:49 / cg"
+!
+
+fontSettings
+ "open a dialog on font related settings"
+
+ SettingsDialogs fontSettingsFor:self.
+
+"/ (self fontBoxForEncoding:nil) ifTrue:[
+"/ self reopenLauncher.
+"/ ]
+
+ "Created: 26.2.1996 / 22:52:51 / cg"
+ "Modified: 8.1.1997 / 14:52:49 / cg"
+!
+
+keyboardSetting
+ "open a dialog on keyboard related settings"
+
+ SettingsDialogs keyboardSettingsFor:self.
+
+"/ |mappings listOfRawKeys listOfFunctions
+"/ box l
+"/ list1 list2 listView1 listView2
+"/ frame 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 retractInterestsFor:selectionForwarder.
+"/ list2 selection:(mappings at:raw asSymbol) asString.
+"/ list2 onChangeSend:#showRawKey to:selectionForwarder.
+"/ ].
+"/ selectionForwarder respondTo:#showRawKey
+"/ with:[
+"/ |f raw|
+"/
+"/ f := list2 selection.
+"/ list1 retractInterestsFor: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 := [
+"/ |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:#value to:macroForwarder.
+"/
+"/ box := Dialog new.
+"/ box label:(resources string:'Keyboard mappings').
+"/
+"/ l := box addTextLabel:(resources string:'KEY_MSG') withCRs.
+"/ l adjust:#left; borderWidth:0.
+"/
+"/ frame := View new.
+"/ frame extent:300 @ 300.
+"/ frame borderWidth:0.
+"/
+"/ 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; borderWidth:0.
+"/ 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
+"/ addHelpButtonFor:'Launcher/keyboardSetting.html';
+"/ "addAbortButton;"
+"/ addOkButtonLabelled:(resources string:'dismiss').
+"/
+"/ macroTextView topInset:(l preferredExtent y + 5).
+"/ macroTextView bottomInset:(box preferredExtent y - y).
+"/
+"/ box open.
+"/
+"/ box accepted ifTrue:[
+"/ "no action yet ..."
+"/ ].
+"/ box destroy
+"/
+"/ "Modified: 9.9.1996 / 22:43:17 / stefan"
+"/ "Modified: 18.10.1997 / 03:39:41 / cg"
+!
+
+languageSetting
+ "open a dialog on language related settings"
+
+ SettingsDialogs languageSettingsFor:self.
+
+"/ |listOfLanguages translatedLanguages switch box languageList flags|
+"/
+"/ "
+"/ get list of supported languages from the launchers resources ...
+"/ "
+"/ listOfLanguages := resources at:'LIST_OF_OFFERED_LANGUAGES' default:#('default').
+"/ listOfLanguages := listOfLanguages asOrderedCollection.
+"/ translatedLanguages := listOfLanguages collect:[:lang | |item|
+"/ item := resources at:lang.
+"/ item isString ifTrue:[
+"/ item
+"/ ] ifFalse:[
+"/ item at:1
+"/ ]
+"/ ].
+"/ flags := listOfLanguages collect:[:lang | |item|
+"/ item := resources at:lang.
+"/ item isArray ifTrue:[
+"/ item at:2
+"/ ] ifFalse:[
+"/ nil
+"/ ]
+"/ ].
+"/ flags := flags collect:[:nm | nm notNil ifTrue:[Image fromFile:nm] ifFalse:[nil]].
+"/
+"/ languageList := translatedLanguages with:flags collect:[:lang :flag |
+"/ LabelAndIcon icon:flag string:lang.
+"/ ].
+"/
+"/ box := ListSelectionBox title:(resources string:'LANG_MSG') withCRs.
+"/ box label:(resources string:'Language selection').
+"/ box list:languageList.
+"/ box initialText:(Language).
+"/ box action:[:newLanguage |
+"/ self withWaitCursorDo:[
+"/ |fontPref idx language oldLanguage enc answer matchingFonts|
+"/
+"/ idx := translatedLanguages indexOf:newLanguage withoutSeparators.
+"/ idx ~~ 0 ifTrue:[
+"/ language := listOfLanguages at:idx
+"/ ] ifFalse:[
+"/ language := newLanguage
+"/ ].
+"/
+"/ "/ check if the new language needs a differently encoded font;
+"/ "/ ask user to switch font and allow cancellation.
+"/ "/ Otherwise, you are left with unreadable menu & button items ...
+"/
+"/ oldLanguage := Smalltalk language.
+"/ Smalltalk language:language asSymbol.
+"/ ResourcePack flushCachedResourcePacks.
+"/ fontPref := self class classResources at:'PREFERRED_FONT_ENCODING' default:'iso8859*'.
+"/ Smalltalk language:oldLanguage.
+"/
+"/ switch := true.
+"/ enc := MenuView defaultFont encoding.
+"/ (fontPref match:enc) ifFalse:[
+"/ "/ look if there is one at all.
+"/ matchingFonts := Screen current listOfAvailableFonts select:[:f | fontPref match:f encoding].
+"/ matchingFonts size == 0 ifTrue:[
+"/ (Dialog
+"/ confirm:(resources
+"/ string:'your display does not offer any %1-encoded font.\\Change the language anyway ?\ (texts will probably be unreadable then)'
+"/ with:fontPref) withCRs)
+"/ ifFalse:[
+"/ switch := false
+"/ ]
+"/ ] ifFalse:[
+"/ answer := Dialog
+"/ confirmWithCancel:(resources
+"/ string:'menu font is not %1-encoded.\\Change it ?'
+"/ with:fontPref) withCRs
+"/ labels:(resources
+"/ array:#('cancel' 'no' 'yes'))
+"/ default:3.
+"/ answer isNil ifTrue:[
+"/ switch := false
+"/ ] ifFalse:[
+"/ answer ifTrue:[
+"/ switch := (self fontBoxForEncoding:fontPref)
+"/ ]
+"/ ].
+"/ ].
+"/ ].
+"/
+"/ switch ifTrue:[
+"/ transcript showCR:'change language to ' , newLanguage , ' ...'.
+"/ Smalltalk language:language asSymbol.
+"/ ResourcePack flushCachedResourcePacks
+"/ ].
+"/ ].
+"/ switch ifTrue:[
+"/ self reopenLauncher.
+"/ DebugView newDebugger.
+"/ ]
+"/ ].
+"/ box
+"/ addHelpButtonFor:'Launcher/languageSetting.html'.
+"/ box open.
+"/ box destroy
+"/
+"/ "Modified: / 9.9.1996 / 22:43:27 / stefan"
+"/ "Modified: / 6.2.1998 / 00:00:38 / cg"
+!
+
+memorySettings
+ "open a dialog on objectMemory related settings"
+
+ SettingsDialogs memorySettingsFor:self.
+
+"/ |box igcLimit igcFreeLimit igcFreeAmount newSpaceSize
+"/ compressLimit
+"/ oldIncr component fields codeLimit codeTrigger stackLimit|
+"/
+"/ "/
+"/ "/ extract relevant system settings ...
+"/ "/
+"/ igcLimit := ObjectMemory incrementalGCLimit asValue.
+"/ igcFreeLimit := ObjectMemory freeSpaceGCLimit asValue.
+"/ igcFreeAmount := ObjectMemory freeSpaceGCAmount asValue.
+"/ newSpaceSize := ObjectMemory newSpaceSize asValue.
+"/ oldIncr := ObjectMemory oldSpaceIncrement asValue.
+"/ compressLimit := ObjectMemory oldSpaceCompressLimit asValue.
+"/ codeLimit := ObjectMemory dynamicCodeLimit asValue.
+"/ codeTrigger := ObjectMemory dynamicCodeGCTrigger asValue.
+"/ stackLimit := Process defaultMaximumStackSize asValue.
+"/
+"/ "/
+"/ "/ create a box on those values ...
+"/ "/
+"/ fields := OrderedCollection new.
+"/
+"/ box := DialogBox new.
+"/ box label:(resources string:'Memory manager settings').
+"/
+"/ (box addTextLabel:'Warning - invalid settings may result in failures or poor performance
+"/
+"/You have been warned.') adjust:#left.
+"/ box addHorizontalLine.
+"/
+"/ component := box
+"/ addLabelledInputField:(resources string:'size of newSpace:')
+"/ adjust:#right
+"/ on:nil "/ newSpaceSize
+"/ tabable:true
+"/ separateAtX:0.7.
+"/ component acceptOnLeave:false.
+"/ component converter:(PrintConverter new initForNumber).
+"/ component model:newSpaceSize.
+"/ fields add:component.
+"/
+"/ box addHorizontalLine.
+"/
+"/
+"/ component := box
+"/ addLabelledInputField:(resources string:'incremental GC allocation trigger:')
+"/ adjust:#right
+"/ on:nil "/ igcLimit
+"/ tabable:true
+"/ separateAtX:0.7.
+"/ component acceptOnLeave:false.
+"/ component converter:(PrintConverter new initForNumber).
+"/ component model:igcLimit.
+"/ fields add:component.
+"/
+"/ box addTextLabel:'(start IGC whenever this amount has been allocated)'.
+"/ box addHorizontalLine.
+"/
+"/ component := box
+"/ addLabelledInputField:(resources string:'incremental GC freespace trigger:')
+"/ adjust:#right
+"/ on:nil "/ igcFreeLimit
+"/ tabable:true
+"/ separateAtX:0.7.
+"/ component acceptOnLeave:false.
+"/ component converter:(PrintConverter new initForNumber).
+"/ component model:igcFreeLimit.
+"/ fields add:component.
+"/
+"/ box addTextLabel:'(start IGC whenever freespace drops below this)'.
+"/ box addHorizontalLine.
+"/
+"/ component := box
+"/ addLabelledInputField:(resources string:'incremental GC amount:')
+"/ adjust:#right
+"/ on:nil "/ igcFreeAmount
+"/ tabable:true
+"/ separateAtX:0.7.
+"/ component acceptOnLeave:false.
+"/ component converter:(PrintConverter new initForNumber).
+"/ component model:igcFreeAmount.
+"/ fields add:component.
+"/
+"/ box addTextLabel:'(try to keep this amount for peak requests)'.
+"/ box addHorizontalLine.
+"/
+"/ component := box
+"/ addLabelledInputField:(resources string:'oldspace increment:')
+"/ adjust:#right
+"/ on:nil "/ oldIncr
+"/ tabable:true
+"/ separateAtX:0.7.
+"/ component acceptOnLeave:false.
+"/ component converter:(PrintConverter new initForNumber).
+"/ component model:oldIncr.
+"/ fields add:component.
+"/
+"/ box addTextLabel:'(increase oldSpace in chunks of this size)'.
+"/ box addHorizontalLine.
+"/
+"/ component := box
+"/ addLabelledInputField:(resources string:'oldspace compress limit:')
+"/ adjust:#right
+"/ on:nil "/ compressLimit
+"/ tabable:true
+"/ separateAtX:0.7.
+"/ component acceptOnLeave:false.
+"/ component converter:(PrintConverter new initForNumber).
+"/ component model:compressLimit.
+"/ fields add:component.
+"/
+"/ box addTextLabel:'(suppress compressing GC if more memory is in use)'.
+"/ box addHorizontalLine.
+"/
+"/ component := box
+"/ addLabelledInputField:(resources string:'stack limit:')
+"/ adjust:#right
+"/ on:nil
+"/ tabable:true
+"/ separateAtX:0.7.
+"/ component acceptOnLeave:false.
+"/ component converter:(PrintConverter new initForNumber).
+"/ component model:stackLimit.
+"/ fields add:component.
+"/
+"/ box addTextLabel:'(trigger recursionInterrupt if more stack is used by a process)'.
+"/ box addHorizontalLine.
+"/
+"/ ObjectMemory supportsJustInTimeCompilation ifTrue:[
+"/ component := box
+"/ addLabelledInputField:(resources string:'dynamic code limit:')
+"/ adjust:#right
+"/ on:nil
+"/ tabable:true
+"/ separateAtX:0.7.
+"/ component acceptOnLeave:false.
+"/ component converter:(PrintConverter new initForNumberOrNil).
+"/ component model:codeLimit.
+"/ fields add:component.
+"/
+"/ box addTextLabel:'(flush dynamic compiled code to stay within this limit)'.
+"/ box addHorizontalLine.
+"/
+"/ component := box
+"/ addLabelledInputField:(resources string:'dynamic code GC trigger:')
+"/ adjust:#right
+"/ on:nil
+"/ tabable:true
+"/ separateAtX:0.7.
+"/ component acceptOnLeave:false.
+"/ component converter:(PrintConverter new initForNumberOrNil).
+"/ component model:codeTrigger.
+"/ fields add:component.
+"/
+"/ box addTextLabel:'(start incremental GC whenever this amount of code has been allocated)'.
+"/ box addHorizontalLine.
+"/ ].
+"/
+"/ box addAbortButton; addOkButton.
+"/ box
+"/ addHelpButtonFor:'Launcher/memorySettings.html'.
+"/
+"/ "/
+"/ "/ show the box ...
+"/ "/
+"/ box open.
+"/
+"/ "/
+"/ "/ update system settings
+"/ "/
+"/ box accepted ifTrue:[
+"/ fields do:[:comp | comp accept].
+"/
+"/ igcFreeAmount value ~~ ObjectMemory freeSpaceGCAmount ifTrue:[
+"/ ObjectMemory freeSpaceGCAmount:igcFreeAmount value.
+"/ ].
+"/ igcFreeLimit value ~~ ObjectMemory freeSpaceGCLimit ifTrue:[
+"/ ObjectMemory freeSpaceGCLimit:igcFreeLimit value.
+"/ ].
+"/ igcLimit value ~~ ObjectMemory incrementalGCLimit ifTrue:[
+"/ ObjectMemory incrementalGCLimit:igcLimit value.
+"/ ].
+"/ newSpaceSize value ~~ ObjectMemory newSpaceSize ifTrue:[
+"/ ObjectMemory newSpaceSize:newSpaceSize value.
+"/ ].
+"/ oldIncr value ~~ ObjectMemory oldSpaceIncrement ifTrue:[
+"/ ObjectMemory oldSpaceIncrement:oldIncr value.
+"/ ].
+"/ stackLimit value ~~ Process defaultMaximumStackSize ifTrue:[
+"/ Process defaultMaximumStackSize:stackLimit value.
+"/ ].
+"/ ObjectMemory oldSpaceCompressLimit:compressLimit value.
+"/ ObjectMemory dynamicCodeLimit:codeLimit value.
+"/ ObjectMemory dynamicCodeGCTrigger:codeTrigger value.
+"/ ].
+"/ box destroy
+"/
+"/ "Modified: 27.2.1997 / 16:50:12 / cg"
+!
+
+messageSettings
+ "open a dialog on infoMessage related settings"
+
+ SettingsDialogs messageSettingsFor:self.
+
+"/ |box vmInfo vmErrors displayErrors classInfos|
+"/
+"/ vmInfo := ObjectMemory infoPrinting asValue.
+"/ vmErrors := ObjectMemory debugPrinting asValue.
+"/ classInfos := Object infoPrinting asValue.
+"/ displayErrors := DeviceWorkstation errorPrinting asValue.
+"/
+"/ box := DialogBox new.
+"/ box label:(resources string:'Messages').
+"/
+"/ box addCheckBox:(resources string:'VM info messages') on:vmInfo.
+"/ box addCheckBox:(resources string:'VM error messages') on:vmErrors.
+"/ box addHorizontalLine.
+"/
+"/ box addCheckBox:(resources string:'Display error messages (Xlib, Xtlib ...)') on:displayErrors.
+"/ box addCheckBox:(resources string:'Other info messages') on:classInfos.
+"/
+"/ box addHelpButtonFor:'Launcher/messageSettings.html'.
+"/ box addAbortButton; addOkButton.
+"/ box open.
+"/
+"/ box accepted ifTrue:[
+"/ ObjectMemory infoPrinting:vmInfo value.
+"/ ObjectMemory debugPrinting:vmErrors value.
+"/ Object infoPrinting:classInfos value.
+"/ DeviceWorkstation errorPrinting:displayErrors value.
+"/ ].
+"/ box destroy
+"/
+"/ "Modified: 27.1.1997 / 17:46:01 / cg"
+!
+
+miscSettings
+ "open a dialog on misc other settings"
+
+ SettingsDialogs miscSettingsFor:self.
+
+"/ |box shadows takeFocus returnFocus
+"/ hostNameInLabel showAccelerators
+"/ preemptive hostNameInLabelHolder st80EditingMode|
+"/
+"/ "/
+"/ "/ extract relevant system settings ...
+"/ "/
+"/ shadows := PopUpView shadows asValue.
+"/ hostNameInLabel := StandardSystemView includeHostNameInLabel.
+"/ hostNameInLabelHolder := hostNameInLabel asValue.
+"/ returnFocus := StandardSystemView returnFocusWhenClosingModalBoxes asValue.
+"/ takeFocus := StandardSystemView takeFocusWhenMapped asValue.
+"/
+"/ showAccelerators := MenuView showAcceleratorKeys asValue.
+"/ preemptive := Processor isTimeSlicing asValue.
+"/
+"/ st80EditingMode := EditTextView st80Mode asValue.
+"/
+"/ "/
+"/ "/ create a box on those values ...
+"/ "/
+"/ box := DialogBox new.
+"/ box label:(resources string:'Other settings').
+"/
+"/ box addCheckBox:(resources string:'shadows under popup views') on:shadows.
+"/ box addCheckBox:(resources string:'boxes return focus to previously active view') on:returnFocus.
+"/ box addCheckBox:(resources string:'views catch focus when mapped') on:takeFocus.
+"/ box addCheckBox:(resources string:'hostname in window labels') on:hostNameInLabelHolder.
+"/ box addCheckBox:(resources string:'show accelerator keys in menus') on:showAccelerators.
+"/
+"/ box addHorizontalLine.
+"/
+"/ box addCheckBox:(resources string:'preemptive scheduling') on:preemptive.
+"/
+"/ box addHorizontalLine.
+"/
+"/ box addCheckBox:(resources string:'st80 cursor behavior in editTextView') on:st80EditingMode.
+"/
+"/ box
+"/ addHelpButtonFor:'Launcher/miscSettings.html';
+"/ addAbortButton;
+"/ addOkButton.
+"/
+"/ "/
+"/ "/ show the box ...
+"/ "/
+"/ box open.
+"/
+"/ "/
+"/ "/ update system settings
+"/ "/
+"/ box accepted ifTrue:[
+"/ PopUpView shadows:shadows value.
+"/ hostNameInLabelHolder value ~~ hostNameInLabel ifTrue:[
+"/ StandardSystemView includeHostNameInLabel:hostNameInLabelHolder value.
+"/
+"/ Screen allScreens do:[:aDisplay |
+"/ aDisplay allViewsDo:[:aView |
+"/ |l|
+"/
+"/ aView isTopView ifTrue:[
+"/ l := aView label.
+"/ aView label:(l , ' '); label:l. "/ force a change
+"/ ]
+"/ ]
+"/ ]
+"/ ].
+"/ StandardSystemView returnFocusWhenClosingModalBoxes:returnFocus value.
+"/ StandardSystemView takeFocusWhenMapped:takeFocus value.
+"/ MenuView showAcceleratorKeys:showAccelerators value.
+"/ Processor isTimeSlicing ~~ preemptive value ifTrue:[
+"/ preemptive value ifTrue:[
+"/ Processor startTimeSlicing
+"/ ] ifFalse:[
+"/ Processor stopTimeSlicing
+"/ ]
+"/ ].
+"/ EditTextView st80Mode:(st80EditingMode value)
+"/ ].
+"/ box destroy
+"/
+"/ "Modified: / 9.9.1996 / 22:43:36 / stefan"
+"/ "Modified: / 16.1.1998 / 22:56:57 / cg"
+!
+
+printerSettings
+ "open a dialog on printer related settings"
+
+ SettingsDialogs printerSettingsFor:self.
+
+"/ |box
+"/ possiblePrinters possibleTypes printerType printCommand
+"/ pageFormat landscape updater
+"/ formatLabel formatComponent landscapeLabel landscapeComponent
+"/ topMargin leftMargin rightMargin bottomMargin unitList unit
+"/ topMarginComponent leftMarginComponent
+"/ rightMarginComponent
+"/ bottomMarginComponent supportsColor supportsColorComponent
+"/ y y1 commandListPop component commandList row|
+"/
+"/ possiblePrinters := PrinterStream withAllSubclasses asArray.
+"/ possibleTypes := possiblePrinters collect:[:cls | cls printerTypeName].
+"/
+"/ printerType := SelectionInList new list:(resources array:possibleTypes).
+"/ printerType selectionIndex:(possiblePrinters identityIndexOf:Printer).
+"/ printCommand := Printer printCommand asValue.
+"/
+"/ pageFormat := SelectionInList new list:(Printer defaultPageFormats).
+"/ pageFormat selection:(Printer pageFormat).
+"/ landscape := Printer landscape asValue.
+"/
+"/ topMargin := Printer topMargin asValue.
+"/ leftMargin := Printer leftMargin asValue.
+"/ rightMargin := Printer rightMargin asValue.
+"/ bottomMargin := Printer bottomMargin asValue.
+"/ supportsColor := Printer supportsColor asValue.
+"/
+"/ box := DialogBox new.
+"/ box label:(resources string:'Printer settings').
+"/
+"/"/ either use a popUpList ...
+"/"/ box addPopUpList:(resources string:'printer type:') on:printerType.
+"/
+"/"/ or a comboList;
+"/"/ which one looks better ?
+"/ y := box yPosition.
+"/ component := box addTextLabel:(resources string:'printer type:').
+"/ component width:0.25; adjust:#right; borderWidth:0.
+"/ box yPosition:y.
+"/ component := box addComboListOn:printerType tabable:true.
+"/ component aspect:#selectionIndex; changeMessage:#selectionIndex:; useIndex:true.
+"/ component width:0.75; left:0.25.
+"/"/ end of question
+"/
+"/ y := box yPosition.
+"/ component := box addTextLabel:(resources string:'print command:').
+"/ component width:0.25; adjust:#right; borderWidth:0.
+"/ box yPosition:y.
+"/ commandListPop := box addComboBoxOn:printCommand tabable:true.
+"/"/ commandListPop := box addInputFieldOn:printCommand tabable:true.
+"/ commandListPop width:0.75; left:0.25; immediateAccept:true; acceptOnLeave:false; cursorMovementWhenUpdating:#beginOfLine.
+"/ "/ some common print commands ...
+"/
+"/ commandList := resources at:'PRINT_COMMANDS' ifAbsent:nil.
+"/ commandList isNil ifTrue:[
+"/ commandList := PrinterStream defaultCommands.
+"/ commandList isNil ifTrue:[
+"/ commandList := #('lpr'
+"/ 'lp'
+"/ ).
+"/ ]
+"/ ].
+"/
+"/ commandListPop list:commandList.
+"/
+"/ box addVerticalSpace; addHorizontalLine; addVerticalSpace.
+"/
+"/ row := OrderedCollection new.
+"/ row add:(formatLabel := Label label:(resources string:'page format:')).
+"/ formatLabel borderWidth:0.
+"/ row add:(formatComponent := PopUpList on:pageFormat).
+"/ formatComponent label:'unknown'.
+"/
+"/ row add:(landscapeLabel := Label label:(resources string:'landscape:')).
+"/ landscapeLabel borderWidth:0.
+"/ row add:(landscapeComponent := CheckToggle on:landscape).
+"/
+"/ y := box yPosition.
+"/ box
+"/ addRow:(1 to:2)
+"/ fromX:0
+"/ toX:0.5
+"/ collect:[:idx | row at:idx]
+"/ tabable:false
+"/ horizontalLayout:#leftSpace
+"/ verticalLayout:#center.
+"/ y1 := box yPosition.
+"/ box yPosition:y.
+"/
+"/ box
+"/ addRow:(3 to:4)
+"/ fromX:0.5
+"/ toX:1.0
+"/ collect:[:idx | row at:idx]
+"/ tabable:false
+"/ horizontalLayout:#leftSpace
+"/ verticalLayout:#center.
+"/
+"/ box yPosition:(box yPosition max:y1).
+"/
+"/ box makeTabable:(formatComponent).
+"/ box makeTabable:(landscapeComponent).
+"/
+"/ box addVerticalSpace; addHorizontalLine; addVerticalSpace.
+"/
+"/ y := box yPosition.
+"/
+"/ topMarginComponent := box
+"/ addLabelledInputField:(resources string:'top margin:')
+"/ adjust:#right
+"/ on:nil "/ topMargin
+"/ tabable:true
+"/ from:0.0 to:0.5
+"/ separateAtX:0.6.
+"/ topMarginComponent converter:(PrintConverter new initForNumber).
+"/ topMarginComponent model:topMargin.
+"/ y1 := box yPosition.
+"/
+"/ box yPosition:y.
+"/ unitList := SelectionInList with:#('inch' 'mm').
+"/ unitList selectionIndex:1.
+"/
+"/ component := box addComponent:(PopUpList on:unitList).
+"/ component
+"/ left:0.6;
+"/ width:0.3.
+"/
+"/ box yPosition:y1.
+"/
+"/ leftMarginComponent := box
+"/ addLabelledInputField:(resources string:'left margin:')
+"/ adjust:#right
+"/ on:nil "/ leftMargin
+"/ tabable:true
+"/ from:0.0 to:0.5
+"/ separateAtX:0.6.
+"/ leftMarginComponent converter:(PrintConverter new initForNumber).
+"/ leftMarginComponent model:leftMargin.
+"/
+"/ rightMarginComponent := box
+"/ addLabelledInputField:(resources string:'right margin:')
+"/ adjust:#right
+"/ on:nil "/ rightMargin
+"/ tabable:true
+"/ from:0.0 to:0.5
+"/ separateAtX:0.6.
+"/ rightMarginComponent converter:(PrintConverter new initForNumber).
+"/ rightMarginComponent model:rightMargin.
+"/
+"/ bottomMarginComponent := box
+"/ addLabelledInputField:(resources string:'bottom margin:')
+"/ adjust:#right
+"/ on:nil "/ bottomMargin
+"/ tabable:true
+"/ from:0.0 to:0.5
+"/ separateAtX:0.6.
+"/ bottomMarginComponent converter:(PrintConverter new initForNumber).
+"/ bottomMarginComponent model:bottomMargin.
+"/
+"/ box addHorizontalLine.
+"/ supportsColorComponent := box addCheckBox:(resources string:'Color printer') on:supportsColor.
+"/ box addVerticalSpace.
+"/
+"/ updater := [ |p fg hasPageSize hasMargins|
+"/
+"/ printerType selectionIndex ~~ 0 ifTrue:[
+"/ p := possiblePrinters at:(printerType selectionIndex).
+"/ hasPageSize := p supportsPageSizes.
+"/ hasMargins := p supportsMargins.
+"/ ] ifFalse:[
+"/ hasPageSize := false.
+"/ hasMargins := false.
+"/ ].
+"/ hasPageSize ifTrue:[
+"/ fg := Button new foregroundColor.
+"/ formatComponent enable.
+"/ landscapeComponent enable.
+"/
+"/ formatComponent label:p pageFormat.
+"/ pageFormat value:(p pageFormat).
+"/ landscape value:(p landscape).
+"/ ] ifFalse:[
+"/ fg := Button new disabledForegroundColor.
+"/ formatComponent disable.
+"/ landscapeComponent disable.
+"/
+"/ formatComponent label:'unknown'.
+"/ landscape value:nil.
+"/ ].
+"/ hasMargins ifTrue:[
+"/ unitList selectionIndex == 2 ifTrue:[
+"/ unit := #mm
+"/ ] ifFalse:[
+"/ unit := #inch
+"/ ].
+"/
+"/ topMargin value:(UnitConverter convert:p topMargin from:#inch to:unit).
+"/ leftMargin value:(UnitConverter convert:p leftMargin from:#inch to:unit).
+"/ rightMargin value:(UnitConverter convert:p rightMargin from:#inch to:unit).
+"/ bottomMargin value:(UnitConverter convert:p bottomMargin from:#inch to:unit).
+"/
+"/ topMarginComponent enable.
+"/ leftMarginComponent enable.
+"/ rightMarginComponent enable.
+"/ bottomMarginComponent enable.
+"/ ] ifFalse:[
+"/ topMarginComponent disable.
+"/ leftMarginComponent disable.
+"/ rightMarginComponent disable.
+"/ bottomMarginComponent disable.
+"/ ].
+"/ formatLabel foregroundColor:fg.
+"/ landscapeLabel foregroundColor:fg.
+"/
+"/ p notNil ifTrue:[
+"/ commandList := p defaultCommands.
+"/ commandList notNil ifTrue:[
+"/ commandListPop list:commandList
+"/ ].
+"/
+"/ printCommand value:(p printCommand).
+"/ ].
+"/ p supportsPostscript ifFalse:[
+"/ supportsColorComponent disable.
+"/ supportsColor value:false
+"/ ] ifTrue:[
+"/ supportsColorComponent enable.
+"/ supportsColor value:(Printer supportsColor).
+"/ ]
+"/ ].
+"/ unitList onChangeSend:#value to:updater.
+"/ printerType onChangeSend:#value to:updater.
+"/ updater value.
+"/
+"/ box addVerticalSpace;
+"/ addHelpButtonFor:'Launcher/printerSettings.html';
+"/ addAbortButton; addOkButton.
+"/ box open.
+"/
+"/ box accepted ifTrue:[
+"/ Printer := possiblePrinters at:(printerType selectionIndex).
+"/ Printer printCommand:printCommand value.
+"/
+"/ Printer supportsPageSizes ifTrue:[
+"/ Printer pageFormat:(pageFormat selection).
+"/ Printer landscape:(landscape value).
+"/ ].
+"/ Printer supportsMargins ifTrue:[
+"/ unitList selectionIndex == 2 ifTrue:[
+"/ unit := #mm
+"/ ] ifFalse:[
+"/ unit := #inch
+"/ ].
+"/ Printer topMargin:(UnitConverter convert:topMargin value from:unit to:#inch).
+"/ Printer leftMargin:(UnitConverter convert:leftMargin value from:unit to:#inch).
+"/ Printer rightMargin:(UnitConverter convert:rightMargin value from:unit to:#inch).
+"/ Printer bottomMargin:(UnitConverter convert:bottomMargin value from:unit to:#inch).
+"/ ].
+"/ Printer supportsPostscript ifTrue:[
+"/ Printer supportsColor:supportsColor value.
+"/ ].
+"/ ].
+"/ box destroy
+"/
+"/ "Modified: 9.9.1996 / 22:43:51 / stefan"
+"/ "Modified: 28.2.1997 / 14:00:13 / cg"
+!
+
+restoreSettings
+ "restore settings from a settings-file."
+
+ SettingsDialogs restoreSettingsFor:self.
+
+"/ "a temporary kludge - we need a central systemSettings object for this,
+"/ which can be saved/restored with a single store/read."
+"/
+"/ |fileName|
+"/
+"/ fileName := Dialog
+"/ requestFileName:(resources string:'restore settings from:')
+"/ default:'settings.stx'
+"/ ok:(resources string:'restore')
+"/ abort:(resources string:'cancel')
+"/ pattern:'*.stx'
+"/ fromDirectory:nil.
+"/
+"/ (fileName isNil or:[fileName isEmpty]) ifTrue:[
+"/ "/ canceled
+"/ ^ self
+"/ ].
+"/
+"/ self withWaitCursorDo:[
+"/ Smalltalk fileIn:fileName.
+"/
+"/ self reopenLauncher.
+"/ ].
+"/
+"/ "Modified: 8.1.1997 / 14:53:52 / cg"
+!
+
+saveSettings
+ "save settings to a settings-file."
+
+ SettingsDialogs saveSettingsFor:self.
+
+"/ "a temporary kludge - we need a central systemSettings object for this,
+"/ which can be saved/restored with a single store/read."
+"/
+"/ |s screen fileName|
+"/
+"/ fileName := Dialog
+"/ requestFileName:(resources string:'save settings in:')
+"/ default:'settings.stx'
+"/ ok:(resources string:'save')
+"/ abort:(resources string:'cancel')
+"/ pattern:'*.stx'
+"/ fromDirectory:nil.
+"/
+"/ (fileName isNil or:[fileName isEmpty]) ifTrue:[
+"/ "/ canceled
+"/ ^ self
+"/ ].
+"/
+"/ s := fileName asFilename writeStream.
+"/ s isNil ifTrue:[
+"/ self warn:'cannot write the ''' , fileName , ''' file'.
+"/ ^ self
+"/ ].
+"/
+"/ s nextPutLine:'"/ ST/X saved settings';
+"/ nextPutLine:'"/ DO NOT MODIFY MANUALLY';
+"/ nextPutLine:'"/ (modifications would be lost with next save-settings)';
+"/ nextPutLine:'"/';
+"/ nextPutLine:'"/ this file was automatically generated by the';
+"/ nextPutLine:'"/ ''save settings'' function of the Launcher';
+"/ nextPutLine:'"/'.
+"/ s cr.
+"/
+"/ s nextPutLine:'"/'.
+"/ s nextPutLine:'"/ saved by ' , OperatingSystem getLoginName , '@' , OperatingSystem getHostName , ' at ' , AbsoluteTime now printString.
+"/ s nextPutLine:'"/'.
+"/ s cr.
+"/
+"/ s nextPutLine:'"/'.
+"/ s nextPutLine:'"/ Display settings:'.
+"/ s nextPutLine:'"/'.
+"/ s nextPutLine:'"/ only restore the display settings, if on the same Display ...'.
+"/ s nextPutLine:'Display displayName = ' , (Display displayName storeString) , ' ifTrue:['.
+"/ screen := Screen current.
+"/ screen fixColors notNil ifTrue:[
+"/ s nextPutLine:' Image flushDeviceImages.'.
+"/ s nextPutLine:' Color colorAllocationFailSignal catch:['.
+"/ s nextPutLine:' Color getColorsRed:6 green:6 blue:4 on:Display'.
+"/ s nextPutLine:' ].'.
+"/ ] ifFalse:[
+"/ s nextPutLine:' Display releaseFixColors.'.
+"/ ].
+"/ s nextPutLine:' Display hasColors: ' , (screen hasColors storeString) , '.'.
+"/ s nextPutLine:' Display widthInMillimeter: ' , (screen widthInMillimeter storeString) , '.'.
+"/ s nextPutLine:' Display heightInMillimeter: ' , (screen heightInMillimeter storeString) , '.'.
+"/ s nextPutLine:' Display supportsDeepIcons: ' , (screen supportsDeepIcons storeString) , '.'.
+"/ s nextPutLine:' Image ditherAlgorithm: ' , (Image ditherAlgorithm storeString) , '.'.
+"/ s nextPutLine:' View defaultStyle:' , View defaultStyle storeString , '.'.
+"/ s nextPutLine:'].'.
+"/ s cr.
+"/
+"/ s nextPutLine:'"/'.
+"/ s nextPutLine:'"/ Compiler settings:'.
+"/ s nextPutLine:'"/'.
+"/ s nextPutLine:'Compiler warnSTXSpecials: ' , (Compiler warnSTXSpecials storeString) , '.';
+"/ nextPutLine:'Compiler warnUnderscoreInIdentifier: ' , (Compiler warnUnderscoreInIdentifier storeString) , '.';
+"/ nextPutLine:'Compiler warnOldStyleAssignment: ' , (Compiler warnOldStyleAssignment storeString) , '.';
+"/ nextPutLine:'Compiler warnCommonMistakes: ' , (Compiler warnCommonMistakes storeString) , '.';
+"/ nextPutLine:'Compiler warnPossibleIncompatibilities: ' , (Compiler warnPossibleIncompatibilities storeString) , '.';
+"/ nextPutLine:'Compiler allowUnderscoreInIdentifier: ' , (Compiler allowUnderscoreInIdentifier storeString) , '.';
+"/ nextPutLine:'Compiler arraysAreImmutable: ' , (Compiler arraysAreImmutable storeString) , '.';
+"/ nextPutLine:'Compiler lineNumberInfo: ' , (Compiler lineNumberInfo storeString) , '.';
+"/
+"/ nextPutLine:'Compiler foldConstants: ' , (Compiler foldConstants storeString) , '.';
+"/
+"/ nextPutLine:'Compiler stcCompilationIncludes: ' , (Compiler stcCompilationIncludes storeString) , '.';
+"/ nextPutLine:'Compiler stcCompilationDefines: ' , (Compiler stcCompilationDefines storeString) , '.';
+"/ nextPutLine:'Compiler stcCompilationOptions: ' , (Compiler stcCompilationOptions storeString) , '.';
+"/ nextPutLine:'Compiler ccCompilationOptions: ' , (Compiler ccCompilationOptions storeString) , '.';
+"/ nextPutLine:'Compiler ccPath: ' , (Compiler ccPath storeString) , '.';
+"/
+"/ nextPutLine:'ObjectMemory justInTimeCompilation: ' , (ObjectMemory justInTimeCompilation storeString) , '.';
+"/ nextPutLine:'ObjectMemory fullSingleStepSupport: ' , (ObjectMemory fullSingleStepSupport storeString) , '.'.
+"/
+"/ HistoryManager notNil ifTrue:[
+"/ HistoryManager isActive ifTrue:[
+"/ s nextPutLine:'HistoryManager notNil ifTrue:[HistoryManager activate].'.
+"/ s nextPutLine:'HistoryManager notNil ifTrue:[HistoryManager fullHistoryUpdate:' , HistoryManager fullHistoryUpdate storeString , '].'.
+"/ ] ifFalse:[
+"/ s nextPutLine:'HistoryManager notNil ifTrue:[HistoryManager deactivate].'.
+"/ ].
+"/ ].
+"/
+"/ ObjectFileLoader notNil ifTrue:[
+"/ s nextPutLine:'ObjectFileLoader searchedLibraries: ' , (ObjectFileLoader searchedLibraries storeString) , '.'.
+"/ s nextPutLine:'ObjectFileLoader libPath: ' , (ObjectFileLoader libPath storeString) , '.'.
+"/ ].
+"/
+"/ s nextPutLine:'Class catchMethodRedefinitions: ' , (Class catchMethodRedefinitions storeString) , '.'.
+"/ s nextPutLine:'ClassCategoryReader sourceMode: ' , (ClassCategoryReader sourceMode storeString) , '.'.
+"/
+"/ s cr.
+"/ s nextPutLine:'"/'.
+"/ s nextPutLine:'"/ Info & Debug Messages:'.
+"/ s nextPutLine:'"/'.
+"/ s nextPutLine:'ObjectMemory infoPrinting: ' , (ObjectMemory infoPrinting storeString) , '.';
+"/ nextPutLine:'ObjectMemory debugPrinting: ' , (ObjectMemory debugPrinting storeString) , '.';
+"/ nextPutLine:'Object infoPrinting: ' , (Object infoPrinting storeString) , '.';
+"/ nextPutLine:'DeviceWorkstation errorPrinting: ' , (DeviceWorkstation errorPrinting storeString) , '.'.
+"/
+"/
+"/ s cr.
+"/ s nextPutLine:'"/'.
+"/ s nextPutLine:'"/ Misc settings:'.
+"/ s nextPutLine:'"/'.
+"/ s nextPutLine:'Class keepMethodHistory: ' , (Class methodHistory notNil storeString) , '.';
+"/ nextPutLine:'Smalltalk logDoits: ' , (Smalltalk logDoits storeString) , '.';
+"/ nextPutLine:'Autoload compileLazy: ' , (Autoload compileLazy storeString) , '.';
+"/ nextPutLine:'Smalltalk loadBinaries: ' , (Smalltalk loadBinaries storeString) , '.';
+"/ nextPutLine:'StandardSystemView includeHostNameInLabel: ' , (StandardSystemView includeHostNameInLabel storeString) , '.';
+"/
+"/ "/ claus - I dont think its a good idea to save those ...
+"/ nextPutLine:'"/ Class updateChanges: ' , (Class updatingChanges storeString) , '.';
+"/ nextPutLine:'"/ ObjectMemory nameForChanges: ' , (ObjectMemory nameForChanges storeString) , '.';
+"/
+"/ nextPutLine:'StandardSystemView returnFocusWhenClosingModalBoxes: ' , (StandardSystemView returnFocusWhenClosingModalBoxes storeString) , '.';
+"/ nextPutLine:'StandardSystemView takeFocusWhenMapped: ' , (StandardSystemView takeFocusWhenMapped storeString) , '.';
+"/ nextPutLine:'MenuView showAcceleratorKeys: ' , (MenuView showAcceleratorKeys storeString) , '.';
+"/ nextPutLine:'EditTextView st80Mode: ' , (EditTextView st80Mode storeString) , '.';
+"/ nextPutLine:'UserPreferences current syntaxColoring: ' , (UserPreferences current syntaxColoring storeString) , '.';
+"/ nextPutLine:'Class tryLocalSourceFirst: ' , (Class tryLocalSourceFirst storeString) , '.'.
+"/ (Exception emergencyHandler == Launcher notifyingEmergencyHandler) ifTrue:[
+"/ s nextPutLine:'Exception emergencyHandler:(Launcher notifyingEmergencyHandler).'.
+"/ ].
+"/
+"/ s cr.
+"/ s nextPutLine:'"/'.
+"/ s nextPutLine:'"/ Printer settings:'.
+"/ s nextPutLine:'"/'.
+"/ s nextPutLine:'Printer := ' , (Printer name) , '.';
+"/ nextPutLine:'Printer printCommand: ' , (Printer printCommand storeString) , '.'.
+"/
+"/ Printer supportsPageSizes ifTrue:[
+"/ s nextPutLine:'Printer pageFormat: ' , (Printer pageFormat storeString) , '.'.
+"/ s nextPutLine:'Printer landscape: ' , (Printer landscape storeString) , '.'.
+"/ ].
+"/ Printer supportsMargins ifTrue:[
+"/ s nextPutLine:'Printer topMargin: ' , (Printer topMargin storeString) , '.'.
+"/ s nextPutLine:'Printer leftMargin: ' , (Printer leftMargin storeString) , '.'.
+"/ s nextPutLine:'Printer rightMargin: ' , (Printer rightMargin storeString) , '.'.
+"/ s nextPutLine:'Printer bottomMargin: ' , (Printer bottomMargin storeString) , '.'.
+"/ ].
+"/ Printer supportsPostscript ifTrue:[
+"/ s nextPutLine:'Printer supportsColor: ' , (Printer supportsColor storeString) , '.'.
+"/ ].
+"/
+"/ s cr.
+"/ s nextPutLine:'"/'.
+"/ s nextPutLine:'"/ Font settings:'.
+"/ s nextPutLine:'"/'.
+"/ s nextPutLine:'View defaultFont: ' , (View defaultFont storeString) , '.'.
+"/ s nextPutLine:'Label defaultFont: ' , (Label defaultFont storeString) , '.'.
+"/ s nextPutLine:'Button defaultFont: ' , (Button defaultFont storeString) , '.'.
+"/ s nextPutLine:'Toggle defaultFont: ' , (Toggle defaultFont storeString) , '.'.
+"/ s nextPutLine:'SelectionInListView defaultFont: ' , (SelectionInListView defaultFont storeString) , '.'.
+"/ s nextPutLine:'MenuView defaultFont: ' , (MenuView defaultFont storeString) , '.'.
+"/ s nextPutLine:'PullDownMenu defaultFont: ' , (PullDownMenu defaultFont storeString) , '.'.
+"/ s nextPutLine:'TextView defaultFont: ' , (TextView defaultFont storeString) , '.'.
+"/ s nextPutLine:'EditTextView defaultFont: ' , (EditTextView defaultFont storeString) , '.'.
+"/ s nextPutLine:'CodeView defaultFont: ' , (CodeView defaultFont storeString) , '.'.
+"/
+"/ s cr.
+"/ s nextPutLine:'"/'.
+"/ s nextPutLine:'"/ Language setting:'.
+"/ s nextPutLine:'"/'.
+"/ s nextPutLine:'Smalltalk language: ' , (Smalltalk language storeString) , '.'.
+"/ s nextPutLine:'Smalltalk languageTerritory: ' , (Smalltalk languageTerritory storeString) , '.'.
+"/ s close.
+"/
+"/ "
+"/ Transcript topView application saveSettings
+"/ "
+
+ "Modified: / 1.4.1998 / 12:18:15 / cg"
+!
+
+sourceAndDebuggerSettings
+ "open a dialog on misc other settings"
+
+ SettingsDialogs sourceAndDebuggerSettingsFor:self.
+
+"/ |box check logDoits updChanges changeFileName
+"/ useManager hasManager
+"/ repository repositoryHolder localSourceFirst
+"/ sourceCacheDir cacheEntry
+"/ component localCheck oldIndent nm fn manager
+"/ keepMethodHistory showErrorNotifier showVerboseStack
+"/ syntaxColoring|
+"/
+"/ "/
+"/ "/ extract relevant system settings ...
+"/ "/
+"/ keepMethodHistory := Class methodHistory notNil asValue.
+"/ logDoits := Smalltalk logDoits asValue.
+"/ updChanges := Class updatingChanges asValue.
+"/ changeFileName := ObjectMemory nameForChanges asValue.
+"/
+"/ hasManager := AbstractSourceCodeManager notNil
+"/ and:[AbstractSourceCodeManager isLoaded].
+"/
+"/ hasManager ifTrue:[
+"/ useManager := (manager := Smalltalk at:#SourceCodeManager) notNil asValue.
+"/ localSourceFirst := Class tryLocalSourceFirst asValue.
+"/ manager notNil ifTrue:[
+"/ repository := manager repositoryName.
+"/ repository notNil ifTrue:[
+"/ repositoryHolder := repository asValue
+"/ ] ifFalse:[
+"/ repositoryHolder := '' asValue
+"/ ].
+"/ ].
+"/ ] ifFalse:[
+"/ useManager := false.
+"/ localSourceFirst := false
+"/ ].
+"/ showErrorNotifier := (Exception emergencyHandler == Launcher notifyingEmergencyHandler) asValue.
+"/ showVerboseStack := (DebugView defaultVerboseBacktrace ? false) asValue.
+"/ syntaxColoring := UserPreferences current syntaxColoring asValue.
+"/
+"/ sourceCacheDir := nil asValue.
+"/
+"/ "/
+"/ "/ create a box on those values ...
+"/ "/
+"/ box := DialogBox new.
+"/ box label:(resources string:'Source & Debugger settings').
+"/
+"/ box addCheckBox:(resources string:'remember changed methods (for previous method in browser)') on:keepMethodHistory.
+"/ box addCheckBox:(resources string:'log compiles in changes file') on:updChanges.
+"/ box addCheckBox:(resources string:'log doIts in changes file') on:logDoits.
+"/
+"/ component := box
+"/ addLabelledInputField:(resources string:'change file name:')
+"/ adjust:#right
+"/ on:changeFileName
+"/ tabable:true
+"/ separateAtX:0.4.
+"/ component immediateAccept:true; acceptOnLeave:false.
+"/
+"/"/ y := box yPosition.
+"/"/ component := box addTextLabel:(resources string:'change file name:').
+"/"/ component width:0.5; adjust:#right; borderWidth:0.
+"/"/ box yPosition:y.
+"/"/ component := box addInputFieldOn:changeFileName tabable:true.
+"/"/ component width:0.5; left:0.5; immediateAccept:true; acceptOnLeave:false.
+"/
+"/ box addHorizontalLine.
+"/
+"/ hasManager ifTrue:[
+"/ check := box addCheckBox:(resources string:'sourcecode from sourcecode management') on:useManager.
+"/ oldIndent := box leftIndent.
+"/ box leftIndent:30.
+"/
+"/ repositoryHolder notNil ifTrue:[
+"/ component := box
+"/ addLabelledInputField:(resources string:'repository:')
+"/ adjust:#right
+"/ on:repositoryHolder
+"/ tabable:true
+"/ separateAtX:0.4.
+"/ component immediateAccept:true; acceptOnLeave:false.
+"/ component enableChannel:useManager.
+"/ ].
+"/
+"/ cacheEntry := box
+"/ addLabelledInputField:(resources string:'source cache dir:')
+"/ adjust:#right
+"/ on:sourceCacheDir
+"/ tabable:true
+"/ separateAtX:0.4.
+"/ cacheEntry immediateAccept:true; acceptOnLeave:false.
+"/ cacheEntry enableChannel:useManager.
+"/
+"/ localCheck := box addCheckBox:(resources string:'if present, use local source (suppress checkout)') on:localSourceFirst.
+"/ localCheck enableChannel:useManager.
+"/
+"/ box leftIndent:oldIndent.
+"/
+"/ (AbstractSourceCodeManager isNil
+"/ or:[AbstractSourceCodeManager defaultManager isNil]) ifTrue:[
+"/ useManager value:false.
+"/ cacheEntry disable.
+"/ check disable.
+"/ localCheck enable.
+"/ ] ifFalse:[
+"/ sourceCacheDir value:(AbstractSourceCodeManager cacheDirectoryName).
+"/ ].
+"/ box addHorizontalLine.
+"/ ].
+"/
+"/ box addCheckBox:(resources string:'show error notifier before opening debugger') on:showErrorNotifier.
+"/ box addCheckBox:(resources string:'verbose backtrace by default in debugger') on:showVerboseStack.
+"/
+"/ box addHorizontalLine.
+"/ box addCheckBox:(resources string:'syntax coloring') on:syntaxColoring.
+"/
+"/ box
+"/ addHelpButtonFor:'Launcher/sourceSettings.html';
+"/ addAbortButton;
+"/ addOkButton.
+"/
+"/ "/
+"/ "/ show the box ...
+"/ "/
+"/ box open.
+"/
+"/ "/
+"/ "/ update system settings
+"/ "/
+"/ box accepted ifTrue:[
+"/ Class keepMethodHistory:keepMethodHistory value.
+"/ Smalltalk logDoits:logDoits value.
+"/ Class updateChanges:updChanges value.
+"/ ObjectMemory nameForChanges:changeFileName value.
+"/
+"/ (hasManager and:[useManager value]) ifTrue:[
+"/ manager isNil ifTrue:[
+"/ Smalltalk at:#SourceCodeManager put:(AbstractSourceCodeManager defaultManager).
+"/ manager := Smalltalk at:#SourceCodeManager.
+"/ ].
+"/ Class tryLocalSourceFirst:(localSourceFirst value).
+"/
+"/ manager notNil ifTrue:[
+"/ localSourceFirst value ifFalse:[
+"/ nm := sourceCacheDir value.
+"/ nm size > 0 ifTrue:[
+"/ (fn := nm asFilename) exists ifFalse:[
+"/ (self confirm:('cache directory ''' , nm , ''' does not exists\create ?' withCRs)) ifTrue:[
+"/ fn makeDirectory;
+"/ makeReadableForAll;
+"/ makeWritableForAll;
+"/ makeExecutableForAll.
+"/ ]
+"/ ].
+"/ (fn exists
+"/ and:[fn isDirectory
+"/ and:[fn isReadable
+"/ and:[fn isWritable]]]) ifTrue:[
+"/ AbstractSourceCodeManager cacheDirectoryName:(sourceCacheDir value).
+"/ ]
+"/ ]
+"/ ]
+"/ ].
+"/
+"/ repositoryHolder notNil ifTrue:[
+"/ repositoryHolder value size > 0 ifTrue:[
+"/ manager initializeForRepository:repositoryHolder value.
+"/ ].
+"/ ].
+"/ ] ifFalse:[
+"/ Smalltalk at:#SourceCodeManager put:nil
+"/ ].
+"/
+"/ showErrorNotifier value ifFalse:[
+"/ Exception emergencyHandler:nil
+"/ ] ifTrue:[
+"/ Exception emergencyHandler:(Launcher notifyingEmergencyHandler)
+"/ ].
+"/ DebugView defaultVerboseBacktrace:(showVerboseStack value).
+"/ UserPreferences current syntaxColoring:syntaxColoring value.
+"/ ].
+"/ box destroy
+"/
+"/ "Modified: / 9.9.1996 / 22:43:36 / stefan"
+"/ "Created: / 17.1.1997 / 17:39:33 / cg"
+"/ "Modified: / 3.4.1998 / 12:28:10 / cg"
+"/ "Modified: / 16.4.1998 / 17:18:47 / ca"
+!
+
+viewStyleSetting
+ "open a dialog on viewStyle related settings"
+
+ SettingsDialogs viewStyleSettingsFor:self.
+
+"/ |listOfStyles resourceDir dir box
+"/ list listView scrView infoLabel infoForwarder newStyle
+"/ someRsrcFile b didApply|
+"/
+"/ "
+"/ search resources directory for a list of .style files ...
+"/ "
+"/ someRsrcFile := Smalltalk getSystemFileName:('resources' asFilename constructString:'normal.style').
+"/ someRsrcFile notNil ifTrue:[
+"/ resourceDir := someRsrcFile asFilename directoryName
+"/ ] ifFalse:[
+"/ resourceDir := Smalltalk getSystemFileName:'resources'.
+"/ ].
+"/
+"/ resourceDir isNil ifTrue:[
+"/ self warn:'no styles found (missing ''resources'' directory)'.
+"/ ^ self
+"/ ].
+"/ dir := resourceDir asFilename directoryContents.
+"/
+"/ listOfStyles := dir select:[:aFileName | aFileName asFilename hasSuffix:'style'].
+"/ listOfStyles := listOfStyles collect:[:aFileName | aFileName asFilename withoutSuffix name].
+"/ Filename isCaseSensitive ifFalse:[
+"/ listOfStyles := listOfStyles collect:[:aStyleName | aStyleName asLowercase].
+"/ ].
+"/ 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 := [
+"/ |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:#value to:infoForwarder.
+"/
+"/ box := Dialog new.
+"/ box label:(resources string:'Style selection').
+"/
+"/ (box addTextLabel:(resources string:'STYLE_MSG') withCRs) adjust:#left.
+"/ listView := SelectionInListView on:list.
+"/ listView doubleClickAction:[:sel | box accept value:true. box hide].
+"/ scrView := box addComponent:(ScrollableView forView:listView) tabable:true.
+"/
+"/ box addVerticalSpace.
+"/
+"/ (infoLabel := box addTextLabel:'\\' withCRs) adjust:#centerLeft.
+"/
+"/ box addAbortButton.
+"/ b := box addButton:(Button label:(resources string:'apply')).
+"/ b action:[didApply := true. self changeViewStyleTo:(list selection)].
+"/ box addOkButton.
+"/ list selection:(View defaultStyle).
+"/
+"/ box stickAtBottomWithVariableHeight:scrView.
+"/ box stickAtBottomWithFixHeight:infoLabel.
+"/ box open.
+"/
+"/ box accepted ifTrue:[
+"/ ((newStyle := list selection) ~= View defaultStyle
+"/ or:[didApply ~~ true]) ifTrue:[
+"/ self changeViewStyleTo:newStyle.
+"/ ].
+"/ ].
+"/ box destroy
+
+ "Modified: 20.10.1997 / 15:30:27 / cg"
+! !
+
+!Launcher methodsFor:'actions - tools'!
+
+compressingGarbageCollect
+ "perform a compressing garbageCollect"
+
+ ObjectMemory verboseGarbageCollect
+
+ "Created: 12.5.1996 / 15:30:15 / cg"
+ "Modified: 8.1.1997 / 14:54:21 / cg"
+!
+
+deIconifyAllWindows
+ |setOfViews|
+
+ setOfViews := Project current views asIdentitySet.
+ setOfViews addAll:(Project defaultProject views).
+
+ setOfViews do:[:aTopView |
+ aTopView device == Screen current ifTrue:[
+ aTopView expand
+ ].
+ ].
+
+ "
+ Transcript topView application deIconifyAllWindows
+ "
+
+ "Modified: 3.3.1997 / 14:13:24 / cg"
+!
+
+findAndDestroyWindow
+ "find a window (by name) and destroy it"
+
+ |v|
+
+ v := self findWindow:'select view to close:'.
+ v notNil ifTrue:[
+ v destroy.
+ ].
+
+ "Created: 28.10.1996 / 14:39:23 / cg"
+ "Modified: 14.10.1997 / 11:25:37 / cg"
+!
+
+findAndRaiseWindow
+ "find a window (by name) and raise it"
+
+ |v|
+
+ v := self findWindow:'select view to raise deiconified:'.
+ v notNil ifTrue:[
+ v raiseDeiconified.
+ ].
+
+ "Modified: 14.10.1997 / 11:25:42 / cg"
+!
+
+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
+
+ "Modified: 23.9.1996 / 14:36:14 / cg"
+!
+
+garbageCollect
+ "perform a non-compressing garbageCollect"
+
+ ObjectMemory reclaimSymbols
+
+ "Created: 12.5.1996 / 15:28:03 / cg"
+ "Modified: 8.1.1997 / 14:54:29 / cg"
+!
+
+globalGarbageCollect
+ "perform a non-compressing garbageCollect"
+
+ ObjectMemory reclaimSymbols
+
+ "Created: 12.5.1996 / 15:28:13 / cg"
+ "Modified: 8.1.1997 / 14:54:36 / cg"
+!
+
+iconifyAllWindows
+ |setOfViews|
+
+ setOfViews := Project current views asIdentitySet.
+ setOfViews addAll:(Project defaultProject views).
+
+ setOfViews do:[:aTopView |
+ aTopView device == Screen current ifTrue:[
+ aTopView collapse
+ ]
+ ]
+
+ "Created: 1.3.1997 / 20:10:58 / cg"
+ "Modified: 3.3.1997 / 14:13:11 / cg"
+!
+
+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:[
+ [Screen current leftButtonPressed] whileTrue:[Processor yield].
+
+ area := Rectangle fromUser.
+ (area width > 0 and:[area height > 0]) ifTrue:[
+ self saveScreenImage:(Image fromScreen:area) defaultName:'hardcopy'
+ ]
+ ]
+ afterSeconds:1
+
+ "Modified: 13.2.1997 / 16:02:35 / cg"
+!
+
+startApplication:aSymbol
+ "start an application,
+ popup warnbox if application is not present or autoload failed"
+
+ |app|
+
+ app := Smalltalk classNamed:aSymbol.
+ app isBehavior ifTrue:[
+ app isLoaded ifFalse:[
+ Autoload autoloadFailedSignal handle:[:ex|
+ ^ self warn:(resources string:'Sorry - cannot load %1' with:app name).
+ ] do:[
+ app autoload.
+ ].
+ ].
+ app open.
+ ] ifFalse:[
+ self warn:(resources string:'Sorry - %1 is only available
+in the full commercial release' with:aSymbol asString).
+ ]
+
+ "Created: / 19.12.1997 / 13:00:29 / stefan"
+ "Modified: / 19.12.1997 / 14:09:46 / stefan"
+!
+
+startFullWindowTreeView
+ "open a windowTree view (on all views)"
+
+ WindowTreeView open
+
+ "Modified: 8.1.1997 / 14:56:04 / cg"
+!
+
+startGUIBuilder
+ "open a GUIBuilder view"
+
+ UIPainter open
+
+ "Modified: 8.1.1997 / 14:56:14 / cg"
+ "Created: 25.7.1997 / 10:56:30 / cg"
+!
+
+startNewLauncher
+ "open a real new launcher"
+
+ NewLauncher openAt:(self window origin)
+
+ "Modified: / 5.2.1998 / 19:31:41 / cg"
+!
+
+startStopEventTrace
+ "start/stop event tracing for a particular view"
+
+ |v wg|
+
+ v := Screen current viewFromUser.
+ v notNil ifTrue:[
+ v := v topView.
+ wg := v windowGroup.
+ wg notNil ifTrue:[
+ "/
+ "/ toggle eventTrace in its windowGroup
+ "/
+ wg traceEvents:(wg preEventHook isNil)
+ ]
+ ]
+
+ "Created: 7.3.1996 / 14:44:22 / cg"
+ "Modified: 8.1.1997 / 14:56:44 / cg"
+!
+
+startWindowTreeView
+ "open a windowTree view (on a topView)"
+
+ |v|
+
+ v := self pickAView.
+ v notNil ifTrue:[
+ WindowTreeView openOn:v topView
+ ]
+
+ "Modified: 8.1.1997 / 14:55:59 / cg"
+!
+
+viewDestroy
+ "let user pick a view and destroy it.
+ Even allow destroying non-smalltalk views
+ (also for views which I forgot due to some error)"
+
+ |device p v id i c|
+
+ (Delay forSeconds:1) wait.
+
+ device := Screen current.
+ i := Image fromFile:'bitmaps/xpmBitmaps/cursors/cross2.xpm'.
+ i isNil ifTrue:[
+ c := Cursor crossHair
+ ] ifFalse:[
+ c := Cursor fromImage:i
+ ].
+ p := device pointFromUserShowing:c.
+ id := device viewIdFromPoint:p.
+ v := device viewFromId:id.
+ v notNil ifTrue:[
+ v topView destroy.
+ ^ self
+ ].
+ id = device rootView id ifTrue:[
+ ^ self
+ ].
+ (Dialog confirm:'mhmh, this may not a be smalltalk view\(Or I somehow forgot about it).\Destroy anyway ?' withCRs)
+ ifTrue:[
+ device destroyView:nil withId:id
+ ].
+
+ "Modified: 18.9.1995 / 23:13:32 / claus"
+ "Modified: 19.10.1997 / 03:09:20 / cg"
+!
+
+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
+
+ "Modified: 19.10.1997 / 03:09:34 / cg"
+!
+
+viewInspect
+ "let user pick a view and inspect it. Only smalltalk views are allowed"
+
+ |v|
+
+ v := self pickAView.
+ v notNil ifTrue:[
+"/ v topView inspect
+ v inspect
+ ]
+
+! !
+
+!Launcher methodsFor:'change & update'!
+
+update:something with:aParameter from:changedObject
+ "care for project changes & update my infoView"
+
+ ((something == #currentProject)
+ or:[changedObject == Project]) ifTrue:[
+ self updateInfo.
+ ^ self
+ ].
+
+ "Modified: 28.7.1997 / 18:39:39 / cg"
+! !
+
+!Launcher methodsFor:'drag & drop'!
+
+canDrop:aCollectionOfDropObjects in:aComponent
+ "I accept fileObjects in the fileBrowser button
+ and open a fileBrowser ..."
+
+ aCollectionOfDropObjects size ~~ 1 ifTrue:[^ false].
+ ^ aCollectionOfDropObjects first isFileObject
+
+ "Modified: 11.4.1997 / 12:42:59 / cg"
+!
+
+drop:aCollectionOfDropObjects in:aComponent at:aPoint
+ "I accept fileObjects and will open a fileBrowser ..."
+
+ |singleDropObject|
+
+ aCollectionOfDropObjects size == 1 ifFalse:[
+ transcript showCR:'can only drop single objects'.
+ ^ self
+ ].
+ singleDropObject := aCollectionOfDropObjects first.
+
+ singleDropObject isFileObject ifTrue:[
+ FileBrowser openOnFileNamed:(singleDropObject theObject pathName)
+ ].
+
+ "Modified: 11.4.1997 / 12:44:29 / cg"
+! !
+
+!Launcher methodsFor:'dynamic menus'!
+
+addMenu:name withItems:items actions:actions
+ "dynamically add a new (user-)menu to the menu panel.
+ This allows applications to install items for themself
+ dynamically in the launcher."
+
+ |subMenu|
+
+ myMenu add:name selector:(name asSymbol) before:#help.
+ subMenu := MenuView forMenu:myMenu.
+ subMenu labels:items.
+ subMenu actions:actions.
+ myMenu at:name putMenu:subMenu
+
+ "
+ |launcher actionBlocks|
+
+ actionBlocks := Array new:3.
+ actionBlocks at:1 put:[Transcript showCR:'foo'].
+ actionBlocks at:2 put:[Transcript showCR:'bar'].
+
+ launcher := Transcript topView application.
+ launcher
+ addMenu:'misc'
+ withItems:#('foo' 'bar')
+ actions:actionBlocks
+ "
+
+ "
+ |launcher actionBlocks|
+
+ actionBlocks := Array new:3.
+ actionBlocks at:1 put:[RDoItServer startServer].
+ actionBlocks at:2 put:[RDoItServer killServer].
+
+ launcher := Transcript topView application.
+ launcher
+ addMenu:'misc'
+ withItems:#('start rdoit server' 'stop rdoit server')
+ actions:actionBlocks
+ "
+
+ "Modified: 5.7.1996 / 11:45:19 / cg"
+!
+
+menuAt:nameSymbol
+ "return a menu by name"
+
+ ^ myMenu subMenuAt:nameSymbol
+
+ "
+ |launcher demoMenu|
+
+ launcher := Transcript topView application.
+ demoMenu := launcher menuAt:#demos.
+ demoMenu
+ addLabels:#('-' 'fooBar')
+ selectors:#(nil fooBar).
+ demoMenu actionAt:#fooBar put:[Transcript showCR:'fooBar']
+ "
+
+ "Created: 11.7.1996 / 15:35:13 / cg"
+ "Modified: 11.7.1996 / 15:42:25 / cg"
+!
+
+removeMenu:name
+ "dynamically remove a (user-)menu from the menu panel.
+ This allows applications to de-install items for themself
+ dynamically in the launcher."
+
+ myMenu remove:name
+
+ "
+ |launcher actionBlocks|
+
+ actionBlocks := Array new:3.
+ actionBlocks at:1 put:[Transcript showCR:'foo'].
+ actionBlocks at:2 put:[Transcript showCR:'bar'].
+
+ launcher := Transcript topView application.
+ launcher
+ addMenu:'misc'
+ withItems:#('foo' 'bar')
+ actions:actionBlocks.
+
+ Delay waitForSeconds:10.
+
+ launcher removeMenu:'misc'
+ "
+
+ "Created: 5.7.1996 / 11:44:54 / cg"
+ "Modified: 5.7.1996 / 11:54:36 / cg"
+! !
+
+!Launcher methodsFor:'help'!
+
+helpTextFor:aComponent
+ "activeHelp interface: return some help text for a component"
+
+ |sel s buttons|
+
+ aComponent == transcript ifTrue:[
+ s := 'TRANSCRIPT_HELP'
+ ].
+
+ aComponent == infoView ifTrue:[
+ s := 'INFOVIEW_HELP'
+ ].
+
+ buttons := buttonPanel subViews.
+ (buttons notNil and:[buttons includes:aComponent]) ifTrue:[
+ "kludge: look for its change selector"
+ sel := aComponent changeMessage.
+ sel == #startSystemBrowser ifTrue:[
+ s := 'SBROWSER_BUTTON_HELP'
+ ].
+ sel == #startFileBrowser ifTrue:[
+ s := 'FBROWSER_BUTTON_HELP'
+ ].
+ sel == #startChangesBrowser ifTrue:[
+ s := 'CBROWSER_BUTTON_HELP'
+ ].
+ ].
+ s notNil ifTrue:[
+ ^ resources string:s
+ ].
+ ^ nil
+
+ "Modified: 8.1.1997 / 14:57:34 / cg"
+! !
+
+!Launcher methodsFor:'infoview update'!
+
+showActivity:someMessage
+ "some activityNotification to be forwarded to the user;
+ show it in the transcript here."
+
+ transcript showCR:someMessage; endEntry
+
+ "Created: 23.12.1995 / 12:38:29 / cg"
+ "Modified: 5.7.1996 / 13:13:15 / cg"
+!
+
+updateInfo
+ "update the infoView from the current project"
+
+ |project projectName projectDir packageName defNameSpace msg args|
+
+ (Project isNil or:[(project := Project current) isNil]) ifTrue:[
+ projectName := '* none *'.
+ projectDir := '.'.
+ packageName := '* none *'.
+ ] ifFalse:[
+ projectName := project name.
+ projectDir := project directory.
+ packageName := project packageName.
+ defNameSpace := project defaultNameSpace.
+ ].
+ defNameSpace isNil ifTrue:[
+ defNameSpace := Smalltalk.
+ ].
+
+ defNameSpace == Smalltalk ifTrue:[
+ msg := 'project: ''%1'' fileOut to: ''%3'' package: ''%2'''.
+ args := Array
+ with:projectName
+ with:packageName
+ with:(projectDir contractTo:30).
+ ] ifFalse:[
+ msg := 'project: ''%1'' fileOut to: ''%3'' package: ''%2'' nameSpace: %4'.
+ args := Array
+ with:projectName
+ with:packageName
+ with:(projectDir contractTo:30)
+ with:defNameSpace name.
+ ].
+
+ projectInfoHolder value:(resources string:msg withArgs:args)
+
+ "Created: 28.7.1997 / 18:39:15 / cg"
+ "Modified: 28.7.1997 / 18:42:40 / cg"
+! !
+
+!Launcher methodsFor:'initialize - menus'!
+
+disableDangerousMenuItemsInRemoteLauncher
+ "if I am a remote launcher (multidisplay operation),
+ disable menus which are dangerous or affect common state.
+ These operations have to
+ be performed on the main screen."
+
+ isMainLauncher ifFalse:[
+ (myMenu menuAt:#file) disableAll:#(snapshot snapshotAndExit objectModuleDialog exit).
+ (myMenu menuAt:#projects) disableAll.
+ (myMenu menuAt:#settings) disableAll:#(languageSetting viewStyleSetting fontSettings printerSettings messageSettings compilerSettings sourceAndDebuggerSettings memorySettings miscSettings saveSettings restoreSettings).
+ ].
+
+ "Created: 5.7.1996 / 17:00:50 / cg"
+ "Modified: 11.4.1997 / 09:19:51 / cg"
+!
+
+setupAboutMenu
+ <resource: #programMenu >
+
+ "setup the about- pulldown menu"
+
+ myMenu at:#about
+ putLabels:(resources array:#(
+ 'about Smalltalk/X ...'
+ '-'
+ 'licence conditions'
+ ))
+ selectors:#(
+ #about
+ nil
+ #showLicenceConditions
+ )
+ receiver:self.
+
+ "Created: / 8.1.1997 / 14:03:20 / cg"
+ "Modified: / 29.10.1997 / 03:40:36 / cg"
+!
+
+setupClassesMenu
+ <resource: #programMenu >
+
+ |m|
+
+ "setup the classes- pulldown menu"
+
+ myMenu at:#classes
+ putLabels:(resources array:#(
+ 'system browser'
+ 'class browser ...'
+ 'full class browser ...'
+ 'class hierarchy browser ...'
+ 'class tree'
+ '-'
+ 'implementors ...'
+ 'senders ...'
+ 'special'
+ '-'
+ 'change browser'
+ ))
+ selectors:#(
+ #startSystemBrowser
+ #startClassBrowser
+ #startFullClassBrowser
+ #startClassHierarchyBrowser
+ #startClassTreeView
+ nil
+ #browseImplementors
+ #browseSenders
+ #special
+ nil
+ #startChangesBrowser
+ )
+ receiver:self.
+
+ m := myMenu menuAt:#classes.
+ m subMenuAt:#special
+ put:(PopUpMenu
+ labels:(resources array:#(
+ 'references to undeclared'
+ 'resource methods ...'
+ 'show break/trace points'
+ '-'
+ 'remove all break/trace points'
+ ))
+ selectors:#(
+ #browseUndeclared
+ #browseResources
+ #browseAllBreakAndTracePoints
+ nil
+ #removeAllBreakAndTracePoints
+ )
+ ).
+
+ (JavaBrowser notNil
+ and:[JavaBrowser isLoaded]) ifTrue:[
+ (myMenu subMenuAt:#classes)
+ addLabels:(resources array:#('-' 'java browser'))
+ selectors:#(nil startJavaBrowser)
+ after:#startClassTreeView
+ ].
+
+ "Created: / 8.1.1997 / 14:05:44 / cg"
+ "Modified: / 13.1.1998 / 09:57:46 / cg"
+!
+
+setupDemoMenu
+ "setup the demo- pulldown menu"
+
+ <resource: #programMenu>
+
+ |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'
+ 'Tic Tac Toe (2 players)'
+ ))
+ selectors:#(
+ startTetris
+ startTicTacToe
+ startTicTacToe2
+ )
+ receiver:self).
+
+ "
+ and labels:selector:args:receiver: here:
+ "
+ m subMenuAt:#geometricDesigns
+ put:(PopUpMenu
+ labels:(resources array:#(
+ 'Pen demo'
+ 'Commander demo'
+ '-'
+ 'Fractal plants demo'
+ 'Fractal patterns demo'
+ 'more fractal patterns demo'
+ ))
+ selector:#openDemo:
+ args:#(
+ PenDemo
+ CommanderDemo
+ nil
+ FractalPlantsDemo
+ FractalPatternsDemo
+ ArmchairUniverseDemo
+ )
+ 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)'
+ 'sphere (wireframe)'
+ 'doughnut (wireframe)'
+ 'planet'
+ 'teapot'
+ 'logo'
+ 'rubics cube'
+ 'x/y graph'
+ '-'
+ 'cube (light)'
+ 'cube (light & texture)'
+ 'sphere (light)'
+ 'colored octahedron'
+ ))
+ selector:#openDemo:
+ args:#(
+ GLPlaneDemoView2
+ GLTetraDemoView
+ GLWireCubeDemoView
+ GLCubeDemoView
+ GLWireSphereDemoView
+ GLDoughnutDemoView
+ GLPlanetDemoView
+ GLTeapotDemo
+ Logo3DView1
+ RubicsCubeView
+ GLXYGraph
+ nil
+ GLCubeDemoView2
+ GLBrickCubeDemoView
+ GLSphereDemoView2
+ GLOctaHedronDemoView
+ )
+ receiver:self).
+
+ m subMenuAt:#graphicEditors
+ put:(PopUpMenu
+ labels:(resources array:#(
+ 'DrawTool'
+ 'LogicTool'
+ 'Paint Demo'
+ ))
+ selector:#openDemo:
+ args:#(
+ DrawTool
+ LogicTool
+ ColorDrawDemo3
+ )
+ receiver:self).
+
+ m subMenuAt:#goodies
+ put:(PopUpMenu
+ labels:(resources array:#(
+ 'clock'
+ 'digital clock'
+ 'calendar'
+ 'calculator'
+ '-'
+ 'mail tool'
+ 'news tool'
+ 'ftp tool'
+ ))
+ selector:#openDemo:
+ args:#(
+ Clock
+ DigitalClockView
+ Calendar
+ CalculatorView
+ nil
+ MailView
+ NewsView
+ FTPTool
+ )
+ receiver:self).
+
+ "Modified: 3.7.1997 / 13:54:20 / cg"
+!
+
+setupFileMenu
+ <resource: #programMenu >
+
+ "setup the file- pulldown menu"
+
+ |l s|
+
+ l := #(
+ 'file browser'
+ '-'
+ 'modules ...'
+ '-'
+ 'snapshot ...'
+ 'snapshot & exit ...'
+ 'exit smalltalk ...'
+ ).
+ s := #(
+ #startFileBrowser
+ nil
+ #objectModuleDialog
+ nil
+ #snapshot
+ #snapshotAndExit
+ #exit
+ ).
+
+ myMenu at:#file
+ putLabels:(resources array:l)
+ selectors:s
+ receiver:self.
+
+ "Created: / 8.1.1997 / 14:04:15 / cg"
+ "Modified: / 29.10.1997 / 03:40:49 / cg"
+!
+
+setupHelpMenu
+ <resource: #programMenu >
+
+ "setup the help- pulldown menu"
+
+ |l s|
+
+ ActiveHelp notNil ifTrue:[
+ l := #(
+ 'what''s new'
+ 'index'
+ '-'
+ 'ST/X online documentation'
+ 'class documentation'
+ '-'
+ 'print documentation ...'
+ '-'
+ 'active help \c'
+ ).
+ s := #(
+ #startWhatsNewDocumentation
+ #startDocumentationIndex
+ nil
+ #startDocumentationTool
+ #startClassDocumentation
+ nil
+ #showBookPrintDocument
+ nil
+ #toggleActiveHelp:
+ )
+ ] ifFalse:[
+ l := #(
+ 'what''s new'
+ 'index'
+ '-'
+ 'ST/X online documentation'
+ 'class documentation'
+ '-'
+ 'print documentation ...'
+ ).
+ s := #(
+ #startWhatsNewDocumentation
+ #startDocumentationIndex
+ nil
+ #startDocumentationTool
+ #startClassDocumentation
+ nil
+ #showBookPrintDocument
+ )
+ ].
+
+ myMenu at:#help
+ putLabels:(resources array:l)
+ selectors:s
+ receiver:self.
+
+ (ActiveHelp notNil
+ and:[ActiveHelp isActive]) ifTrue:[
+ (myMenu menuAt:#help) checkToggleAt:#toggleActiveHelp: put:true
+ ].
+
+ "Created: / 8.1.1997 / 14:08:09 / cg"
+ "Modified: / 29.10.1997 / 03:40:53 / cg"
+!
+
+setupMainMenu
+ "setup the pulldown menus main items.
+ Extracted into a separate method, to allow subclasses to
+ add their own entries"
+
+ <resource: #programMenu >
+
+ |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:[
+"/ icon := icon on:device.
+ 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).
+
+ "Created: / 8.1.1997 / 13:58:50 / cg"
+ "Modified: / 29.10.1997 / 03:41:00 / cg"
+!
+
+setupMenu
+ "setup the pulldown menu"
+
+ |mainItems|
+
+ self setupMainMenu.
+
+ mainItems := myMenu selectors.
+
+ (mainItems includes:#about) ifTrue:[
+ "/ if not redefined without an about-menu ...
+ self setupAboutMenu
+ ].
+ (mainItems includes:#file) ifTrue:[
+ "/ if not redefined without a file-menu ...
+ self setupFileMenu
+ ].
+ (mainItems includes:#classes) ifTrue:[
+ "/ if not redefined without a classes-menu ...
+ self setupClassesMenu
+ ].
+ (mainItems includes:#projects) ifTrue:[
+ "/ if not redefined without a projects-menu ...
+ self setupProjectsMenu
+ ].
+ (mainItems includes:#settings) ifTrue:[
+ "/ if not redefined without a settings-menu ...
+ self setupSettingsMenu
+ ].
+ (mainItems includes:#tools) ifTrue:[
+ "/ if not redefined without a tools-menu ...
+ self setupToolsMenu
+ ].
+ (mainItems includes:#demos) ifTrue:[
+ "/ if not redefined without a demos-menu ...
+ self setupDemoMenu
+ ].
+ (mainItems includes:#help) ifTrue:[
+ "/ if not redefined without a help-menu ...
+ self setupHelpMenu
+ ].
+
+ self disableDangerousMenuItemsInRemoteLauncher
+
+ "Modified: 8.1.1997 / 14:09:47 / cg"
+!
+
+setupProjectsMenu
+ "setup the projects- pulldown menu"
+
+ <resource: #programMenu >
+
+ myMenu at:#projects
+ putLabels:(resources array:#(
+ 'new project'
+ '-'
+ 'select project ...'
+ ))
+ selectors:#(
+ #newProject
+ nil
+ #selectProject
+ )
+ receiver:self.
+
+ "Created: / 8.1.1997 / 14:06:18 / cg"
+ "Modified: / 29.10.1997 / 03:41:09 / cg"
+!
+
+setupSettingsMenu
+ "setup the settings- pulldown menu"
+
+ <resource: #programMenu >
+
+ myMenu at:#settings
+ putLabels:(resources array:#(
+ 'language ...'
+ 'show keyboard mappings ...'
+ 'view style ...'
+ 'fonts ...'
+ 'printer ...'
+ 'messages ...'
+ 'compilation ...'
+ 'source & debugger ...'
+ 'object memory ...'
+ 'screen ...'
+ 'misc ...'
+ '='
+ 'save settings ...'
+ 'restore settings ...'
+ ))
+ selectors:#(
+ #languageSetting
+ #keyboardSetting
+ #viewStyleSetting
+ #fontSettings
+ #printerSettings
+ #messageSettings
+ #compilerSettings
+ #sourceAndDebuggerSettings
+ #memorySettings
+ #displaySettings
+ #miscSettings
+ nil
+ #saveSettings
+ #restoreSettings
+ )
+ receiver:self.
+
+ "Created: / 8.1.1997 / 14:07:00 / cg"
+ "Modified: / 29.10.1997 / 03:41:17 / cg"
+!
+
+setupToolsMenu
+ "setup the tools- pulldown menu"
+
+ <resource: #programMenu>
+
+ |m |
+
+ myMenu at:#tools
+ putLabels:(resources array:#(
+ 'workspace'
+ '-'
+ 'GUI builder'
+ '-'
+ 'new launcher'
+ '-'
+ 'monitors'
+ '-'
+ 'views'
+ '-'
+ 'hardcopy'
+ '-'
+ 'misc'
+ ))
+ selectors:#(
+ #startWorkspace
+ nil
+ #startGUIBuilder
+ nil
+ #startNewLauncher
+ nil
+ #monitors
+ nil
+ #views
+ nil
+ #hardcopy
+ nil
+ #misc
+ )
+ receiver:self.
+
+
+ m := myMenu menuAt:#tools.
+ m subMenuAt:#monitors
+ put:(PopUpMenu
+ labels:(resources array:#(
+ 'process'
+ 'semaphores'
+ 'memory'
+ 'irq latency'
+ 'event view'
+ 'event trace'
+ '-'
+ 'memory usage'
+ ))
+ selectors:#(
+ #startApplication:
+ #startApplication:
+ #startApplication:
+ #startApplication:
+ #startApplication:
+ #startStopEventTrace
+ nil
+ #startApplication:
+ )
+ args:#(
+ #ProcessMonitor
+ #SemaphoreMonitor
+ #MemoryMonitor
+ #InterruptLatencyMonitor
+ #EventMonitor
+ #StopEventTrace
+ nil
+ #MemoryUsageView
+ )
+ receiver:self).
+
+ m subMenuAt:#views
+ put:(PopUpMenu
+ labels:(resources array:#(
+ 'iconify all'
+ 'de-iconify all'
+ '-'
+ 'find & raise ...'
+ '-'
+ 'view tree (all views)'
+ 'view tree'
+ '-'
+ 'select & inspect view'
+ '-'
+ 'select & destroy view'
+ 'find & destroy ...'
+ ))
+ selectors:#(
+ #iconifyAllWindows
+ #deIconifyAllWindows
+ nil
+ #findAndRaiseWindow
+ nil
+ #startFullWindowTreeView
+ #startWindowTreeView
+ nil
+ #viewInspect
+ nil
+ #viewDestroy
+ #findAndDestroyWindow
+ )
+ receiver:self).
+
+ m subMenuAt:#misc
+ put:(PopUpMenu
+ labels:(resources array:#(
+ 'garbage collect'
+ 'garbage collect & compress'
+ ))
+ selectors:#(
+ #garbageCollect
+ #compressingGarbageCollect
+ )
+ receiver:self).
+
+ m subMenuAt:#hardcopy
+ put:(PopUpMenu
+ labels:(resources array:#(
+ 'screen'
+ 'area'
+ 'view'
+ ))
+ selectors:#(
+ #fullScreenHardcopy
+ #screenHardcopy
+ #viewHardcopy
+ )
+ receiver:self).
+
+ "Modified: / 31.10.1997 / 16:01:53 / cg"
+ "Modified: / 19.12.1997 / 13:15:27 / stefan"
+! !
+
+!Launcher methodsFor:'initialize / release'!
+
+addTopViewsToCurrentProject
+ "ignored here - the launcher is always global (i.e. not project private)."
+
+ ^ 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')
+"/ #(startWorkspace 'Workspace32x32.xbm')
+ #(nil nil)
+ #(startChangesBrowser 'CBrowser32x32.xbm')
+"/ #(nil nil)
+"/ #(nil nil)
+"/ #(startDocumentationTool 'book11.ico')
+ )
+
+ "Created: 4.12.1995 / 20:16:18 / cg"
+ "Modified: 19.4.1996 / 16:37:46 / cg"
+!
+
+closeDownViews
+ OpenLaunchers removeIdentical:self ifAbsent:nil.
+ super closeDownViews.
+
+ "Created: 5.7.1996 / 13:33:36 / cg"
+ "Modified: 1.2.1997 / 12:07:53 / cg"
+!
+
+closeRequest
+ (self confirm:(resources string:'really close %1 ?' with:self class name)) ifTrue:[
+ super closeRequest
+ ]
+!
+
+focusSequence
+ ^ (Array with:myMenu)
+ ,
+ (buttonPanel subViews select:[:element | element isKindOf:Button])
+"/ , (Array with:Transcript)
+!
+
+openInterface
+ "sent by my superclass to open up my interface"
+
+ ^ self openInterfaceAt:nil
+
+ "Modified: / 5.2.1998 / 19:57:39 / cg"
+!
+
+openInterfaceAt:aPoint
+ "sent by my superclass to open up my interface"
+
+ |top icn w sz|
+
+ "/ if there is already a transcript on my device,
+ "/ I am a slave launcher with limited functionality.
+
+ Transcript notNil ifTrue:[
+ Transcript ~~ Stderr ifTrue:[
+ isMainLauncher := (Transcript graphicsDevice == device).
+ ] ifFalse:[
+ isMainLauncher := true
+ ]
+ ] ifFalse:[
+ isMainLauncher := true
+ ].
+
+ top := StandardSystemView onDevice:device.
+ top label:'Smalltalk/X'; iconLabel:'ST/X Launcher'.
+ top extent:(400@300 ).
+ aPoint notNil ifTrue:[
+ top origin:aPoint
+ ].
+
+ icn := self class aboutIcon.
+ icn notNil ifTrue:[
+ icn := icn magnifiedTo:(sz := device preferredIconSize).
+ ].
+
+ icn notNil ifTrue:[
+ (device supportsDeepIcons not
+ and:[device supportsIconViews
+ and:[device depth > 1]]) ifTrue:[
+ w := View extent:sz.
+ w viewBackground:icn.
+ top iconView:w
+ ] ifFalse:[
+ top icon:icn.
+ ]
+ ].
+
+"/ device supportsDeepIcons ifTrue:[
+"/ icn := self class aboutIcon.
+"/ icn notNil ifTrue:[
+"/ icn := icn magnifiedTo:(sz := device preferredIconSize).
+"/ icn := Depth8Image fromImage:icn.
+"/ top icon:icn
+"/ ].
+
+"/ ] ifFalse:[
+"/ device supportsIconViews ifTrue:[
+"/ icn := self class aboutIcon.
+"/ icn notNil ifTrue:[
+"/ icn := icn magnifiedTo:(sz := device preferredIconSize).
+"/ w := View extent:sz.
+"/ w viewBackground:icn.
+"/ top iconView:w
+"/ ].
+"/ ]
+"/ ].
+
+ self setupViewsIn:top.
+
+ top application:self.
+
+ "
+ open with higher prio to allow interaction even while things
+ are running ...
+ "
+ top openWithPriority:(Processor userSchedulingPriority + 1).
+
+ OpenLaunchers isNil ifTrue:[
+ OpenLaunchers := OrderedCollection new.
+ ].
+ OpenLaunchers add:self.
+
+ ^ builder
+
+ "Created: / 5.2.1998 / 19:43:44 / cg"
+ "Modified: / 5.2.1998 / 20:08:58 / cg"
+!
+
+release
+ OpenLaunchers removeIdentical:self ifAbsent:nil.
+ super release
+
+ "Modified: 28.7.1997 / 18:40:55 / cg"
+!
+
+restarted
+ "image restart - since WindowGroup recreates the process with
+ the default priority, we have to raise the prio again.
+ Mhmh - this looks like a bug to me ...
+ Also, the cursor (which was stored as a write or waitCursor) must
+ be reset to normal."
+
+ Processor activeProcess priority:(Processor userSchedulingPriority + 1).
+
+ super restarted
+
+ "Modified: 1.6.1996 / 16:58:25 / cg"
+!
+
+saveAndTerminateRequest
+ "some windowManagers can send this, to shutDown an application
+ but let it save its state before, for later restart.
+ Although I have not yet encountered such a windowManager,
+ we are already prepared for this ;-)"
+
+ self snapshot.
+ super saveAndTerminateRequest
+
+ "Created: 5.7.1996 / 13:07:45 / cg"
+ "Modified: 5.7.1996 / 13:08:55 / cg"
+!
+
+setupButtonPanelIn:aTopView
+ "create the buttonPanel"
+
+ |spc mh buttonSize|
+
+ spc := View viewSpacing // 2.
+ buttonPanel := HorizontalPanelView in:aTopView.
+ buttonPanel level:-1; borderWidth:0.
+ buttonPanel horizontalLayout:#leftSpace.
+"/ buttonPanel verticalLayout:#centerSpace.
+
+ buttonSize := self class buttonImageSize.
+
+ "/
+ "/ the buttonSpec is a collection of:
+ "/ #( selector iconFileName )
+ "/ or:
+ "/ #( selector (className iconQuerySelector) )
+ "/ or"
+ "/ #( nil )
+ "/
+ self buttonPanelSpec do:[:entry |
+ |sel b sep img iconSpec v|
+
+ sel := entry at:1.
+ sel isNil ifTrue:[
+ sep := View in:buttonPanel.
+ sep extent:32@1; borderWidth:0.
+ ] ifFalse:[
+ iconSpec := entry at:2.
+ iconSpec isArray ifTrue:[
+ img := (Smalltalk classNamed:(iconSpec at:1)) perform:(iconSpec at:2).
+ ] ifFalse:[
+ img := Image fromFile:iconSpec.
+ ].
+ (img notNil and:[buttonSize notNil]) ifTrue:[
+ img extent ~= buttonSize ifTrue:[
+ img := img magnifiedTo:buttonSize
+ ]
+ ].
+
+ b := Button new.
+ b form:img.
+ b model:self; changeMessage:sel.
+
+ b styleSheet name = 'win95' ifTrue:[
+
+ false ifTrue:[
+ "/ make buttons flat, popping up when entered ...
+
+ b enterLevel: 1.
+ b leaveLevel: 0.
+ buttonPanel addSubView:b.
+
+ ] ifFalse:[
+ "/ make buttons flat, but given them a 3D frame ...
+
+ v := View in:buttonPanel.
+ v addSubView:b.
+ v level:-1.
+ b passiveLevel:1; activeLevel:-1.
+ v extent:(b preferredExtent
+ + b borderWidth + b borderWidth
+ + b margin + b margin
+ + v margin + v margin).
+ v preferredExtent:v extent.
+ b origin:(v margin asPoint).
+ ].
+ b enteredBackgroundColor:(Color grey:80).
+ ] ifFalse:[
+ buttonPanel addSubView:b.
+ ].
+ ]
+ ].
+
+ mh := myMenu height.
+ buttonPanel origin:0.0 @ (mh + spc)
+ corner:(1.0 @ (mh + spc + buttonPanel preferredExtent y)).
+
+ buttonPanel leftInset:spc; rightInset:spc.
+
+ "Modified: 26.4.1997 / 21:02:39 / cg"
+!
+
+setupInfoViewIn:topView
+ "create the infoView"
+
+ |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.
+ projectInfoHolder := '' asValue.
+ infoView labelChannel:projectInfoHolder.
+ self updateInfo.
+
+ Project notNil ifTrue:[
+ Project addDependent:self.
+ ]
+
+ "
+ Launcher open
+ "
+
+ "Modified: 9.9.1996 / 22:44:15 / stefan"
+ "Modified: 28.7.1997 / 18:42:30 / cg"
+!
+
+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.
+"
+!
+
+setupTranscriptIn:aView
+ "create the transcript view"
+
+ |v launcher|
+
+ "/ check if this is an additional launcher on a remote display.
+ "/ if so, do not close the real launcher.
+
+ (Transcript notNil and:[Transcript ~~ Stderr]) ifTrue:[
+ isMainLauncher ifTrue:[
+ launcher := Transcript topView application
+ ] ifFalse:[
+ launcher := self class current.
+ (launcher isNil and: [NewLauncher notNil]) ifTrue: [launcher := NewLauncher current].
+ ].
+
+ launcher notNil ifTrue:[
+ launcher window graphicsDevice == device ifTrue:[
+ OpenLaunchers removeIdentical:launcher ifAbsent:nil.
+ launcher class = NewLauncher
+ ifTrue: [launcher close]
+ ifFalse: [launcher window 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.
+
+ isMainLauncher ifTrue:[
+ transcript beTranscript.
+ ] ifFalse:[
+ transcript showCR:'**************** Notice ***********************'.
+ transcript showCR:'** this is NOT the Transcript **'.
+ transcript showCR:'** The real Transcript is on the main screen **'.
+ transcript showCR:'** **'.
+ transcript showCR:'** Menus affecting common state are disabled **'.
+ transcript showCR:'***********************************************'.
+ ]
+
+ "Modified: 1.2.1997 / 12:08:01 / cg"
+!
+
+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) max:myMenu preferredExtent x)
+ @
+ ((tFont height) * 20).
+
+ "
+ Launcher open
+ "
+
+ "Modified: 9.9.1996 / 22:44:31 / stefan"
+! !
+
+!Launcher methodsFor:'private'!
+
+findWindow:title
+ "a helper for find & destroy and find & raise operations;
+ let user choose a view and return it; return nil on cancel"
+
+ |knownTopViews nameList box|
+
+ knownTopViews := IdentitySet new.
+ Screen allScreens do:[:aScreen |
+ aScreen knownViews do:[:aView |
+ |top showIt wg|
+
+ aView notNil ifTrue:[
+ top := aView topView.
+ (top isKindOf:DebugView) ifTrue:[
+ "/ although modal, show it.
+ showIt := top realized
+ ] ifFalse:[
+ wg := top windowGroup.
+ showIt := (wg notNil and:[wg isModal not]).
+ ].
+ showIt ifTrue:[
+ knownTopViews add:top
+ ]
+ ]
+ ]
+ ].
+
+ knownTopViews := knownTopViews asOrderedCollection.
+ knownTopViews sort:[:v1 :v2 | |l1 l2|
+ l1 := v1 label ? 'aView'.
+ l2 := v2 label ? 'aView'.
+ l1 < l2
+ ].
+ nameList := knownTopViews collect:[:v |
+ |isDead wg p l|
+
+ l := v label ? 'aView'.
+ ((wg := v windowGroup) notNil
+ and:[(p := wg process) notNil
+ and:[p state ~~ #dead]]) ifTrue:[
+ l
+ ] ifFalse:[
+ l , ' (dead ?)'
+ ]
+ ].
+
+ box := ListSelectionBox new.
+ box noEnterField.
+ box list:nameList.
+ box label:(resources string:'view selection').
+ box title:(resources string:title) withCRs.
+ box action:[:selection |
+ |v idx|
+
+ (idx := box selectionIndex) notNil ifTrue:[
+ v := knownTopViews at:idx.
+ ].
+ box destroy.
+ ^ v
+ ].
+ box extent:400@300.
+ box showAtPointer.
+ ^ nil
+
+ "Created: / 14.10.1997 / 11:24:42 / cg"
+ "Modified: / 27.10.1997 / 04:41:08 / cg"
+!
+
+openApplication:className nameSpace:aNameSpace
+ "open some application, given the classes name.
+ Look for it in Smalltalk and the given nameSpace"
+
+ self openApplication:className nameSpace:aNameSpace with:#open
+
+ "Modified: 8.1.1997 / 14:59:42 / cg"
+!
+
+openApplication:className nameSpace:aNameSpace with:aSelector
+ "open some application, given the classes name.
+ Look for it in Smalltalk and the given nameSpace"
+
+ |cls|
+
+ cls := Smalltalk at:className asSymbol.
+ cls isNil ifTrue:[
+ "/ look if its in the nameSpace
+ aNameSpace notNil ifTrue:[
+ cls := aNameSpace at:className asSymbol
+ ]
+ ].
+
+ cls isNil ifTrue:[
+ self warn:(resources string:'Sorry, the %1 class is not available.' with:className).
+ ] ifFalse:[
+ Autoload autoloadFailedSignal handle:[:ex |
+ self warn:(resources string:'Sorry, the %1 class seems to be not available.' with:className)
+ ] do:[
+ cls perform:aSelector
+ ]
+ ]
+
+ "Created: 8.1.1997 / 12:52:13 / cg"
+ "Modified: 8.1.1997 / 14:59:47 / cg"
+!
+
+pickAView
+ "let user pick a view and return it"
+
+ |v|
+
+ (Delay forSeconds:1) wait.
+ v := Screen current viewFromUser.
+ v isNil ifTrue:[
+ self warn:'Sorry, this is not a smalltalk view'.
+ ^ nil
+ ].
+ ^ v
+
+ "Created: 19.10.1997 / 03:04:53 / cg"
+ "Modified: 19.10.1997 / 03:42:00 / cg"
+!
+
+saveAllViews
+ "tell each topview that we are going to terminate and give it chance
+ to save its contents."
+
+ ObjectMemory changed:#aboutToExit
+!
+
+saveScreenImage:anImage defaultName:defaultName
+ "save an image into a file
+ - ask user for filename using a fileSelectionBox."
+
+ |fileName|
+
+ fileName := Dialog
+ requestFileName:(resources string:'save image in:')
+ default:(defaultName , '.tiff')
+ ok:(resources string:'save')
+ abort:(resources string:'cancel')
+ pattern:'*.tiff'.
+
+ fileName notNil ifTrue:[
+ anImage saveOn:fileName
+ ].
+
+ "Modified: 21.2.1996 / 13:09:28 / cg"
+! !
+
+!Launcher methodsFor:'private - settings callBacks'!
+
+changeViewStyleTo:newStyle
+ newStyle notNil ifTrue:[
+ self withWaitCursorDo:[
+ transcript showCR:'change style to ' , newStyle , ' ...'.
+ View defaultStyle:newStyle asSymbol.
+ ].
+ self reopenLauncher.
+ DebugView newDebugger.
+ ]
+
+ "Created: 20.10.1997 / 15:28:10 / cg"
+!
+
+fontBoxForEncoding:encodingMatch
+ "open a fontBox, showing fonts which match some encoding
+ (used when changing to japanese ...)"
+
+ |box y b
+ labelDef buttonDef listDef menuDef textDef
+ models labels allOfThem filter|
+
+ encodingMatch notNil ifTrue:[
+ filter := [:f | f encoding notNil
+ and:[encodingMatch match:f encoding]].
+ ].
+
+ models := OrderedCollection new.
+ labels := OrderedCollection new.
+
+ models add:(allOfThem := nil asValue).
+ models add:(labelDef := Label defaultFont asValue).
+ models add:(buttonDef := Button defaultFont asValue).
+ models add:(listDef := SelectionInListView defaultFont asValue).
+ models add:(menuDef := MenuView defaultFont asValue).
+ models add:(textDef := TextView defaultFont asValue).
+
+ box := Dialog new.
+ box label:(resources string:'Font settings').
+
+ models
+ with:(resources array:#('all' 'labels' 'buttons' 'lists' 'menus' 'edit text'))
+ do:[:model :title |
+ |y2 lbl f i|
+
+ f := model value.
+
+ (box addTextLabel:title) adjust:#left.
+
+ y := box yPosition.
+ b := box addComponent:(Button label:(resources string:'change ...')) tabable:true.
+ b relativeExtent:nil; extent:(b preferredExtent).
+ y2 := box yPosition.
+ box yPosition:y.
+ i := box leftIndent.
+ box leftIndent:(b widthIncludingBorder + View viewSpacing).
+ (lbl := box addTextLabel:'')
+ adjust:#left;
+ font:(model value);
+ labelChannel:(BlockValue
+ with:[:v | |f|
+ f := v value.
+ f isNil ifTrue:[
+ ''
+ ] ifFalse:[
+ f userFriendlyName
+ ]
+ ]
+ argument:model).
+ labels add:lbl.
+
+ box leftIndent:i.
+ box yPosition:(box yPosition max:y2).
+
+ box addVerticalSpace; addHorizontalLine; addVerticalSpace.
+
+ b action:[
+ |f|
+
+ f := FontPanel
+ fontFromUserInitial:(model value)
+ title:(resources string:'font for %1' with:title)
+ filter:filter.
+ f notNil ifTrue:[
+ model == allOfThem ifTrue:[
+ models do:[:m | m value:f].
+ labels do:[:l | l font:f]
+ ] ifFalse:[
+ model value:f.
+ lbl font:f.
+ ].
+ ]
+ ].
+ model == allOfThem ifTrue:[
+ box addVerticalSpace
+ ]
+ ].
+
+ box addAbortButton; addOkButton.
+ (box addButton:(Button label:(resources string:'defaults')) before:nil)
+ action:[
+ "/ fetch defaults
+ View updateAllStyleCaches.
+ labelDef value: Label defaultFont.
+ buttonDef value: Button defaultFont.
+ listDef value: SelectionInListView defaultFont.
+ menuDef value: MenuView defaultFont.
+ textDef value: TextView defaultFont.
+ ].
+
+ box open.
+ box accepted ifTrue:[
+ Label defaultFont:labelDef value.
+ Button defaultFont:buttonDef value.
+ Toggle defaultFont:buttonDef value.
+ SelectionInListView defaultFont:listDef value.
+ MenuView defaultFont:menuDef value.
+ PullDownMenu defaultFont:menuDef value.
+ TextView defaultFont:textDef value.
+ EditTextView defaultFont:textDef value.
+ CodeView defaultFont:textDef value.
+ ].
+ box destroy.
+ ^ box accepted
+
+ "Created: 27.2.1996 / 01:44:16 / cg"
+ "Modified: 17.6.1996 / 13:38:48 / stefan"
+ "Modified: 8.1.1997 / 14:59:11 / cg"
+!
+
+reopenLauncher
+ "reopen a new launcher.
+ for now (since style & language settings currently do
+ not affect living views ...)"
+
+ |contents fontPref enc builder newLauncher|
+
+"/ moved the stuff below to the language-setting
+"/ dialog (ask before changing the language, to have
+"/ proper texts in the dialogs).
+"/
+"/ fontPref := self class classResources at:'PREFERRED_FONT_ENCODING' default:'iso8859*'.
+"/ enc := MenuView defaultFont encoding.
+"/ (fontPref match:enc) ifFalse:[
+"/ (self confirm:'menu font is not ' , fontPref , '-encoded.\\Change it ?' withCRs)
+"/ ifTrue:[
+"/ self fontBoxForEncoding:fontPref
+"/ ]
+"/ ].
+
+ contents := transcript endEntry; list.
+ builder := self class openAt:(self window origin).
+ builder window waitUntilVisible.
+ newLauncher := builder application.
+ newLauncher transcript list:contents; hideCursor; scrollToBottom; cursorToEnd; showCursor
+
+ "Modified: / 6.2.1998 / 00:00:45 / cg"
+! !
+
+!Launcher methodsFor:'queries'!
+
+processName
+ "for monitors only - my name"
+
+ ^ 'ST/X Launcher'
+!
+
+transcript
+ "my transcript"
+
+ ^ transcript
+
+ "Created: 5.7.1996 / 13:04:36 / cg"
+! !
+
+!Launcher::SettingsDialogs class methodsFor:'dialogs'!
+
+compilerSettingsFor:requestor
+ "open a dialog on compiler related settings"
+
|box warnings warnSTX warnUnderscore warnDollar warnOldStyle
allowDollar allowUnderscore immutableArrays
warnSTXBox warnUnderscoreBox warnOldStyleBox warnCommonMistakes warnCommonMistakesBox
@@ -1201,7 +5058,10 @@
constantFoldingOptions constantFolding justInTimeCompilation
warnEnabler check component oldIndent t supportsJustInTimeCompilation y
y2 fullDebugSupport yMax
- compileLazy loadBinaries canLoadBinaries strings idx thisIsADemoVersion|
+ compileLazy loadBinaries canLoadBinaries strings idx thisIsADemoVersion
+ resources|
+
+ resources := requestor class classResources.
canLoadBinaries := ObjectFileLoader notNil and:[ObjectFileLoader canLoadObjectFiles].
loadBinaries := Smalltalk loadBinaries asValue.
@@ -1565,26 +5425,28 @@
"Modified: / 23.4.1998 / 14:28:50 / cg"
!
-displaySettings
+displaySettingsFor:requestor
"open a dialog on display related settings"
|box listOfSizes sizeInfos
sizes sizeNames sizeList sizeX sizeY deepIcons
isColorMonitor useFixPalette useFixGrayPalette idx ditherStyles ditherSyms ditherList
- y component screen visual clipEncodings clipEncodingSyms clipEncodingList|
+ y component screen visual clipEncodings clipEncodingSyms clipEncodingList resources|
+
+ resources := requestor class classResources.
listOfSizes := resources at:'LIST_OF_OFFERED_SCREEN_SIZES' default:#default.
listOfSizes == #default ifTrue:[
- "/ nothing in resource file; offer at least some.
- sizeInfos := #(
- ( '11.3'' (235mm x 175mm) LCD' (235 175) )
- ( '17'' (325mm x 245mm)' (325 245) )
- ( '19'' (340mm x 270mm)' (340 270) )
- ( '20'' (350mm x 280mm)' (350 280) )
- ( '21'' (365mm x 285mm)' (365 285) )
- ).
+ "/ nothing in resource file; offer at least some.
+ sizeInfos := #(
+ ( '11.3'' (235mm x 175mm) LCD' (235 175) )
+ ( '17'' (325mm x 245mm)' (325 245) )
+ ( '19'' (340mm x 270mm)' (340 270) )
+ ( '20'' (350mm x 280mm)' (350 280) )
+ ( '21'' (365mm x 285mm)' (365 285) )
+ ).
] ifFalse:[
- sizeInfos := resources array:listOfSizes.
+ sizeInfos := resources array:listOfSizes.
].
sizeNames := sizeInfos collect:[:entry | entry at:1].
sizes := sizeInfos collect:[:entry | entry at:2].
@@ -1610,43 +5472,43 @@
ditherList := SelectionInList new.
(visual == #StaticGray or:[visual == #GrayScale]) ifTrue:[
- ditherStyles := #('threshold' 'ordered dither' 'error diffusion').
- ditherSyms := #(threshold ordered floydSteinberg).
+ ditherStyles := #('threshold' 'ordered dither' 'error diffusion').
+ ditherSyms := #(threshold ordered floydSteinberg).
] ifFalse:[
- visual ~~ #TrueColor ifTrue:[
- ditherStyles := #('nearest color' 'error diffusion').
- ditherSyms := #(ordered floydSteinberg).
- ]
+ visual ~~ #TrueColor ifTrue:[
+ ditherStyles := #('nearest color' 'error diffusion').
+ ditherSyms := #(ordered floydSteinberg).
+ ]
].
ditherSyms notNil ifTrue:[
- ditherList list:ditherStyles.
- ditherList selectionIndex:(ditherSyms indexOf:(Image ditherAlgorithm) ifAbsent:#threshold).
+ ditherList list:ditherStyles.
+ ditherList selectionIndex:(ditherSyms indexOf:(Image ditherAlgorithm) ifAbsent:#threshold).
].
box := DialogBox new.
box label:(resources string:'Display screen settings').
(box addTextLabel:(resources string:'Actual visible screen area:'))
- adjust:#left.
+ adjust:#left.
(box addPopUpList:(resources string:'common sizes:') on:sizeList)
- label:'monitor size'.
+ label:'monitor size'.
idx := sizes findFirst:[:entry |
- ((entry at:1) = sizeX value)
- and:[((entry at:2) = sizeY value)]
- ].
+ ((entry at:1) = sizeX value)
+ and:[((entry at:2) = sizeY value)]
+ ].
idx ~~ 0 ifTrue:[
- sizeList selectionIndex:idx
+ sizeList selectionIndex:idx
].
sizeList onChangeSend:#value to:[
- |idx|
-
- idx := sizeList selectionIndex.
- sizeX value:((sizes at:idx) at:1).
- sizeY value:((sizes at:idx) at:2).
- ].
+ |idx|
+
+ idx := sizeList selectionIndex.
+ sizeX value:((sizes at:idx) at:1).
+ sizeY value:((sizes at:idx) at:2).
+ ].
y := box yPosition.
component := box addTextLabel:(resources string:'screen size:').
@@ -1655,10 +5517,10 @@
box yPosition:y.
component := box addInputFieldOn:nil tabable:true.
component width:0.25; left:0.3;
- immediateAccept:false; acceptOnLeave:false;
- cursorMovementWhenUpdating:#beginOfLine;
- converter:(PrintConverter new initForInteger);
- model:sizeX.
+ immediateAccept:false; acceptOnLeave:false;
+ cursorMovementWhenUpdating:#beginOfLine;
+ converter:(PrintConverter new initForInteger);
+ model:sizeX.
box yPosition:y.
component := box addTextLabel:(' x ').
@@ -1667,10 +5529,10 @@
box yPosition:y.
component := box addInputFieldOn:nil tabable:true.
component width:0.25; left:0.65;
- immediateAccept:false; acceptOnLeave:false;
- cursorMovementWhenUpdating:#beginOfLine;
- converter:(PrintConverter new initForInteger);
- model:sizeY.
+ immediateAccept:false; acceptOnLeave:false;
+ cursorMovementWhenUpdating:#beginOfLine;
+ converter:(PrintConverter new initForInteger);
+ model:sizeY.
box yPosition:y.
component := box addTextLabel:('(mm)').
@@ -1679,28 +5541,28 @@
box addVerticalSpace; addHorizontalLine; addVerticalSpace.
(box addTextLabel:(resources string:'Screen: depth: %1 visual: %2 (%3)'
- with:Screen current depth printString
- with:Screen current visualType
- with:Screen current serverVendor))
- adjust:#left.
+ with:Screen current depth printString
+ with:Screen current visualType
+ with:Screen current serverVendor))
+ adjust:#left.
box addVerticalSpace; addHorizontalLine; addVerticalSpace.
box addCheckBox:(resources string:'color monitor') on:isColorMonitor.
visual == #PseudoColor ifTrue:[
- box addVerticalSpace.
- component := box addCheckBox:(resources string:'use fix color palette %1' with:'(4x8x4)') on:useFixPalette.
-
- box addVerticalSpace.
- component := box addCheckBox:(resources string:'use fix gray color palette %1' with:'(32)') on:useFixGrayPalette.
+ box addVerticalSpace.
+ component := box addCheckBox:(resources string:'use fix color palette %1' with:'(4x8x4)') on:useFixPalette.
+
+ box addVerticalSpace.
+ component := box addCheckBox:(resources string:'use fix gray color palette %1' with:'(32)') on:useFixGrayPalette.
].
ditherSyms notNil ifTrue:[
- box addVerticalSpace.
- component := box addPopUpList:(resources string:'image display:') on:ditherList.
- component defaultLabel:'image display'.
- component superView horizontalLayout:#leftSpace.
+ box addVerticalSpace.
+ component := box addPopUpList:(resources string:'image display:') on:ditherList.
+ component defaultLabel:'image display'.
+ component superView horizontalLayout:#leftSpace.
].
box addVerticalSpace.
@@ -1712,48 +5574,48 @@
component superView horizontalLayout:#leftSpace.
box
- addHelpButtonFor:'Launcher/screenSettings.html';
- addAbortButton; addOkButton.
+ addHelpButtonFor:'Launcher/screenSettings.html';
+ addAbortButton; addOkButton.
box open.
box accepted ifTrue:[
- Image flushDeviceImages.
-
- screen visualType == #PseudoColor ifTrue:[
- useFixPalette value ifTrue:[
- Color colorAllocationFailSignal handle:[:ex |
- self warn:(resources string:'Could not allocate colors.').
- ] do:[
- Color getColorsRed:4 green:8 blue:4 on:screen
- ]
- ] ifFalse:[
- screen releaseFixColors
- ].
-
- useFixGrayPalette value ifTrue:[
- Color colorAllocationFailSignal handle:[:ex |
- self warn:(resources string:'Could not allocate colors.').
- ] do:[
- Color getGrayColors:32 on:screen
- ]
- ] ifFalse:[
- screen releaseFixGrayColors
- ]
- ].
- screen hasColors:isColorMonitor value.
- screen widthInMillimeter:sizeX value.
- screen heightInMillimeter:sizeY value.
-
- screen supportsDeepIcons:deepIcons value.
- ditherSyms notNil ifTrue:[
- Image ditherAlgorithm:(ditherSyms at:ditherList selectionIndex).
- ].
-
- self withWaitCursorDo:[
- View defaultStyle:(View defaultStyle).
- ].
-
- screen clipBoardEncoding:(clipEncodingSyms at:clipEncodingList selectionIndex).
+ Image flushDeviceImages.
+
+ screen visualType == #PseudoColor ifTrue:[
+ useFixPalette value ifTrue:[
+ Color colorAllocationFailSignal handle:[:ex |
+ self warn:(resources string:'Could not allocate colors.').
+ ] do:[
+ Color getColorsRed:4 green:8 blue:4 on:screen
+ ]
+ ] ifFalse:[
+ screen releaseFixColors
+ ].
+
+ useFixGrayPalette value ifTrue:[
+ Color colorAllocationFailSignal handle:[:ex |
+ self warn:(resources string:'Could not allocate colors.').
+ ] do:[
+ Color getGrayColors:32 on:screen
+ ]
+ ] ifFalse:[
+ screen releaseFixGrayColors
+ ]
+ ].
+ screen hasColors:isColorMonitor value.
+ screen widthInMillimeter:sizeX value.
+ screen heightInMillimeter:sizeY value.
+
+ screen supportsDeepIcons:deepIcons value.
+ ditherSyms notNil ifTrue:[
+ Image ditherAlgorithm:(ditherSyms at:ditherList selectionIndex).
+ ].
+
+ requestor withWaitCursorDo:[
+ View defaultStyle:(View defaultStyle).
+ ].
+
+ screen clipBoardEncoding:(clipEncodingSyms at:clipEncodingList selectionIndex).
].
box destroy
@@ -1761,24 +5623,26 @@
"Modified: 21.7.1997 / 19:26:49 / cg"
!
-fontSettings
+fontSettingsFor:requestor
"open a dialog on font related settings"
- (self fontBoxForEncoding:nil) ifTrue:[
- self reopenLauncher.
+ (self fontBoxForEncoding:nil for:requestor) ifTrue:[
+ requestor reopenLauncher.
]
"Created: 26.2.1996 / 22:52:51 / cg"
"Modified: 8.1.1997 / 14:52:49 / cg"
!
-keyboardSetting
+keyboardSettingsFor:requestor
"open a dialog on keyboard related settings"
|mappings listOfRawKeys listOfFunctions
box l
list1 list2 listView1 listView2
- frame selectionForwarder macroForwarder macroTextView y|
+ frame selectionForwarder macroForwarder macroTextView y resources|
+
+ resources := requestor class classResources.
mappings := Screen current keyboardMap.
@@ -1787,62 +5651,62 @@
selectionForwarder := Plug new.
selectionForwarder respondTo:#showFunction
- with:[
- |raw|
- raw := list1 selection.
- list2 retractInterestsFor:selectionForwarder.
- list2 selection:(mappings at:raw asSymbol) asString.
- list2 onChangeSend:#showRawKey to:selectionForwarder.
- ].
+ with:[
+ |raw|
+ raw := list1 selection.
+ list2 retractInterestsFor:selectionForwarder.
+ list2 selection:(mappings at:raw asSymbol) asString.
+ list2 onChangeSend:#showRawKey to:selectionForwarder.
+ ].
selectionForwarder respondTo:#showRawKey
- with:[
- |f raw|
-
- f := list2 selection.
- list1 retractInterestsFor: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.
- ].
+ with:[
+ |f raw|
+
+ f := list2 selection.
+ list1 retractInterestsFor: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 := [
- |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.
- ].
+ |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.
@@ -1889,9 +5753,9 @@
y := box yPosition.
box
- addHelpButtonFor:'Launcher/keyboardSetting.html';
- "addAbortButton;"
- addOkButtonLabelled:(resources string:'dismiss').
+ addHelpButtonFor:'Launcher/keyboardSetting.html';
+ "addAbortButton;"
+ addOkButtonLabelled:(resources string:'dismiss').
macroTextView topInset:(l preferredExtent y + 5).
macroTextView bottomInset:(box preferredExtent y - y).
@@ -1899,7 +5763,7 @@
box open.
box accepted ifTrue:[
- "no action yet ..."
+ "no action yet ..."
].
box destroy
@@ -1907,10 +5771,12 @@
"Modified: 18.10.1997 / 03:39:41 / cg"
!
-languageSetting
+languageSettingsFor:requestor
"open a dialog on language related settings"
- |listOfLanguages translatedLanguages switch box languageList flags|
+ |listOfLanguages translatedLanguages switch box languageList flags resources|
+
+ resources := requestor class classResources.
"
get list of supported languages from the launchers resources ...
@@ -1944,7 +5810,7 @@
box list:languageList.
box initialText:(Language).
box action:[:newLanguage |
- self withWaitCursorDo:[
+ requestor withWaitCursorDo:[
|fontPref idx language oldLanguage enc answer matchingFonts|
idx := translatedLanguages indexOf:newLanguage withoutSeparators.
@@ -1961,7 +5827,7 @@
oldLanguage := Smalltalk language.
Smalltalk language:language asSymbol.
ResourcePack flushCachedResourcePacks.
- fontPref := self class classResources at:'PREFERRED_FONT_ENCODING' default:'iso8859*'.
+ fontPref := resources at:'PREFERRED_FONT_ENCODING' default:'iso8859*'.
Smalltalk language:oldLanguage.
switch := true.
@@ -1996,13 +5862,13 @@
].
switch ifTrue:[
- transcript showCR:'change language to ' , newLanguage , ' ...'.
+ Transcript showCR:'change language to ' , newLanguage , ' ...'.
Smalltalk language:language asSymbol.
ResourcePack flushCachedResourcePacks
].
].
switch ifTrue:[
- self reopenLauncher.
+ requestor reopenLauncher.
DebugView newDebugger.
]
].
@@ -2015,12 +5881,14 @@
"Modified: / 6.2.1998 / 00:00:38 / cg"
!
-memorySettings
+memorySettingsFor:requestor
"open a dialog on objectMemory related settings"
|box igcLimit igcFreeLimit igcFreeAmount newSpaceSize
compressLimit
- oldIncr component fields codeLimit codeTrigger stackLimit|
+ oldIncr component fields codeLimit codeTrigger stackLimit resources|
+
+ resources := requestor class classResources.
"/
"/ extract relevant system settings ...
@@ -2049,11 +5917,11 @@
box addHorizontalLine.
component := box
- addLabelledInputField:(resources string:'size of newSpace:')
- adjust:#right
- on:nil "/ newSpaceSize
- tabable:true
- separateAtX:0.7.
+ addLabelledInputField:(resources string:'size of newSpace:')
+ adjust:#right
+ on:nil "/ newSpaceSize
+ tabable:true
+ separateAtX:0.7.
component acceptOnLeave:false.
component converter:(PrintConverter new initForNumber).
component model:newSpaceSize.
@@ -2063,11 +5931,11 @@
component := box
- addLabelledInputField:(resources string:'incremental GC allocation trigger:')
- adjust:#right
- on:nil "/ igcLimit
- tabable:true
- separateAtX:0.7.
+ addLabelledInputField:(resources string:'incremental GC allocation trigger:')
+ adjust:#right
+ on:nil "/ igcLimit
+ tabable:true
+ separateAtX:0.7.
component acceptOnLeave:false.
component converter:(PrintConverter new initForNumber).
component model:igcLimit.
@@ -2077,11 +5945,11 @@
box addHorizontalLine.
component := box
- addLabelledInputField:(resources string:'incremental GC freespace trigger:')
- adjust:#right
- on:nil "/ igcFreeLimit
- tabable:true
- separateAtX:0.7.
+ addLabelledInputField:(resources string:'incremental GC freespace trigger:')
+ adjust:#right
+ on:nil "/ igcFreeLimit
+ tabable:true
+ separateAtX:0.7.
component acceptOnLeave:false.
component converter:(PrintConverter new initForNumber).
component model:igcFreeLimit.
@@ -2091,11 +5959,11 @@
box addHorizontalLine.
component := box
- addLabelledInputField:(resources string:'incremental GC amount:')
- adjust:#right
- on:nil "/ igcFreeAmount
- tabable:true
- separateAtX:0.7.
+ addLabelledInputField:(resources string:'incremental GC amount:')
+ adjust:#right
+ on:nil "/ igcFreeAmount
+ tabable:true
+ separateAtX:0.7.
component acceptOnLeave:false.
component converter:(PrintConverter new initForNumber).
component model:igcFreeAmount.
@@ -2105,11 +5973,11 @@
box addHorizontalLine.
component := box
- addLabelledInputField:(resources string:'oldspace increment:')
- adjust:#right
- on:nil "/ oldIncr
- tabable:true
- separateAtX:0.7.
+ addLabelledInputField:(resources string:'oldspace increment:')
+ adjust:#right
+ on:nil "/ oldIncr
+ tabable:true
+ separateAtX:0.7.
component acceptOnLeave:false.
component converter:(PrintConverter new initForNumber).
component model:oldIncr.
@@ -2119,11 +5987,11 @@
box addHorizontalLine.
component := box
- addLabelledInputField:(resources string:'oldspace compress limit:')
- adjust:#right
- on:nil "/ compressLimit
- tabable:true
- separateAtX:0.7.
+ addLabelledInputField:(resources string:'oldspace compress limit:')
+ adjust:#right
+ on:nil "/ compressLimit
+ tabable:true
+ separateAtX:0.7.
component acceptOnLeave:false.
component converter:(PrintConverter new initForNumber).
component model:compressLimit.
@@ -2133,11 +6001,11 @@
box addHorizontalLine.
component := box
- addLabelledInputField:(resources string:'stack limit:')
- adjust:#right
- on:nil
- tabable:true
- separateAtX:0.7.
+ addLabelledInputField:(resources string:'stack limit:')
+ adjust:#right
+ on:nil
+ tabable:true
+ separateAtX:0.7.
component acceptOnLeave:false.
component converter:(PrintConverter new initForNumber).
component model:stackLimit.
@@ -2147,38 +6015,38 @@
box addHorizontalLine.
ObjectMemory supportsJustInTimeCompilation ifTrue:[
- component := box
- addLabelledInputField:(resources string:'dynamic code limit:')
- adjust:#right
- on:nil
- tabable:true
- separateAtX:0.7.
- component acceptOnLeave:false.
- component converter:(PrintConverter new initForNumberOrNil).
- component model:codeLimit.
- fields add:component.
-
- box addTextLabel:'(flush dynamic compiled code to stay within this limit)'.
- box addHorizontalLine.
-
- component := box
- addLabelledInputField:(resources string:'dynamic code GC trigger:')
- adjust:#right
- on:nil
- tabable:true
- separateAtX:0.7.
- component acceptOnLeave:false.
- component converter:(PrintConverter new initForNumberOrNil).
- component model:codeTrigger.
- fields add:component.
-
- box addTextLabel:'(start incremental GC whenever this amount of code has been allocated)'.
- box addHorizontalLine.
+ component := box
+ addLabelledInputField:(resources string:'dynamic code limit:')
+ adjust:#right
+ on:nil
+ tabable:true
+ separateAtX:0.7.
+ component acceptOnLeave:false.
+ component converter:(PrintConverter new initForNumberOrNil).
+ component model:codeLimit.
+ fields add:component.
+
+ box addTextLabel:'(flush dynamic compiled code to stay within this limit)'.
+ box addHorizontalLine.
+
+ component := box
+ addLabelledInputField:(resources string:'dynamic code GC trigger:')
+ adjust:#right
+ on:nil
+ tabable:true
+ separateAtX:0.7.
+ component acceptOnLeave:false.
+ component converter:(PrintConverter new initForNumberOrNil).
+ component model:codeTrigger.
+ fields add:component.
+
+ box addTextLabel:'(start incremental GC whenever this amount of code has been allocated)'.
+ box addHorizontalLine.
].
box addAbortButton; addOkButton.
box
- addHelpButtonFor:'Launcher/memorySettings.html'.
+ addHelpButtonFor:'Launcher/memorySettings.html'.
"/
"/ show the box ...
@@ -2189,39 +6057,41 @@
"/ update system settings
"/
box accepted ifTrue:[
- fields do:[:comp | comp accept].
-
- igcFreeAmount value ~~ ObjectMemory freeSpaceGCAmount ifTrue:[
- ObjectMemory freeSpaceGCAmount:igcFreeAmount value.
- ].
- igcFreeLimit value ~~ ObjectMemory freeSpaceGCLimit ifTrue:[
- ObjectMemory freeSpaceGCLimit:igcFreeLimit value.
- ].
- igcLimit value ~~ ObjectMemory incrementalGCLimit ifTrue:[
- ObjectMemory incrementalGCLimit:igcLimit value.
- ].
- newSpaceSize value ~~ ObjectMemory newSpaceSize ifTrue:[
- ObjectMemory newSpaceSize:newSpaceSize value.
- ].
- oldIncr value ~~ ObjectMemory oldSpaceIncrement ifTrue:[
- ObjectMemory oldSpaceIncrement:oldIncr value.
- ].
- stackLimit value ~~ Process defaultMaximumStackSize ifTrue:[
- Process defaultMaximumStackSize:stackLimit value.
- ].
- ObjectMemory oldSpaceCompressLimit:compressLimit value.
- ObjectMemory dynamicCodeLimit:codeLimit value.
- ObjectMemory dynamicCodeGCTrigger:codeTrigger value.
+ fields do:[:comp | comp accept].
+
+ igcFreeAmount value ~~ ObjectMemory freeSpaceGCAmount ifTrue:[
+ ObjectMemory freeSpaceGCAmount:igcFreeAmount value.
+ ].
+ igcFreeLimit value ~~ ObjectMemory freeSpaceGCLimit ifTrue:[
+ ObjectMemory freeSpaceGCLimit:igcFreeLimit value.
+ ].
+ igcLimit value ~~ ObjectMemory incrementalGCLimit ifTrue:[
+ ObjectMemory incrementalGCLimit:igcLimit value.
+ ].
+ newSpaceSize value ~~ ObjectMemory newSpaceSize ifTrue:[
+ ObjectMemory newSpaceSize:newSpaceSize value.
+ ].
+ oldIncr value ~~ ObjectMemory oldSpaceIncrement ifTrue:[
+ ObjectMemory oldSpaceIncrement:oldIncr value.
+ ].
+ stackLimit value ~~ Process defaultMaximumStackSize ifTrue:[
+ Process defaultMaximumStackSize:stackLimit value.
+ ].
+ ObjectMemory oldSpaceCompressLimit:compressLimit value.
+ ObjectMemory dynamicCodeLimit:codeLimit value.
+ ObjectMemory dynamicCodeGCTrigger:codeTrigger value.
].
box destroy
"Modified: 27.2.1997 / 16:50:12 / cg"
!
-messageSettings
+messageSettingsFor:requestor
"open a dialog on infoMessage related settings"
- |box vmInfo vmErrors displayErrors classInfos|
+ |box vmInfo vmErrors displayErrors classInfos resources|
+
+ resources := requestor class classResources.
vmInfo := ObjectMemory infoPrinting asValue.
vmErrors := ObjectMemory debugPrinting asValue.
@@ -2243,22 +6113,24 @@
box open.
box accepted ifTrue:[
- ObjectMemory infoPrinting:vmInfo value.
- ObjectMemory debugPrinting:vmErrors value.
- Object infoPrinting:classInfos value.
- DeviceWorkstation errorPrinting:displayErrors value.
+ ObjectMemory infoPrinting:vmInfo value.
+ ObjectMemory debugPrinting:vmErrors value.
+ Object infoPrinting:classInfos value.
+ DeviceWorkstation errorPrinting:displayErrors value.
].
box destroy
"Modified: 27.1.1997 / 17:46:01 / cg"
!
-miscSettings
+miscSettingsFor:requestor
"open a dialog on misc other settings"
|box shadows takeFocus returnFocus
hostNameInLabel showAccelerators
- preemptive hostNameInLabelHolder st80EditingMode|
+ preemptive hostNameInLabelHolder st80EditingMode resources|
+
+ resources := requestor class classResources.
"/
"/ extract relevant system settings ...
@@ -2295,9 +6167,9 @@
box addCheckBox:(resources string:'st80 cursor behavior in editTextView') on:st80EditingMode.
box
- addHelpButtonFor:'Launcher/miscSettings.html';
- addAbortButton;
- addOkButton.
+ addHelpButtonFor:'Launcher/miscSettings.html';
+ addAbortButton;
+ addOkButton.
"/
"/ show the box ...
@@ -2308,40 +6180,41 @@
"/ update system settings
"/
box accepted ifTrue:[
- PopUpView shadows:shadows value.
- hostNameInLabelHolder value ~~ hostNameInLabel ifTrue:[
- StandardSystemView includeHostNameInLabel:hostNameInLabelHolder value.
-
- Screen allScreens do:[:aDisplay |
- aDisplay allViewsDo:[:aView |
- |l|
-
- aView isTopView ifTrue:[
- l := aView label.
- aView label:(l , ' '); label:l. "/ force a change
- ]
- ]
- ]
- ].
- StandardSystemView returnFocusWhenClosingModalBoxes:returnFocus value.
- StandardSystemView takeFocusWhenMapped:takeFocus value.
- MenuView showAcceleratorKeys:showAccelerators value.
- Processor isTimeSlicing ~~ preemptive value ifTrue:[
- preemptive value ifTrue:[
- Processor startTimeSlicing
- ] ifFalse:[
- Processor stopTimeSlicing
- ]
- ].
- EditTextView st80Mode:(st80EditingMode value)
+ PopUpView shadows:shadows value.
+ hostNameInLabelHolder value ~~ hostNameInLabel ifTrue:[
+ StandardSystemView includeHostNameInLabel:hostNameInLabelHolder value.
+
+ Screen allScreens do:[:aDisplay |
+ aDisplay allViewsDo:[:aView |
+ |l|
+
+ aView isTopView ifTrue:[
+ l := aView label.
+ aView label:(l , ' '); label:l. "/ force a change
+ ]
+ ]
+ ]
+ ].
+ StandardSystemView returnFocusWhenClosingModalBoxes:returnFocus value.
+ StandardSystemView takeFocusWhenMapped:takeFocus value.
+ MenuView showAcceleratorKeys:showAccelerators value.
+ Processor isTimeSlicing ~~ preemptive value ifTrue:[
+ preemptive value ifTrue:[
+ Processor startTimeSlicing
+ ] ifFalse:[
+ Processor stopTimeSlicing
+ ]
+ ].
+ EditTextView st80Mode:(st80EditingMode value)
].
box destroy
"Modified: / 9.9.1996 / 22:43:36 / stefan"
"Modified: / 16.1.1998 / 22:56:57 / cg"
+
!
-printerSettings
+printerSettingsFor:requestor
"open a dialog on printer related settings"
|box
@@ -2352,7 +6225,9 @@
topMarginComponent leftMarginComponent
rightMarginComponent
bottomMarginComponent supportsColor supportsColorComponent
- y y1 commandListPop component commandList row|
+ y y1 commandListPop component commandList row resources|
+
+ resources := requestor class classResources.
possiblePrinters := PrinterStream withAllSubclasses asArray.
possibleTypes := possiblePrinters collect:[:cls | cls printerTypeName].
@@ -2399,12 +6274,12 @@
commandList := resources at:'PRINT_COMMANDS' ifAbsent:nil.
commandList isNil ifTrue:[
- commandList := PrinterStream defaultCommands.
- commandList isNil ifTrue:[
- commandList := #('lpr'
- 'lp'
- ).
- ]
+ commandList := PrinterStream defaultCommands.
+ commandList isNil ifTrue:[
+ commandList := #('lpr'
+ 'lp'
+ ).
+ ]
].
commandListPop list:commandList.
@@ -2423,24 +6298,24 @@
y := box yPosition.
box
- addRow:(1 to:2)
- fromX:0
- toX:0.5
- collect:[:idx | row at:idx]
- tabable:false
- horizontalLayout:#leftSpace
- verticalLayout:#center.
+ addRow:(1 to:2)
+ fromX:0
+ toX:0.5
+ collect:[:idx | row at:idx]
+ tabable:false
+ horizontalLayout:#leftSpace
+ verticalLayout:#center.
y1 := box yPosition.
box yPosition:y.
box
- addRow:(3 to:4)
- fromX:0.5
- toX:1.0
- collect:[:idx | row at:idx]
- tabable:false
- horizontalLayout:#leftSpace
- verticalLayout:#center.
+ addRow:(3 to:4)
+ fromX:0.5
+ toX:1.0
+ collect:[:idx | row at:idx]
+ tabable:false
+ horizontalLayout:#leftSpace
+ verticalLayout:#center.
box yPosition:(box yPosition max:y1).
@@ -2452,12 +6327,12 @@
y := box yPosition.
topMarginComponent := box
- addLabelledInputField:(resources string:'top margin:')
- adjust:#right
- on:nil "/ topMargin
- tabable:true
- from:0.0 to:0.5
- separateAtX:0.6.
+ addLabelledInputField:(resources string:'top margin:')
+ adjust:#right
+ on:nil "/ topMargin
+ tabable:true
+ from:0.0 to:0.5
+ separateAtX:0.6.
topMarginComponent converter:(PrintConverter new initForNumber).
topMarginComponent model:topMargin.
y1 := box yPosition.
@@ -2468,38 +6343,38 @@
component := box addComponent:(PopUpList on:unitList).
component
- left:0.6;
- width:0.3.
+ left:0.6;
+ width:0.3.
box yPosition:y1.
leftMarginComponent := box
- addLabelledInputField:(resources string:'left margin:')
- adjust:#right
- on:nil "/ leftMargin
- tabable:true
- from:0.0 to:0.5
- separateAtX:0.6.
+ addLabelledInputField:(resources string:'left margin:')
+ adjust:#right
+ on:nil "/ leftMargin
+ tabable:true
+ from:0.0 to:0.5
+ separateAtX:0.6.
leftMarginComponent converter:(PrintConverter new initForNumber).
leftMarginComponent model:leftMargin.
rightMarginComponent := box
- addLabelledInputField:(resources string:'right margin:')
- adjust:#right
- on:nil "/ rightMargin
- tabable:true
- from:0.0 to:0.5
- separateAtX:0.6.
+ addLabelledInputField:(resources string:'right margin:')
+ adjust:#right
+ on:nil "/ rightMargin
+ tabable:true
+ from:0.0 to:0.5
+ separateAtX:0.6.
rightMarginComponent converter:(PrintConverter new initForNumber).
rightMarginComponent model:rightMargin.
bottomMarginComponent := box
- addLabelledInputField:(resources string:'bottom margin:')
- adjust:#right
- on:nil "/ bottomMargin
- tabable:true
- from:0.0 to:0.5
- separateAtX:0.6.
+ addLabelledInputField:(resources string:'bottom margin:')
+ adjust:#right
+ on:nil "/ bottomMargin
+ tabable:true
+ from:0.0 to:0.5
+ separateAtX:0.6.
bottomMarginComponent converter:(PrintConverter new initForNumber).
bottomMarginComponent model:bottomMargin.
@@ -2509,146 +6384,152 @@
updater := [ |p fg hasPageSize hasMargins|
- printerType selectionIndex ~~ 0 ifTrue:[
- p := possiblePrinters at:(printerType selectionIndex).
- hasPageSize := p supportsPageSizes.
- hasMargins := p supportsMargins.
- ] ifFalse:[
- hasPageSize := false.
- hasMargins := false.
- ].
- hasPageSize ifTrue:[
- fg := Button new foregroundColor.
- formatComponent enable.
- landscapeComponent enable.
-
- formatComponent label:p pageFormat.
- pageFormat value:(p pageFormat).
- landscape value:(p landscape).
- ] ifFalse:[
- fg := Button new disabledForegroundColor.
- formatComponent disable.
- landscapeComponent disable.
-
- formatComponent label:'unknown'.
- landscape value:nil.
- ].
- hasMargins ifTrue:[
- unitList selectionIndex == 2 ifTrue:[
- unit := #mm
- ] ifFalse:[
- unit := #inch
- ].
-
- topMargin value:(UnitConverter convert:p topMargin from:#inch to:unit).
- leftMargin value:(UnitConverter convert:p leftMargin from:#inch to:unit).
- rightMargin value:(UnitConverter convert:p rightMargin from:#inch to:unit).
- bottomMargin value:(UnitConverter convert:p bottomMargin from:#inch to:unit).
-
- topMarginComponent enable.
- leftMarginComponent enable.
- rightMarginComponent enable.
- bottomMarginComponent enable.
- ] ifFalse:[
- topMarginComponent disable.
- leftMarginComponent disable.
- rightMarginComponent disable.
- bottomMarginComponent disable.
- ].
- formatLabel foregroundColor:fg.
- landscapeLabel foregroundColor:fg.
-
- p notNil ifTrue:[
- commandList := p defaultCommands.
- commandList notNil ifTrue:[
- commandListPop list:commandList
- ].
-
- printCommand value:(p printCommand).
- ].
- p supportsPostscript ifFalse:[
- supportsColorComponent disable.
- supportsColor value:false
- ] ifTrue:[
- supportsColorComponent enable.
- supportsColor value:(Printer supportsColor).
- ]
- ].
+ printerType selectionIndex ~~ 0 ifTrue:[
+ p := possiblePrinters at:(printerType selectionIndex).
+ hasPageSize := p supportsPageSizes.
+ hasMargins := p supportsMargins.
+ ] ifFalse:[
+ hasPageSize := false.
+ hasMargins := false.
+ ].
+ hasPageSize ifTrue:[
+ fg := Button new foregroundColor.
+ formatComponent enable.
+ landscapeComponent enable.
+
+ formatComponent label:p pageFormat.
+ pageFormat value:(p pageFormat).
+ landscape value:(p landscape).
+ ] ifFalse:[
+ fg := Button new disabledForegroundColor.
+ formatComponent disable.
+ landscapeComponent disable.
+
+ formatComponent label:'unknown'.
+ landscape value:nil.
+ ].
+ hasMargins ifTrue:[
+ unitList selectionIndex == 2 ifTrue:[
+ unit := #mm
+ ] ifFalse:[
+ unit := #inch
+ ].
+
+ topMargin value:(UnitConverter convert:p topMargin from:#inch to:unit).
+ leftMargin value:(UnitConverter convert:p leftMargin from:#inch to:unit).
+ rightMargin value:(UnitConverter convert:p rightMargin from:#inch to:unit).
+ bottomMargin value:(UnitConverter convert:p bottomMargin from:#inch to:unit).
+
+ topMarginComponent enable.
+ leftMarginComponent enable.
+ rightMarginComponent enable.
+ bottomMarginComponent enable.
+ ] ifFalse:[
+ topMarginComponent disable.
+ leftMarginComponent disable.
+ rightMarginComponent disable.
+ bottomMarginComponent disable.
+ ].
+ formatLabel foregroundColor:fg.
+ landscapeLabel foregroundColor:fg.
+
+ p notNil ifTrue:[
+ commandList := p defaultCommands.
+ commandList notNil ifTrue:[
+ commandListPop list:commandList
+ ].
+
+ printCommand value:(p printCommand).
+ ].
+ p supportsPostscript ifFalse:[
+ supportsColorComponent disable.
+ supportsColor value:false
+ ] ifTrue:[
+ supportsColorComponent enable.
+ supportsColor value:(Printer supportsColor).
+ ]
+ ].
unitList onChangeSend:#value to:updater.
printerType onChangeSend:#value to:updater.
updater value.
box addVerticalSpace;
- addHelpButtonFor:'Launcher/printerSettings.html';
- addAbortButton; addOkButton.
+ addHelpButtonFor:'Launcher/printerSettings.html';
+ addAbortButton; addOkButton.
box open.
box accepted ifTrue:[
- Printer := possiblePrinters at:(printerType selectionIndex).
- Printer printCommand:printCommand value.
-
- Printer supportsPageSizes ifTrue:[
- Printer pageFormat:(pageFormat selection).
- Printer landscape:(landscape value).
- ].
- Printer supportsMargins ifTrue:[
- unitList selectionIndex == 2 ifTrue:[
- unit := #mm
- ] ifFalse:[
- unit := #inch
- ].
- Printer topMargin:(UnitConverter convert:topMargin value from:unit to:#inch).
- Printer leftMargin:(UnitConverter convert:leftMargin value from:unit to:#inch).
- Printer rightMargin:(UnitConverter convert:rightMargin value from:unit to:#inch).
- Printer bottomMargin:(UnitConverter convert:bottomMargin value from:unit to:#inch).
- ].
- Printer supportsPostscript ifTrue:[
- Printer supportsColor:supportsColor value.
- ].
+ Printer := possiblePrinters at:(printerType selectionIndex).
+ Printer printCommand:printCommand value.
+
+ Printer supportsPageSizes ifTrue:[
+ Printer pageFormat:(pageFormat selection).
+ Printer landscape:(landscape value).
+ ].
+ Printer supportsMargins ifTrue:[
+ unitList selectionIndex == 2 ifTrue:[
+ unit := #mm
+ ] ifFalse:[
+ unit := #inch
+ ].
+ Printer topMargin:(UnitConverter convert:topMargin value from:unit to:#inch).
+ Printer leftMargin:(UnitConverter convert:leftMargin value from:unit to:#inch).
+ Printer rightMargin:(UnitConverter convert:rightMargin value from:unit to:#inch).
+ Printer bottomMargin:(UnitConverter convert:bottomMargin value from:unit to:#inch).
+ ].
+ Printer supportsPostscript ifTrue:[
+ Printer supportsColor:supportsColor value.
+ ].
].
box destroy
"Modified: 9.9.1996 / 22:43:51 / stefan"
"Modified: 28.2.1997 / 14:00:13 / cg"
+
!
-restoreSettings
+restoreSettingsFor:requestor
"restore settings from a settings-file."
"a temporary kludge - we need a central systemSettings object for this,
which can be saved/restored with a single store/read."
- |fileName|
+ |fileName resources|
+
+ resources := requestor class classResources.
fileName := Dialog
- requestFileName:(resources string:'restore settings from:')
- default:'settings.stx'
- ok:(resources string:'restore')
- abort:(resources string:'cancel')
- pattern:'*.stx'
- fromDirectory:nil.
+ requestFileName:(resources string:'restore settings from:')
+ default:'settings.stx'
+ ok:(resources string:'restore')
+ abort:(resources string:'cancel')
+ pattern:'*.stx'
+ fromDirectory:nil.
(fileName isNil or:[fileName isEmpty]) ifTrue:[
- "/ canceled
- ^ self
+ "/ canceled
+ ^ self
].
self withWaitCursorDo:[
- Smalltalk fileIn:fileName.
-
- self reopenLauncher.
+ Smalltalk fileIn:fileName.
+
+ self reopenLauncher.
].
"Modified: 8.1.1997 / 14:53:52 / cg"
+
!
-saveSettings
+saveSettingsFor:requestor
"save settings to a settings-file."
"a temporary kludge - we need a central systemSettings object for this,
which can be saved/restored with a single store/read."
- |s screen fileName|
+ |s screen fileName resources|
+
+ resources := requestor class classResources.
fileName := Dialog
requestFileName:(resources string:'save settings in:')
@@ -2829,9 +6710,10 @@
"
"Modified: / 1.4.1998 / 12:18:15 / cg"
+
!
-sourceAndDebuggerSettings
+sourceAndDebuggerSettingsFor:requestor
"open a dialog on misc other settings"
|box check logDoits updChanges changeFileName
@@ -2840,7 +6722,9 @@
sourceCacheDir cacheEntry
component localCheck oldIndent nm fn manager
keepMethodHistory showErrorNotifier showVerboseStack
- syntaxColoring|
+ syntaxColoring resources|
+
+ resources := requestor class classResources.
"/
"/ extract relevant system settings ...
@@ -3020,35 +6904,38 @@
"Created: / 17.1.1997 / 17:39:33 / cg"
"Modified: / 3.4.1998 / 12:28:10 / cg"
"Modified: / 16.4.1998 / 17:18:47 / ca"
+
!
-viewStyleSetting
+viewStyleSettingsFor:requestor
"open a dialog on viewStyle related settings"
|listOfStyles resourceDir dir box
list listView scrView infoLabel infoForwarder newStyle
- someRsrcFile b didApply|
+ someRsrcFile b didApply resources|
+
+ resources := requestor class classResources.
"
search resources directory for a list of .style files ...
"
someRsrcFile := Smalltalk getSystemFileName:('resources' asFilename constructString:'normal.style').
someRsrcFile notNil ifTrue:[
- resourceDir := someRsrcFile asFilename directoryName
+ resourceDir := someRsrcFile asFilename directoryName
] ifFalse:[
- resourceDir := Smalltalk getSystemFileName:'resources'.
+ resourceDir := Smalltalk getSystemFileName:'resources'.
].
resourceDir isNil ifTrue:[
- self warn:'no styles found (missing ''resources'' directory)'.
- ^ self
+ self warn:'no styles found (missing ''resources'' directory)'.
+ ^ self
].
dir := resourceDir asFilename directoryContents.
listOfStyles := dir select:[:aFileName | aFileName asFilename hasSuffix:'style'].
listOfStyles := listOfStyles collect:[:aFileName | aFileName asFilename withoutSuffix name].
Filename isCaseSensitive ifFalse:[
- listOfStyles := listOfStyles collect:[:aStyleName | aStyleName asLowercase].
+ listOfStyles := listOfStyles collect:[:aStyleName | aStyleName asLowercase].
].
listOfStyles sort.
@@ -3072,12 +6959,12 @@
"/ new code: build box 'by 'hand'
"/
infoForwarder := [
- |nm sheet comment|
- nm := list selection.
- sheet := ViewStyle fromFile:(nm , '.style').
- comment := sheet at:#comment ifAbsent:''.
- infoLabel label:comment withCRs asStringCollection
- ].
+ |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:#value to:infoForwarder.
@@ -3096,7 +6983,7 @@
box addAbortButton.
b := box addButton:(Button label:(resources string:'apply')).
- b action:[didApply := true. self changeViewStyleTo:(list selection)].
+ b action:[didApply := true. requestor changeViewStyleTo:(list selection)].
box addOkButton.
list selection:(View defaultStyle).
@@ -3104,1682 +6991,37 @@
box stickAtBottomWithFixHeight:infoLabel.
box open.
+ box destroy.
box accepted ifTrue:[
- ((newStyle := list selection) ~= View defaultStyle
- or:[didApply ~~ true]) ifTrue:[
- self changeViewStyleTo:newStyle.
- ].
- ].
- box destroy
-
- "Modified: 20.10.1997 / 15:30:27 / cg"
-! !
-
-!Launcher methodsFor:'actions - tools'!
-
-compressingGarbageCollect
- "perform a compressing garbageCollect"
-
- ObjectMemory verboseGarbageCollect
-
- "Created: 12.5.1996 / 15:30:15 / cg"
- "Modified: 8.1.1997 / 14:54:21 / cg"
-!
-
-deIconifyAllWindows
- |setOfViews|
-
- setOfViews := Project current views asIdentitySet.
- setOfViews addAll:(Project defaultProject views).
-
- setOfViews do:[:aTopView |
- aTopView device == Screen current ifTrue:[
- aTopView expand
- ].
+ ((newStyle := list selection) ~= View defaultStyle
+ or:[didApply ~~ true]) ifTrue:[
+ requestor changeViewStyleTo:newStyle.
+ ].
].
"
- Transcript topView application deIconifyAllWindows
+ self viewStyleSettingsFor:nil
"
- "Modified: 3.3.1997 / 14:13:24 / cg"
-!
-
-findAndDestroyWindow
- "find a window (by name) and destroy it"
-
- |v|
-
- v := self findWindow:'select view to close:'.
- v notNil ifTrue:[
- v destroy.
- ].
-
- "Created: 28.10.1996 / 14:39:23 / cg"
- "Modified: 14.10.1997 / 11:25:37 / cg"
-!
-
-findAndRaiseWindow
- "find a window (by name) and raise it"
-
- |v|
-
- v := self findWindow:'select view to raise deiconified:'.
- v notNil ifTrue:[
- v raiseDeiconified.
- ].
-
- "Modified: 14.10.1997 / 11:25:42 / cg"
-!
-
-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
-
- "Modified: 23.9.1996 / 14:36:14 / cg"
-!
-
-garbageCollect
- "perform a non-compressing garbageCollect"
-
- ObjectMemory reclaimSymbols
-
- "Created: 12.5.1996 / 15:28:03 / cg"
- "Modified: 8.1.1997 / 14:54:29 / cg"
-!
-
-globalGarbageCollect
- "perform a non-compressing garbageCollect"
-
- ObjectMemory reclaimSymbols
-
- "Created: 12.5.1996 / 15:28:13 / cg"
- "Modified: 8.1.1997 / 14:54:36 / cg"
-!
-
-iconifyAllWindows
- |setOfViews|
-
- setOfViews := Project current views asIdentitySet.
- setOfViews addAll:(Project defaultProject views).
-
- setOfViews do:[:aTopView |
- aTopView device == Screen current ifTrue:[
- aTopView collapse
- ]
- ]
-
- "Created: 1.3.1997 / 20:10:58 / cg"
- "Modified: 3.3.1997 / 14:13:11 / cg"
-!
-
-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:[
- [Screen current leftButtonPressed] whileTrue:[Processor yield].
-
- area := Rectangle fromUser.
- (area width > 0 and:[area height > 0]) ifTrue:[
- self saveScreenImage:(Image fromScreen:area) defaultName:'hardcopy'
- ]
- ]
- afterSeconds:1
-
- "Modified: 13.2.1997 / 16:02:35 / cg"
-!
-
-startApplication:aSymbol
- "start an application,
- popup warnbox if application is not present or autoload failed"
-
- |app|
-
- app := Smalltalk classNamed:aSymbol.
- app isBehavior ifTrue:[
- app isLoaded ifFalse:[
- Autoload autoloadFailedSignal handle:[:ex|
- ^ self warn:(resources string:'Sorry - cannot load %1' with:app name).
- ] do:[
- app autoload.
- ].
- ].
- app open.
- ] ifFalse:[
- self warn:(resources string:'Sorry - %1 is only available
-in the full commercial release' with:aSymbol asString).
- ]
-
- "Created: / 19.12.1997 / 13:00:29 / stefan"
- "Modified: / 19.12.1997 / 14:09:46 / stefan"
-!
-
-startFullWindowTreeView
- "open a windowTree view (on all views)"
-
- WindowTreeView open
-
- "Modified: 8.1.1997 / 14:56:04 / cg"
-!
-
-startGUIBuilder
- "open a GUIBuilder view"
-
- UIPainter open
-
- "Modified: 8.1.1997 / 14:56:14 / cg"
- "Created: 25.7.1997 / 10:56:30 / cg"
-!
-
-startNewLauncher
- "open a real new launcher"
-
- NewLauncher openAt:(self window origin)
-
- "Modified: / 5.2.1998 / 19:31:41 / cg"
-!
-
-startStopEventTrace
- "start/stop event tracing for a particular view"
-
- |v wg|
-
- v := Screen current viewFromUser.
- v notNil ifTrue:[
- v := v topView.
- wg := v windowGroup.
- wg notNil ifTrue:[
- "/
- "/ toggle eventTrace in its windowGroup
- "/
- wg traceEvents:(wg preEventHook isNil)
- ]
- ]
-
- "Created: 7.3.1996 / 14:44:22 / cg"
- "Modified: 8.1.1997 / 14:56:44 / cg"
-!
-
-startWindowTreeView
- "open a windowTree view (on a topView)"
-
- |v|
-
- v := self pickAView.
- v notNil ifTrue:[
- WindowTreeView openOn:v topView
- ]
-
- "Modified: 8.1.1997 / 14:55:59 / cg"
-!
-
-viewDestroy
- "let user pick a view and destroy it.
- Even allow destroying non-smalltalk views
- (also for views which I forgot due to some error)"
-
- |device p v id i c|
-
- (Delay forSeconds:1) wait.
-
- device := Screen current.
- i := Image fromFile:'bitmaps/xpmBitmaps/cursors/cross2.xpm'.
- i isNil ifTrue:[
- c := Cursor crossHair
- ] ifFalse:[
- c := Cursor fromImage:i
- ].
- p := device pointFromUserShowing:c.
- id := device viewIdFromPoint:p.
- v := device viewFromId:id.
- v notNil ifTrue:[
- v topView destroy.
- ^ self
- ].
- id = device rootView id ifTrue:[
- ^ self
- ].
- (Dialog confirm:'mhmh, this may not a be smalltalk view\(Or I somehow forgot about it).\Destroy anyway ?' withCRs)
- ifTrue:[
- device destroyView:nil withId:id
- ].
-
- "Modified: 18.9.1995 / 23:13:32 / claus"
- "Modified: 19.10.1997 / 03:09:20 / cg"
-!
-
-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
-
- "Modified: 19.10.1997 / 03:09:34 / cg"
-!
-
-viewInspect
- "let user pick a view and inspect it. Only smalltalk views are allowed"
-
- |v|
-
- v := self pickAView.
- v notNil ifTrue:[
-"/ v topView inspect
- v inspect
- ]
-
! !
-!Launcher methodsFor:'change & update'!
-
-update:something with:aParameter from:changedObject
- "care for project changes & update my infoView"
-
- ((something == #currentProject)
- or:[changedObject == Project]) ifTrue:[
- self updateInfo.
- ^ self
- ].
-
- "Modified: 28.7.1997 / 18:39:39 / cg"
-! !
-
-!Launcher methodsFor:'drag & drop'!
-
-canDrop:aCollectionOfDropObjects in:aComponent
- "I accept fileObjects in the fileBrowser button
- and open a fileBrowser ..."
-
- aCollectionOfDropObjects size ~~ 1 ifTrue:[^ false].
- ^ aCollectionOfDropObjects first isFileObject
-
- "Modified: 11.4.1997 / 12:42:59 / cg"
-!
-
-drop:aCollectionOfDropObjects in:aComponent at:aPoint
- "I accept fileObjects and will open a fileBrowser ..."
-
- |singleDropObject|
-
- aCollectionOfDropObjects size == 1 ifFalse:[
- transcript showCR:'can only drop single objects'.
- ^ self
- ].
- singleDropObject := aCollectionOfDropObjects first.
-
- singleDropObject isFileObject ifTrue:[
- FileBrowser openOnFileNamed:(singleDropObject theObject pathName)
- ].
-
- "Modified: 11.4.1997 / 12:44:29 / cg"
-! !
-
-!Launcher methodsFor:'dynamic menus'!
-
-addMenu:name withItems:items actions:actions
- "dynamically add a new (user-)menu to the menu panel.
- This allows applications to install items for themself
- dynamically in the launcher."
-
- |subMenu|
-
- myMenu add:name selector:(name asSymbol) before:#help.
- subMenu := MenuView forMenu:myMenu.
- subMenu labels:items.
- subMenu actions:actions.
- myMenu at:name putMenu:subMenu
-
- "
- |launcher actionBlocks|
-
- actionBlocks := Array new:3.
- actionBlocks at:1 put:[Transcript showCR:'foo'].
- actionBlocks at:2 put:[Transcript showCR:'bar'].
-
- launcher := Transcript topView application.
- launcher
- addMenu:'misc'
- withItems:#('foo' 'bar')
- actions:actionBlocks
- "
-
- "
- |launcher actionBlocks|
-
- actionBlocks := Array new:3.
- actionBlocks at:1 put:[RDoItServer startServer].
- actionBlocks at:2 put:[RDoItServer killServer].
-
- launcher := Transcript topView application.
- launcher
- addMenu:'misc'
- withItems:#('start rdoit server' 'stop rdoit server')
- actions:actionBlocks
- "
-
- "Modified: 5.7.1996 / 11:45:19 / cg"
-!
-
-menuAt:nameSymbol
- "return a menu by name"
-
- ^ myMenu subMenuAt:nameSymbol
-
- "
- |launcher demoMenu|
-
- launcher := Transcript topView application.
- demoMenu := launcher menuAt:#demos.
- demoMenu
- addLabels:#('-' 'fooBar')
- selectors:#(nil fooBar).
- demoMenu actionAt:#fooBar put:[Transcript showCR:'fooBar']
- "
-
- "Created: 11.7.1996 / 15:35:13 / cg"
- "Modified: 11.7.1996 / 15:42:25 / cg"
-!
-
-removeMenu:name
- "dynamically remove a (user-)menu from the menu panel.
- This allows applications to de-install items for themself
- dynamically in the launcher."
-
- myMenu remove:name
-
- "
- |launcher actionBlocks|
-
- actionBlocks := Array new:3.
- actionBlocks at:1 put:[Transcript showCR:'foo'].
- actionBlocks at:2 put:[Transcript showCR:'bar'].
-
- launcher := Transcript topView application.
- launcher
- addMenu:'misc'
- withItems:#('foo' 'bar')
- actions:actionBlocks.
-
- Delay waitForSeconds:10.
-
- launcher removeMenu:'misc'
- "
-
- "Created: 5.7.1996 / 11:44:54 / cg"
- "Modified: 5.7.1996 / 11:54:36 / cg"
-! !
-
-!Launcher methodsFor:'help'!
-
-helpTextFor:aComponent
- "activeHelp interface: return some help text for a component"
-
- |sel s buttons|
-
- aComponent == transcript ifTrue:[
- s := 'TRANSCRIPT_HELP'
- ].
-
- aComponent == infoView ifTrue:[
- s := 'INFOVIEW_HELP'
- ].
-
- buttons := buttonPanel subViews.
- (buttons notNil and:[buttons includes:aComponent]) ifTrue:[
- "kludge: look for its change selector"
- sel := aComponent changeMessage.
- sel == #startSystemBrowser ifTrue:[
- s := 'SBROWSER_BUTTON_HELP'
- ].
- sel == #startFileBrowser ifTrue:[
- s := 'FBROWSER_BUTTON_HELP'
- ].
- sel == #startChangesBrowser ifTrue:[
- s := 'CBROWSER_BUTTON_HELP'
- ].
- ].
- s notNil ifTrue:[
- ^ resources string:s
- ].
- ^ nil
-
- "Modified: 8.1.1997 / 14:57:34 / cg"
-! !
-
-!Launcher methodsFor:'infoview update'!
-
-showActivity:someMessage
- "some activityNotification to be forwarded to the user;
- show it in the transcript here."
-
- transcript showCR:someMessage; endEntry
-
- "Created: 23.12.1995 / 12:38:29 / cg"
- "Modified: 5.7.1996 / 13:13:15 / cg"
-!
-
-updateInfo
- "update the infoView from the current project"
-
- |project projectName projectDir packageName defNameSpace msg args|
-
- (Project isNil or:[(project := Project current) isNil]) ifTrue:[
- projectName := '* none *'.
- projectDir := '.'.
- packageName := '* none *'.
- ] ifFalse:[
- projectName := project name.
- projectDir := project directory.
- packageName := project packageName.
- defNameSpace := project defaultNameSpace.
- ].
- defNameSpace isNil ifTrue:[
- defNameSpace := Smalltalk.
- ].
-
- defNameSpace == Smalltalk ifTrue:[
- msg := 'project: ''%1'' fileOut to: ''%3'' package: ''%2'''.
- args := Array
- with:projectName
- with:packageName
- with:(projectDir contractTo:30).
- ] ifFalse:[
- msg := 'project: ''%1'' fileOut to: ''%3'' package: ''%2'' nameSpace: %4'.
- args := Array
- with:projectName
- with:packageName
- with:(projectDir contractTo:30)
- with:defNameSpace name.
- ].
-
- projectInfoHolder value:(resources string:msg withArgs:args)
-
- "Created: 28.7.1997 / 18:39:15 / cg"
- "Modified: 28.7.1997 / 18:42:40 / cg"
-! !
-
-!Launcher methodsFor:'initialize - menus'!
-
-disableDangerousMenuItemsInRemoteLauncher
- "if I am a remote launcher (multidisplay operation),
- disable menus which are dangerous or affect common state.
- These operations have to
- be performed on the main screen."
-
- isMainLauncher ifFalse:[
- (myMenu menuAt:#file) disableAll:#(snapshot snapshotAndExit objectModuleDialog exit).
- (myMenu menuAt:#projects) disableAll.
- (myMenu menuAt:#settings) disableAll:#(languageSetting viewStyleSetting fontSettings printerSettings messageSettings compilerSettings sourceAndDebuggerSettings memorySettings miscSettings saveSettings restoreSettings).
- ].
-
- "Created: 5.7.1996 / 17:00:50 / cg"
- "Modified: 11.4.1997 / 09:19:51 / cg"
-!
-
-setupAboutMenu
- <resource: #programMenu >
-
- "setup the about- pulldown menu"
-
- myMenu at:#about
- putLabels:(resources array:#(
- 'about Smalltalk/X ...'
- '-'
- 'licence conditions'
- ))
- selectors:#(
- #about
- nil
- #showLicenceConditions
- )
- receiver:self.
-
- "Created: / 8.1.1997 / 14:03:20 / cg"
- "Modified: / 29.10.1997 / 03:40:36 / cg"
-!
-
-setupClassesMenu
- <resource: #programMenu >
-
- |m|
-
- "setup the classes- pulldown menu"
-
- myMenu at:#classes
- putLabels:(resources array:#(
- 'system browser'
- 'class browser ...'
- 'full class browser ...'
- 'class hierarchy browser ...'
- 'class tree'
- '-'
- 'implementors ...'
- 'senders ...'
- 'special'
- '-'
- 'change browser'
- ))
- selectors:#(
- #startSystemBrowser
- #startClassBrowser
- #startFullClassBrowser
- #startClassHierarchyBrowser
- #startClassTreeView
- nil
- #browseImplementors
- #browseSenders
- #special
- nil
- #startChangesBrowser
- )
- receiver:self.
-
- m := myMenu menuAt:#classes.
- m subMenuAt:#special
- put:(PopUpMenu
- labels:(resources array:#(
- 'references to undeclared'
- 'resource methods ...'
- 'show break/trace points'
- '-'
- 'remove all break/trace points'
- ))
- selectors:#(
- #browseUndeclared
- #browseResources
- #browseAllBreakAndTracePoints
- nil
- #removeAllBreakAndTracePoints
- )
- ).
-
- (JavaBrowser notNil
- and:[JavaBrowser isLoaded]) ifTrue:[
- (myMenu subMenuAt:#classes)
- addLabels:(resources array:#('-' 'java browser'))
- selectors:#(nil startJavaBrowser)
- after:#startClassTreeView
- ].
-
- "Created: / 8.1.1997 / 14:05:44 / cg"
- "Modified: / 13.1.1998 / 09:57:46 / cg"
-!
-
-setupDemoMenu
- "setup the demo- pulldown menu"
-
- <resource: #programMenu>
-
- |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'
- 'Tic Tac Toe (2 players)'
- ))
- selectors:#(
- startTetris
- startTicTacToe
- startTicTacToe2
- )
- receiver:self).
-
- "
- and labels:selector:args:receiver: here:
- "
- m subMenuAt:#geometricDesigns
- put:(PopUpMenu
- labels:(resources array:#(
- 'Pen demo'
- 'Commander demo'
- '-'
- 'Fractal plants demo'
- 'Fractal patterns demo'
- 'more fractal patterns demo'
- ))
- selector:#openDemo:
- args:#(
- PenDemo
- CommanderDemo
- nil
- FractalPlantsDemo
- FractalPatternsDemo
- ArmchairUniverseDemo
- )
- 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)'
- 'sphere (wireframe)'
- 'doughnut (wireframe)'
- 'planet'
- 'teapot'
- 'logo'
- 'rubics cube'
- 'x/y graph'
- '-'
- 'cube (light)'
- 'cube (light & texture)'
- 'sphere (light)'
- 'colored octahedron'
- ))
- selector:#openDemo:
- args:#(
- GLPlaneDemoView2
- GLTetraDemoView
- GLWireCubeDemoView
- GLCubeDemoView
- GLWireSphereDemoView
- GLDoughnutDemoView
- GLPlanetDemoView
- GLTeapotDemo
- Logo3DView1
- RubicsCubeView
- GLXYGraph
- nil
- GLCubeDemoView2
- GLBrickCubeDemoView
- GLSphereDemoView2
- GLOctaHedronDemoView
- )
- receiver:self).
-
- m subMenuAt:#graphicEditors
- put:(PopUpMenu
- labels:(resources array:#(
- 'DrawTool'
- 'LogicTool'
- 'Paint Demo'
- ))
- selector:#openDemo:
- args:#(
- DrawTool
- LogicTool
- ColorDrawDemo3
- )
- receiver:self).
-
- m subMenuAt:#goodies
- put:(PopUpMenu
- labels:(resources array:#(
- 'clock'
- 'digital clock'
- 'calendar'
- 'calculator'
- '-'
- 'mail tool'
- 'news tool'
- 'ftp tool'
- ))
- selector:#openDemo:
- args:#(
- Clock
- DigitalClockView
- Calendar
- CalculatorView
- nil
- MailView
- NewsView
- FTPTool
- )
- receiver:self).
-
- "Modified: 3.7.1997 / 13:54:20 / cg"
-!
-
-setupFileMenu
- <resource: #programMenu >
-
- "setup the file- pulldown menu"
-
- |l s|
-
- l := #(
- 'file browser'
- '-'
- 'modules ...'
- '-'
- 'snapshot ...'
- 'snapshot & exit ...'
- 'exit smalltalk ...'
- ).
- s := #(
- #startFileBrowser
- nil
- #objectModuleDialog
- nil
- #snapshot
- #snapshotAndExit
- #exit
- ).
-
- myMenu at:#file
- putLabels:(resources array:l)
- selectors:s
- receiver:self.
-
- "Created: / 8.1.1997 / 14:04:15 / cg"
- "Modified: / 29.10.1997 / 03:40:49 / cg"
-!
-
-setupHelpMenu
- <resource: #programMenu >
-
- "setup the help- pulldown menu"
-
- |l s|
-
- ActiveHelp notNil ifTrue:[
- l := #(
- 'what''s new'
- 'index'
- '-'
- 'ST/X online documentation'
- 'class documentation'
- '-'
- 'print documentation ...'
- '-'
- 'active help \c'
- ).
- s := #(
- #startWhatsNewDocumentation
- #startDocumentationIndex
- nil
- #startDocumentationTool
- #startClassDocumentation
- nil
- #showBookPrintDocument
- nil
- #toggleActiveHelp:
- )
- ] ifFalse:[
- l := #(
- 'what''s new'
- 'index'
- '-'
- 'ST/X online documentation'
- 'class documentation'
- '-'
- 'print documentation ...'
- ).
- s := #(
- #startWhatsNewDocumentation
- #startDocumentationIndex
- nil
- #startDocumentationTool
- #startClassDocumentation
- nil
- #showBookPrintDocument
- )
- ].
-
- myMenu at:#help
- putLabels:(resources array:l)
- selectors:s
- receiver:self.
-
- (ActiveHelp notNil
- and:[ActiveHelp isActive]) ifTrue:[
- (myMenu menuAt:#help) checkToggleAt:#toggleActiveHelp: put:true
- ].
-
- "Created: / 8.1.1997 / 14:08:09 / cg"
- "Modified: / 29.10.1997 / 03:40:53 / cg"
-!
-
-setupMainMenu
- "setup the pulldown menus main items.
- Extracted into a separate method, to allow subclasses to
- add their own entries"
-
- <resource: #programMenu >
-
- |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:[
-"/ icon := icon on:device.
- 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).
-
- "Created: / 8.1.1997 / 13:58:50 / cg"
- "Modified: / 29.10.1997 / 03:41:00 / cg"
-!
-
-setupMenu
- "setup the pulldown menu"
-
- |mainItems|
-
- self setupMainMenu.
-
- mainItems := myMenu selectors.
-
- (mainItems includes:#about) ifTrue:[
- "/ if not redefined without an about-menu ...
- self setupAboutMenu
- ].
- (mainItems includes:#file) ifTrue:[
- "/ if not redefined without a file-menu ...
- self setupFileMenu
- ].
- (mainItems includes:#classes) ifTrue:[
- "/ if not redefined without a classes-menu ...
- self setupClassesMenu
- ].
- (mainItems includes:#projects) ifTrue:[
- "/ if not redefined without a projects-menu ...
- self setupProjectsMenu
- ].
- (mainItems includes:#settings) ifTrue:[
- "/ if not redefined without a settings-menu ...
- self setupSettingsMenu
- ].
- (mainItems includes:#tools) ifTrue:[
- "/ if not redefined without a tools-menu ...
- self setupToolsMenu
- ].
- (mainItems includes:#demos) ifTrue:[
- "/ if not redefined without a demos-menu ...
- self setupDemoMenu
- ].
- (mainItems includes:#help) ifTrue:[
- "/ if not redefined without a help-menu ...
- self setupHelpMenu
- ].
-
- self disableDangerousMenuItemsInRemoteLauncher
-
- "Modified: 8.1.1997 / 14:09:47 / cg"
-!
-
-setupProjectsMenu
- "setup the projects- pulldown menu"
-
- <resource: #programMenu >
-
- myMenu at:#projects
- putLabels:(resources array:#(
- 'new project'
- '-'
- 'select project ...'
- ))
- selectors:#(
- #newProject
- nil
- #selectProject
- )
- receiver:self.
-
- "Created: / 8.1.1997 / 14:06:18 / cg"
- "Modified: / 29.10.1997 / 03:41:09 / cg"
-!
-
-setupSettingsMenu
- "setup the settings- pulldown menu"
-
- <resource: #programMenu >
-
- myMenu at:#settings
- putLabels:(resources array:#(
- 'language ...'
- 'show keyboard mappings ...'
- 'view style ...'
- 'fonts ...'
- 'printer ...'
- 'messages ...'
- 'compilation ...'
- 'source & debugger ...'
- 'object memory ...'
- 'screen ...'
- 'misc ...'
- '='
- 'save settings ...'
- 'restore settings ...'
- ))
- selectors:#(
- #languageSetting
- #keyboardSetting
- #viewStyleSetting
- #fontSettings
- #printerSettings
- #messageSettings
- #compilerSettings
- #sourceAndDebuggerSettings
- #memorySettings
- #displaySettings
- #miscSettings
- nil
- #saveSettings
- #restoreSettings
- )
- receiver:self.
-
- "Created: / 8.1.1997 / 14:07:00 / cg"
- "Modified: / 29.10.1997 / 03:41:17 / cg"
-!
-
-setupToolsMenu
- "setup the tools- pulldown menu"
-
- <resource: #programMenu>
-
- |m |
-
- myMenu at:#tools
- putLabels:(resources array:#(
- 'workspace'
- '-'
- 'GUI builder'
- '-'
- 'new launcher'
- '-'
- 'monitors'
- '-'
- 'views'
- '-'
- 'hardcopy'
- '-'
- 'misc'
- ))
- selectors:#(
- #startWorkspace
- nil
- #startGUIBuilder
- nil
- #startNewLauncher
- nil
- #monitors
- nil
- #views
- nil
- #hardcopy
- nil
- #misc
- )
- receiver:self.
-
-
- m := myMenu menuAt:#tools.
- m subMenuAt:#monitors
- put:(PopUpMenu
- labels:(resources array:#(
- 'process'
- 'semaphores'
- 'memory'
- 'irq latency'
- 'event view'
- 'event trace'
- '-'
- 'memory usage'
- ))
- selectors:#(
- #startApplication:
- #startApplication:
- #startApplication:
- #startApplication:
- #startApplication:
- #startStopEventTrace
- nil
- #startApplication:
- )
- args:#(
- #ProcessMonitor
- #SemaphoreMonitor
- #MemoryMonitor
- #InterruptLatencyMonitor
- #EventMonitor
- #StopEventTrace
- nil
- #MemoryUsageView
- )
- receiver:self).
-
- m subMenuAt:#views
- put:(PopUpMenu
- labels:(resources array:#(
- 'iconify all'
- 'de-iconify all'
- '-'
- 'find & raise ...'
- '-'
- 'view tree (all views)'
- 'view tree'
- '-'
- 'select & inspect view'
- '-'
- 'select & destroy view'
- 'find & destroy ...'
- ))
- selectors:#(
- #iconifyAllWindows
- #deIconifyAllWindows
- nil
- #findAndRaiseWindow
- nil
- #startFullWindowTreeView
- #startWindowTreeView
- nil
- #viewInspect
- nil
- #viewDestroy
- #findAndDestroyWindow
- )
- receiver:self).
-
- m subMenuAt:#misc
- put:(PopUpMenu
- labels:(resources array:#(
- 'garbage collect'
- 'garbage collect & compress'
- ))
- selectors:#(
- #garbageCollect
- #compressingGarbageCollect
- )
- receiver:self).
-
- m subMenuAt:#hardcopy
- put:(PopUpMenu
- labels:(resources array:#(
- 'screen'
- 'area'
- 'view'
- ))
- selectors:#(
- #fullScreenHardcopy
- #screenHardcopy
- #viewHardcopy
- )
- receiver:self).
-
- "Modified: / 31.10.1997 / 16:01:53 / cg"
- "Modified: / 19.12.1997 / 13:15:27 / stefan"
-! !
-
-!Launcher methodsFor:'initialize / release'!
-
-addTopViewsToCurrentProject
- "ignored here - the launcher is always global (i.e. not project private)."
-
- ^ 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')
-"/ #(startWorkspace 'Workspace32x32.xbm')
- #(nil nil)
- #(startChangesBrowser 'CBrowser32x32.xbm')
-"/ #(nil nil)
-"/ #(nil nil)
-"/ #(startDocumentationTool 'book11.ico')
- )
-
- "Created: 4.12.1995 / 20:16:18 / cg"
- "Modified: 19.4.1996 / 16:37:46 / cg"
-!
-
-closeDownViews
- OpenLaunchers removeIdentical:self ifAbsent:nil.
- super closeDownViews.
-
- "Created: 5.7.1996 / 13:33:36 / cg"
- "Modified: 1.2.1997 / 12:07:53 / cg"
-!
-
-closeRequest
- (self confirm:(resources string:'really close %1 ?' with:self class name)) ifTrue:[
- super closeRequest
- ]
-!
-
-focusSequence
- ^ (Array with:myMenu)
- ,
- (buttonPanel subViews select:[:element | element isKindOf:Button])
-"/ , (Array with:Transcript)
-!
-
-openInterface
- "sent by my superclass to open up my interface"
-
- ^ self openInterfaceAt:nil
-
- "Modified: / 5.2.1998 / 19:57:39 / cg"
-!
-
-openInterfaceAt:aPoint
- "sent by my superclass to open up my interface"
-
- |top icn w sz|
-
- "/ if there is already a transcript on my device,
- "/ I am a slave launcher with limited functionality.
-
- Transcript notNil ifTrue:[
- Transcript ~~ Stderr ifTrue:[
- isMainLauncher := (Transcript graphicsDevice == device).
- ] ifFalse:[
- isMainLauncher := true
- ]
- ] ifFalse:[
- isMainLauncher := true
- ].
-
- top := StandardSystemView onDevice:device.
- top label:'Smalltalk/X'; iconLabel:'ST/X Launcher'.
- top extent:(400@300 ).
- aPoint notNil ifTrue:[
- top origin:aPoint
- ].
-
- icn := self class aboutIcon.
- icn notNil ifTrue:[
- icn := icn magnifiedTo:(sz := device preferredIconSize).
- ].
-
- icn notNil ifTrue:[
- (device supportsDeepIcons not
- and:[device supportsIconViews
- and:[device depth > 1]]) ifTrue:[
- w := View extent:sz.
- w viewBackground:icn.
- top iconView:w
- ] ifFalse:[
- top icon:icn.
- ]
- ].
-
-"/ device supportsDeepIcons ifTrue:[
-"/ icn := self class aboutIcon.
-"/ icn notNil ifTrue:[
-"/ icn := icn magnifiedTo:(sz := device preferredIconSize).
-"/ icn := Depth8Image fromImage:icn.
-"/ top icon:icn
-"/ ].
-
-"/ ] ifFalse:[
-"/ device supportsIconViews ifTrue:[
-"/ icn := self class aboutIcon.
-"/ icn notNil ifTrue:[
-"/ icn := icn magnifiedTo:(sz := device preferredIconSize).
-"/ w := View extent:sz.
-"/ w viewBackground:icn.
-"/ top iconView:w
-"/ ].
-"/ ]
-"/ ].
-
- self setupViewsIn:top.
-
- top application:self.
-
- "
- open with higher prio to allow interaction even while things
- are running ...
- "
- top openWithPriority:(Processor userSchedulingPriority + 1).
-
- OpenLaunchers isNil ifTrue:[
- OpenLaunchers := OrderedCollection new.
- ].
- OpenLaunchers add:self.
-
- ^ builder
-
- "Created: / 5.2.1998 / 19:43:44 / cg"
- "Modified: / 5.2.1998 / 20:08:58 / cg"
-!
-
-release
- OpenLaunchers removeIdentical:self ifAbsent:nil.
- super release
-
- "Modified: 28.7.1997 / 18:40:55 / cg"
-!
-
-restarted
- "image restart - since WindowGroup recreates the process with
- the default priority, we have to raise the prio again.
- Mhmh - this looks like a bug to me ...
- Also, the cursor (which was stored as a write or waitCursor) must
- be reset to normal."
-
- Processor activeProcess priority:(Processor userSchedulingPriority + 1).
-
- super restarted
-
- "Modified: 1.6.1996 / 16:58:25 / cg"
-!
-
-saveAndTerminateRequest
- "some windowManagers can send this, to shutDown an application
- but let it save its state before, for later restart.
- Although I have not yet encountered such a windowManager,
- we are already prepared for this ;-)"
-
- self snapshot.
- super saveAndTerminateRequest
-
- "Created: 5.7.1996 / 13:07:45 / cg"
- "Modified: 5.7.1996 / 13:08:55 / cg"
-!
-
-setupButtonPanelIn:aTopView
- "create the buttonPanel"
-
- |spc mh buttonSize|
-
- spc := View viewSpacing // 2.
- buttonPanel := HorizontalPanelView in:aTopView.
- buttonPanel level:-1; borderWidth:0.
- buttonPanel horizontalLayout:#leftSpace.
-"/ buttonPanel verticalLayout:#centerSpace.
-
- buttonSize := self class buttonImageSize.
-
- "/
- "/ the buttonSpec is a collection of:
- "/ #( selector iconFileName )
- "/ or:
- "/ #( selector (className iconQuerySelector) )
- "/ or"
- "/ #( nil )
- "/
- self buttonPanelSpec do:[:entry |
- |sel b sep img iconSpec v|
-
- sel := entry at:1.
- sel isNil ifTrue:[
- sep := View in:buttonPanel.
- sep extent:32@1; borderWidth:0.
- ] ifFalse:[
- iconSpec := entry at:2.
- iconSpec isArray ifTrue:[
- img := (Smalltalk classNamed:(iconSpec at:1)) perform:(iconSpec at:2).
- ] ifFalse:[
- img := Image fromFile:iconSpec.
- ].
- (img notNil and:[buttonSize notNil]) ifTrue:[
- img extent ~= buttonSize ifTrue:[
- img := img magnifiedTo:buttonSize
- ]
- ].
-
- b := Button new.
- b form:img.
- b model:self; changeMessage:sel.
-
- b styleSheet name = 'win95' ifTrue:[
-
- false ifTrue:[
- "/ make buttons flat, popping up when entered ...
-
- b enterLevel: 1.
- b leaveLevel: 0.
- buttonPanel addSubView:b.
-
- ] ifFalse:[
- "/ make buttons flat, but given them a 3D frame ...
-
- v := View in:buttonPanel.
- v addSubView:b.
- v level:-1.
- b passiveLevel:1; activeLevel:-1.
- v extent:(b preferredExtent
- + b borderWidth + b borderWidth
- + b margin + b margin
- + v margin + v margin).
- v preferredExtent:v extent.
- b origin:(v margin asPoint).
- ].
- b enteredBackgroundColor:(Color grey:80).
- ] ifFalse:[
- buttonPanel addSubView:b.
- ].
- ]
- ].
-
- mh := myMenu height.
- buttonPanel origin:0.0 @ (mh + spc)
- corner:(1.0 @ (mh + spc + buttonPanel preferredExtent y)).
-
- buttonPanel leftInset:spc; rightInset:spc.
-
- "Modified: 26.4.1997 / 21:02:39 / cg"
-!
-
-setupInfoViewIn:topView
- "create the infoView"
-
- |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.
- projectInfoHolder := '' asValue.
- infoView labelChannel:projectInfoHolder.
- self updateInfo.
-
- Project notNil ifTrue:[
- Project addDependent:self.
- ]
-
- "
- Launcher open
- "
-
- "Modified: 9.9.1996 / 22:44:15 / stefan"
- "Modified: 28.7.1997 / 18:42:30 / cg"
-!
-
-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.
-"
-!
-
-setupTranscriptIn:aView
- "create the transcript view"
-
- |v launcher|
-
- "/ check if this is an additional launcher on a remote display.
- "/ if so, do not close the real launcher.
-
- (Transcript notNil and:[Transcript ~~ Stderr]) ifTrue:[
- isMainLauncher ifTrue:[
- launcher := Transcript topView application
- ] ifFalse:[
- launcher := self class current.
- (launcher isNil and: [NewLauncher notNil]) ifTrue: [launcher := NewLauncher current].
- ].
-
- launcher notNil ifTrue:[
- launcher window graphicsDevice == device ifTrue:[
- OpenLaunchers removeIdentical:launcher ifAbsent:nil.
- launcher class = NewLauncher
- ifTrue: [launcher close]
- ifFalse: [launcher window 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.
-
- isMainLauncher ifTrue:[
- transcript beTranscript.
- ] ifFalse:[
- transcript showCR:'**************** Notice ***********************'.
- transcript showCR:'** this is NOT the Transcript **'.
- transcript showCR:'** The real Transcript is on the main screen **'.
- transcript showCR:'** **'.
- transcript showCR:'** Menus affecting common state are disabled **'.
- transcript showCR:'***********************************************'.
- ]
-
- "Modified: 1.2.1997 / 12:08:01 / cg"
-!
-
-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) max:myMenu preferredExtent x)
- @
- ((tFont height) * 20).
-
- "
- Launcher open
- "
-
- "Modified: 9.9.1996 / 22:44:31 / stefan"
-! !
-
-!Launcher methodsFor:'private'!
-
-changeViewStyleTo:newStyle
- newStyle notNil ifTrue:[
- self withWaitCursorDo:[
- transcript showCR:'change style to ' , newStyle , ' ...'.
- View defaultStyle:newStyle asSymbol.
- ].
- self reopenLauncher.
- DebugView newDebugger.
- ]
-
- "Created: 20.10.1997 / 15:28:10 / cg"
-!
-
-findWindow:title
- "a helper for find & destroy and find & raise operations;
- let user choose a view and return it; return nil on cancel"
-
- |knownTopViews nameList box|
-
- knownTopViews := IdentitySet new.
- Screen allScreens do:[:aScreen |
- aScreen knownViews do:[:aView |
- |top showIt wg|
-
- aView notNil ifTrue:[
- top := aView topView.
- (top isKindOf:DebugView) ifTrue:[
- "/ although modal, show it.
- showIt := top realized
- ] ifFalse:[
- wg := top windowGroup.
- showIt := (wg notNil and:[wg isModal not]).
- ].
- showIt ifTrue:[
- knownTopViews add:top
- ]
- ]
- ]
- ].
-
- knownTopViews := knownTopViews asOrderedCollection.
- knownTopViews sort:[:v1 :v2 | |l1 l2|
- l1 := v1 label ? 'aView'.
- l2 := v2 label ? 'aView'.
- l1 < l2
- ].
- nameList := knownTopViews collect:[:v |
- |isDead wg p l|
-
- l := v label ? 'aView'.
- ((wg := v windowGroup) notNil
- and:[(p := wg process) notNil
- and:[p state ~~ #dead]]) ifTrue:[
- l
- ] ifFalse:[
- l , ' (dead ?)'
- ]
- ].
-
- box := ListSelectionBox new.
- box noEnterField.
- box list:nameList.
- box label:(resources string:'view selection').
- box title:(resources string:title) withCRs.
- box action:[:selection |
- |v idx|
-
- (idx := box selectionIndex) notNil ifTrue:[
- v := knownTopViews at:idx.
- ].
- box destroy.
- ^ v
- ].
- box extent:400@300.
- box showAtPointer.
- ^ nil
-
- "Created: / 14.10.1997 / 11:24:42 / cg"
- "Modified: / 27.10.1997 / 04:41:08 / cg"
-!
-
-fontBoxForEncoding:encodingMatch
+!Launcher::SettingsDialogs class methodsFor:'dialogs-private'!
+
+fontBoxForEncoding:encodingMatch for:requestor
"open a fontBox, showing fonts which match some encoding
(used when changing to japanese ...)"
|box y b
labelDef buttonDef listDef menuDef textDef
- models labels allOfThem filter|
+ models labels allOfThem filter resources|
+
+ resources := requestor class classResources.
encodingMatch notNil ifTrue:[
- filter := [:f | f encoding notNil
- and:[encodingMatch match:f encoding]].
+ filter := [:f | f encoding notNil
+ and:[encodingMatch match:f encoding]].
].
-
+
models := OrderedCollection new.
labels := OrderedCollection new.
@@ -4796,84 +7038,84 @@
models
with:(resources array:#('all' 'labels' 'buttons' 'lists' 'menus' 'edit text'))
do:[:model :title |
- |y2 lbl f i|
-
- f := model value.
-
- (box addTextLabel:title) adjust:#left.
-
- y := box yPosition.
- b := box addComponent:(Button label:(resources string:'change ...')) tabable:true.
- b relativeExtent:nil; extent:(b preferredExtent).
- y2 := box yPosition.
- box yPosition:y.
- i := box leftIndent.
- box leftIndent:(b widthIncludingBorder + View viewSpacing).
- (lbl := box addTextLabel:'')
- adjust:#left;
- font:(model value);
- labelChannel:(BlockValue
- with:[:v | |f|
- f := v value.
- f isNil ifTrue:[
- ''
- ] ifFalse:[
- f userFriendlyName
- ]
- ]
- argument:model).
- labels add:lbl.
-
- box leftIndent:i.
- box yPosition:(box yPosition max:y2).
+ |y2 lbl f i|
+
+ f := model value.
+
+ (box addTextLabel:title) adjust:#left.
+
+ y := box yPosition.
+ b := box addComponent:(Button label:(resources string:'change ...')) tabable:true.
+ b relativeExtent:nil; extent:(b preferredExtent).
+ y2 := box yPosition.
+ box yPosition:y.
+ i := box leftIndent.
+ box leftIndent:(b widthIncludingBorder + View viewSpacing).
+ (lbl := box addTextLabel:'')
+ adjust:#left;
+ font:(model value);
+ labelChannel:(BlockValue
+ with:[:v | |f|
+ f := v value.
+ f isNil ifTrue:[
+ ''
+ ] ifFalse:[
+ f userFriendlyName
+ ]
+ ]
+ argument:model).
+ labels add:lbl.
+
+ box leftIndent:i.
+ box yPosition:(box yPosition max:y2).
box addVerticalSpace; addHorizontalLine; addVerticalSpace.
- b action:[
- |f|
-
- f := FontPanel
- fontFromUserInitial:(model value)
- title:(resources string:'font for %1' with:title)
- filter:filter.
- f notNil ifTrue:[
- model == allOfThem ifTrue:[
- models do:[:m | m value:f].
- labels do:[:l | l font:f]
- ] ifFalse:[
- model value:f.
- lbl font:f.
- ].
- ]
- ].
- model == allOfThem ifTrue:[
- box addVerticalSpace
- ]
+ b action:[
+ |f|
+
+ f := FontPanel
+ fontFromUserInitial:(model value)
+ title:(resources string:'font for %1' with:title)
+ filter:filter.
+ f notNil ifTrue:[
+ model == allOfThem ifTrue:[
+ models do:[:m | m value:f].
+ labels do:[:l | l font:f]
+ ] ifFalse:[
+ model value:f.
+ lbl font:f.
+ ].
+ ]
+ ].
+ model == allOfThem ifTrue:[
+ box addVerticalSpace
+ ]
].
box addAbortButton; addOkButton.
(box addButton:(Button label:(resources string:'defaults')) before:nil)
- action:[
- "/ fetch defaults
- View updateAllStyleCaches.
- labelDef value: Label defaultFont.
- buttonDef value: Button defaultFont.
- listDef value: SelectionInListView defaultFont.
- menuDef value: MenuView defaultFont.
- textDef value: TextView defaultFont.
- ].
+ action:[
+ "/ fetch defaults
+ View updateAllStyleCaches.
+ labelDef value: Label defaultFont.
+ buttonDef value: Button defaultFont.
+ listDef value: SelectionInListView defaultFont.
+ menuDef value: MenuView defaultFont.
+ textDef value: TextView defaultFont.
+ ].
box open.
box accepted ifTrue:[
- Label defaultFont:labelDef value.
- Button defaultFont:buttonDef value.
- Toggle defaultFont:buttonDef value.
- SelectionInListView defaultFont:listDef value.
- MenuView defaultFont:menuDef value.
- PullDownMenu defaultFont:menuDef value.
- TextView defaultFont:textDef value.
- EditTextView defaultFont:textDef value.
- CodeView defaultFont:textDef value.
+ Label defaultFont:labelDef value.
+ Button defaultFont:buttonDef value.
+ Toggle defaultFont:buttonDef value.
+ SelectionInListView defaultFont:listDef value.
+ MenuView defaultFont:menuDef value.
+ PullDownMenu defaultFont:menuDef value.
+ TextView defaultFont:textDef value.
+ EditTextView defaultFont:textDef value.
+ CodeView defaultFont:textDef value.
].
box destroy.
^ box accepted
@@ -4881,136 +7123,11 @@
"Created: 27.2.1996 / 01:44:16 / cg"
"Modified: 17.6.1996 / 13:38:48 / stefan"
"Modified: 8.1.1997 / 14:59:11 / cg"
-!
-
-openApplication:className nameSpace:aNameSpace
- "open some application, given the classes name.
- Look for it in Smalltalk and the given nameSpace"
-
- self openApplication:className nameSpace:aNameSpace with:#open
-
- "Modified: 8.1.1997 / 14:59:42 / cg"
-!
-
-openApplication:className nameSpace:aNameSpace with:aSelector
- "open some application, given the classes name.
- Look for it in Smalltalk and the given nameSpace"
-
- |cls|
-
- cls := Smalltalk at:className asSymbol.
- cls isNil ifTrue:[
- "/ look if its in the nameSpace
- aNameSpace notNil ifTrue:[
- cls := aNameSpace at:className asSymbol
- ]
- ].
-
- cls isNil ifTrue:[
- self warn:(resources string:'Sorry, the %1 class is not available.' with:className).
- ] ifFalse:[
- Autoload autoloadFailedSignal handle:[:ex |
- self warn:(resources string:'Sorry, the %1 class seems to be not available.' with:className)
- ] do:[
- cls perform:aSelector
- ]
- ]
-
- "Created: 8.1.1997 / 12:52:13 / cg"
- "Modified: 8.1.1997 / 14:59:47 / cg"
-!
-
-pickAView
- "let user pick a view and return it"
-
- |v|
-
- (Delay forSeconds:1) wait.
- v := Screen current viewFromUser.
- v isNil ifTrue:[
- self warn:'Sorry, this is not a smalltalk view'.
- ^ nil
- ].
- ^ v
-
- "Created: 19.10.1997 / 03:04:53 / cg"
- "Modified: 19.10.1997 / 03:42:00 / cg"
-!
-
-reopenLauncher
- "reopen a new launcher.
- for now (since style & language settings currently do
- not affect living views ...)"
-
- |contents fontPref enc builder newLauncher|
-
-"/ moved the stuff below to the language-setting
-"/ dialog (ask before changing the language, to have
-"/ proper texts in the dialogs).
-"/
-"/ fontPref := self class classResources at:'PREFERRED_FONT_ENCODING' default:'iso8859*'.
-"/ enc := MenuView defaultFont encoding.
-"/ (fontPref match:enc) ifFalse:[
-"/ (self confirm:'menu font is not ' , fontPref , '-encoded.\\Change it ?' withCRs)
-"/ ifTrue:[
-"/ self fontBoxForEncoding:fontPref
-"/ ]
-"/ ].
-
- contents := transcript endEntry; list.
- builder := self class openAt:(self window origin).
- builder window waitUntilVisible.
- newLauncher := builder application.
- newLauncher transcript list:contents; hideCursor; scrollToBottom; cursorToEnd; showCursor
-
- "Modified: / 6.2.1998 / 00:00:45 / cg"
-!
-
-saveAllViews
- "tell each topview that we are going to terminate and give it chance
- to save its contents."
-
- ObjectMemory changed:#aboutToExit
-!
-
-saveScreenImage:anImage defaultName:defaultName
- "save an image into a file
- - ask user for filename using a fileSelectionBox."
-
- |fileName|
-
- fileName := Dialog
- requestFileName:(resources string:'save image in:')
- default:(defaultName , '.tiff')
- ok:(resources string:'save')
- abort:(resources string:'cancel')
- pattern:'*.tiff'.
-
- fileName notNil ifTrue:[
- anImage saveOn:fileName
- ].
-
- "Modified: 21.2.1996 / 13:09:28 / cg"
-! !
-
-!Launcher methodsFor:'queries'!
-
-processName
- "for monitors only - my name"
-
- ^ 'ST/X Launcher'
-!
-
-transcript
- "my transcript"
-
- ^ transcript
-
- "Created: 5.7.1996 / 13:04:36 / cg"
+
! !
!Launcher class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/Launcher.st,v 1.326 1998-04-23 19:38:04 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Launcher.st,v 1.327 1998-04-25 14:23:15 cg Exp $'
! !