--- a/Launcher.st Thu Feb 11 12:14:01 1999 +0100
+++ b/Launcher.st Thu Feb 11 12:14:21 1999 +0100
@@ -10,21 +10,14 @@
hereby transferred.
"
-ApplicationModel subclass:#Launcher
+AbstractLauncherApplication subclass:#Launcher
instanceVariableNames:'myMenu buttonPanel transcript infoView projectInfoHolder helpIsOn
isMainLauncher'
- classVariableNames:'CachedAboutIcon OpenLaunchers NotifyingEmergencyHandler'
+ classVariableNames:'CachedAboutIcon'
poolDictionaries:''
category:'Interface-Smalltalk'
!
-Object subclass:#LauncherDialogs
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- privateIn:Launcher
-!
-
!Launcher class methodsFor:'documentation'!
copyright
@@ -90,6 +83,16 @@
documentation
"
+ WARNING:
+ This is a old part of the ST/X system, and no
+ longer maintained.
+ This used to be the launcher some time ago.
+ It has been replaced by the NewLauncher, which provides
+ a similar look, but is completely implemented using the
+ new GUI framework.
+ (this launcher is hand-written)
+
+
Used to be a new launcher (w.r.t. the old menu-launcher),
combining the old Launchers menu and transcript into
one view. (you no longer have to move two views around all the time ...).
@@ -102,25 +105,25 @@
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).
Notice2:
- By the time you read this, this 'new launcher' is already old again;
- we have written a completely new newLauncher, using the GUI painter tools,
- which provides the same functionality, but has all of its GUI, menus and
- icon bitmaps been generated using convenient tools.
- Look into NewLauncher if you need coding examples on GUI programming.
+ By the time you read this, this 'new launcher' is already old again;
+ we have written a completely new newLauncher, using the GUI painter tools,
+ which provides the same functionality, but has all of its GUI, menus and
+ icon bitmaps been generated using convenient tools.
+ Look into NewLauncher if you need coding examples on GUI programming.
[author:]
- Claus Gittinger
+ Claus Gittinger
[see also:]
- Examples_misc::MyLauncher
+ Examples_misc::MyLauncher
[start with:]
- Launcher open
+ Launcher open
"
!
@@ -147,38 +150,6 @@
"
! !
-!Launcher class methodsFor:'accessing'!
-
-current
- "return the launcher running on the current screen.
- (for access via addMenu/ removeMenu)"
-
- |currentScreen|
-
- OpenLaunchers size > 0 ifTrue:[
- currentScreen := Screen current.
- OpenLaunchers do:[:aLauncher |
- aLauncher window graphicsDevice == currentScreen ifTrue:[
- ^ aLauncher
- ]
- ]
- ].
- ^ nil.
-
- "
- Launcher current
- "
-
- "Modified: / 9.9.1996 / 22:41:36 / stefan"
- "Modified: / 13.10.1998 / 16:09:50 / cg"
-!
-
-openLaunchers
- "return all opened launchers"
-
- ^OpenLaunchers ? (OpenLaunchers := OrderedCollection new)
-! !
-
!Launcher class methodsFor:'defaults'!
aboutIcon
@@ -231,23 +202,6 @@
"Modified: / 26.10.1997 / 17:07:40 / cg"
!
-notifyingEmergencyHandler
- "return a block (used as an emergency handler
- for exceptions), which does errorNotification before going
- into the debugger."
-
- "Remember the handlerBlock, to be able to determine if the current
- handler is the notifying one."
-
- NotifyingEmergencyHandler isNil ifTrue:[
- NotifyingEmergencyHandler := Exception notifyingEmergencyHandler
- ].
- ^ NotifyingEmergencyHandler
-
- "Created: 7.1.1997 / 22:18:19 / cg"
- "Modified: 15.1.1997 / 21:15:38 / cg"
-!
-
smallAboutIcon
"return the icon shown in the about menu-item"
@@ -271,115 +225,6 @@
!Launcher methodsFor:'actions - about & help'!
-about
- "show an about box"
-
- |box|
-
- box := AboutBox new.
- box autoHideAfter:10 with:[].
- box showAtCenter
-
- "Modified: 8.1.1997 / 14:37:07 / cg"
-!
-
-showBookPrintDocument
- "open an HTML browser on the 'book'-printing document"
-
- self showDocumentation:'BOOK.html'
-
- "Modified: 31.8.1995 / 13:11:28 / claus"
- "Created: 12.9.1996 / 01:53:30 / cg"
- "Modified: 8.1.1997 / 14:42:59 / cg"
-!
-
-showDocumentation:aRelativeDocFilePath
- "open an HTML browser on some document"
-
- "
- although that one is not yet finished,
- 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
- ].
- ].
-
- self warn:'Sorry, the ST/X HTML reader is not
-included in this release.
-
-Please use Mosaic, netscape, chimera or any
-other HTML viewer to see the documentation.
-
-The documentation is found in the ''doc/online'' directory.'.
-
- "Modified: 31.8.1995 / 13:11:08 / claus"
- "Modified: 8.1.1997 / 14:42:42 / cg"
-!
-
-showLicenceConditions
- "open an HTML browser on the 'LICENCE' document"
-
- |lang doc|
-
- Smalltalk releaseIdentification = 'ST/X_free_demo_vsn' ifTrue:[
- doc := 'english/LICENCE_DEMO_STX.html'
- ] ifFalse:[
- ((lang := Smalltalk language) = 'de'
- or:[lang = 'german']) ifTrue:[
- doc := 'german/LICENCE_STX.html'
- ] ifFalse:[
- doc := 'english/LICENCE_STX.html'
- ].
- ].
- doc := resources at:'LICENCEFILE' default:doc.
- self showDocumentation:('../' , doc)
-
- "Created: / 14.9.1996 / 12:35:00 / cg"
- "Modified: / 23.9.1996 / 17:03:15 / stefan"
- "Modified: / 23.4.1998 / 11:42:26 / cg"
-!
-
-startClassDocumentation
- "open an HTML browser on the 'classDoc/TOP' document"
-
- self showDocumentation:'classDoc/TOP.html'
-
- "Modified: 31.8.1995 / 13:11:28 / claus"
- "Created: 22.4.1996 / 21:03:56 / cg"
- "Modified: 8.1.1997 / 14:42:04 / cg"
-!
-
-startDocumentationIndex
- "open an HTML browser on the 'index' document"
-
- self showDocumentation:'index.html'
-
- "Modified: 31.8.1995 / 13:11:28 / claus"
- "Created: 17.4.1996 / 22:08:55 / cg"
- "Modified: 8.1.1997 / 14:41:23 / cg"
-!
-
-startDocumentationTool
- "open an HTML browser on the 'TOP' document"
-
- self showDocumentation:'TOP.html'
-
- "Modified: 31.8.1995 / 13:11:28 / claus"
- "Modified: 8.1.1997 / 14:41:38 / cg"
-!
-
startLauncherHelp
"open an HTML browser on the 'launcher-help' document"
@@ -390,16 +235,6 @@
"Created: / 31.10.1997 / 15:59:28 / cg"
!
-startWhatsNewDocumentation
- "open an HTML browser on the 'whatsNew.html' document"
-
- self showDocumentation:'whatsNew.html'
-
- "Modified: 31.8.1995 / 13:11:28 / claus"
- "Created: 18.10.1996 / 14:00:35 / cg"
- "Modified: 8.1.1997 / 14:39:32 / cg"
-!
-
toggleActiveHelp:aBoolean
"turn on/off active help"
@@ -683,19 +518,12 @@
(self confirm:(resources string:'Are you certain you want to exit without saving ?'))
ifTrue:[
- self saveAllViews.
- Smalltalk exit
+ Smalltalk exit
]
"Modified: 8.1.1997 / 14:50:00 / cg"
!
-objectModuleDialog
- ^ LauncherDialogs objectModuleDialogFor:self
-
- "Created: / 31.7.1998 / 15:50:37 / cg"
-!
-
snapshot
"saves a snapshot image, after asking for a fileName"
@@ -855,152 +683,6 @@
"Modified: 8.1.1997 / 14:52:20 / cg"
! !
-!Launcher methodsFor:'actions - settings'!
-
-compilerSettings
- "open a dialog on compiler related settings"
-
- LauncherDialogs compilerSettingsFor:self.
-
- "Modified: / 10.9.1995 / 19:19:18 / claus"
- "Modified: / 9.9.1996 / 22:42:47 / stefan"
- "Modified: / 31.7.1998 / 15:15:33 / cg"
-!
-
-displaySettings
- "open a dialog on display related settings"
-
- LauncherDialogs displaySettingsFor:self.
-
- "Modified: / 9.9.1996 / 22:43:04 / stefan"
- "Modified: / 31.7.1998 / 15:15:37 / cg"
-!
-
-editSettings
- "open a dialog on edit settings"
-
- LauncherDialogs editSettingsFor:self.
-
- "Modified: / 9.9.1996 / 22:43:36 / stefan"
- "Modified: / 31.7.1998 / 15:17:56 / cg"
- "Created: / 6.1.1999 / 14:14:16 / cg"
-!
-
-fontSettings
- "open a dialog on font related settings"
-
- LauncherDialogs fontSettingsFor:self.
-
- "Modified: / 31.7.1998 / 15:15:41 / cg"
-!
-
-javaSettings
- "open a dialog on java related settings"
-
- LauncherDialogs javaSettingsFor:self.
-
- "Modified: / 9.9.1996 / 22:43:04 / stefan"
- "Created: / 18.7.1998 / 22:33:15 / cg"
- "Modified: / 31.7.1998 / 15:15:45 / cg"
-!
-
-keyboardSetting
- "open a dialog on keyboard related settings"
-
- LauncherDialogs keyboardSettingsFor:self.
-
- "Modified: / 9.9.1996 / 22:43:17 / stefan"
- "Modified: / 31.7.1998 / 15:15:49 / cg"
-!
-
-languageSetting
- "open a dialog on language related settings"
-
- LauncherDialogs languageSettingsFor:self.
-
- "Modified: / 9.9.1996 / 22:43:27 / stefan"
- "Modified: / 31.7.1998 / 15:17:32 / cg"
-!
-
-memorySettings
- "open a dialog on objectMemory related settings"
-
- LauncherDialogs memorySettingsFor:self.
-
- "Modified: / 31.7.1998 / 15:17:42 / cg"
-!
-
-messageSettings
- "open a dialog on infoMessage related settings"
-
- LauncherDialogs messageSettingsFor:self.
-
- "Modified: / 31.7.1998 / 15:17:53 / cg"
-!
-
-miscSettings
- "open a dialog on misc other settings"
-
- LauncherDialogs miscSettingsFor:self.
-
- "Modified: / 9.9.1996 / 22:43:36 / stefan"
- "Modified: / 31.7.1998 / 15:17:56 / cg"
-!
-
-printerSettings
- "open a dialog on printer related settings"
-
- LauncherDialogs printerSettingsFor:self.
-
- "Modified: / 9.9.1996 / 22:43:51 / stefan"
- "Modified: / 31.7.1998 / 15:18:00 / cg"
-!
-
-restoreSettings
- "restore settings from a settings-file."
-
- LauncherDialogs restoreSettingsFor:self.
-
- "Modified: / 31.7.1998 / 15:18:03 / cg"
-!
-
-saveSettings
- "save settings to a settings-file."
-
- LauncherDialogs saveSettingsFor:self.
-
- "Modified: / 31.7.1998 / 15:18:06 / cg"
-!
-
-sourceAndDebuggerSettings
- "open a dialog on misc other settings"
-
- LauncherDialogs sourceAndDebuggerSettingsFor:self.
-
- "Modified: / 9.9.1996 / 22:43:36 / stefan"
- "Created: / 17.1.1997 / 17:39:33 / cg"
- "Modified: / 16.4.1998 / 17:18:47 / ca"
- "Modified: / 31.7.1998 / 15:18:09 / cg"
-!
-
-toolSettings
- "open a dialog on tool settings"
-
- LauncherDialogs toolSettingsFor:self.
-
- "Modified: / 9.9.1996 / 22:43:36 / stefan"
- "Modified: / 31.7.1998 / 15:17:56 / cg"
- "Created: / 13.10.1998 / 15:49:08 / cg"
-!
-
-viewStyleSetting
- "open a dialog on viewStyle related settings"
-
- LauncherDialogs viewStyleSettingsFor:self.
-
- "Modified: / 31.7.1998 / 15:18:12 / cg"
-! !
-
!Launcher methodsFor:'actions - tools'!
compressingGarbageCollect
@@ -1543,17 +1225,17 @@
"setup the about- pulldown menu"
myMenu at:#about
- putLabels:(resources array:#(
- 'about Smalltalk/X ...'
- '-'
- 'licence conditions'
- ))
- selectors:#(
- #about
- nil
- #showLicenceConditions
- )
- receiver:self.
+ putLabels:(resources array:#(
+ 'about Smalltalk/X ...'
+ '-'
+ 'licence conditions'
+ ))
+ selectors:#(
+ #openAbout
+ nil
+ #openLicenseConditions
+ )
+ receiver:self.
"Created: / 8.1.1997 / 14:03:20 / cg"
"Modified: / 29.10.1997 / 03:40:36 / cg"
@@ -2618,13 +2300,6 @@
"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."
@@ -2821,3143 +2496,8 @@
"Created: 5.7.1996 / 13:04:36 / cg"
! !
-!Launcher::LauncherDialogs 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
- warnCompatibility warnCompatibilityBox warnDollarBox
- stcCompilation compilationList stcCompilationOptions stcIncludes stcDefines stcOptions
- stcLibraries stcLibraryPath cc stc ccOptions historyLines fullHistoryUpdate
- catchMethodRedefs catchClassRedefs keepSourceOptions keepSource
- constantFoldingOptions constantFolding justInTimeCompilation
- warnEnabler check component oldIndent t supportsJustInTimeCompilation y
- y2 fullDebugSupport yMax
- compileLazy loadBinaries canLoadBinaries strings idx thisIsADemoVersion
- resources stcSetupButt|
-
- resources := requestor class classResources.
-
- 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.
- fullDebugSupport := ObjectMemory fullSingleStepSupport.
- ] ifFalse:[
- justInTimeCompilation := false.
- fullDebugSupport := (Compiler lineNumberInfo == #full) asValue.
- ].
- justInTimeCompilation := justInTimeCompilation asValue.
- fullDebugSupport := fullDebugSupport asValue.
-
- catchMethodRedefs := Class catchMethodRedefinitions asValue.
- catchClassRedefs := Class catchClassRedefinitions asValue.
- historyLines := HistoryManager notNil and:[HistoryManager isLoaded and:[HistoryManager isActive]].
- historyLines ifFalse:[
- fullHistoryUpdate := false asValue
- ] 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').
-
- y := box yPosition.
- check := box addCheckBox:(resources string:'catch method redefinitions') on:catchMethodRedefs.
- check width:0.5.
-
- box yPosition:y.
- check := box addCheckBox:(resources string:'catch class redefinitions') on:catchClassRedefs.
- check left:0.5; width:0.5.
-
- y := box yPosition.
- check := box addCheckBox:(resources string:'keep history line in methods') on:historyLines.
- check width:0.5.
- HistoryManager isNil ifTrue:[check disable].
- box yPosition:y.
- check := box addCheckBox:(resources string:'keep full class history') on:fullHistoryUpdate.
- check left:0.5; width: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).
-
- stcSetupButt := box addComponent:(Button label:(resources string:'stc compilation parameters...')
- action:[|manager|
-
- self stcCompilerSettingsFor:requestor.
- ]).
- ].
-
- 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:catchMethodRedefs value.
- Class catchClassRedefinitions:catchClassRedefs 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).
- Compiler foldConstants:(constantFoldingOptions at:constantFolding selectionIndex).
-
- supportsJustInTimeCompilation ifTrue:[
- justInTimeCompilation := justInTimeCompilation value.
- justInTimeCompilation ifTrue:[
- Method allInstancesDo:[:m | m checked:false].
- ].
- ObjectMemory justInTimeCompilation:justInTimeCompilation.
- ObjectMemory fullSingleStepSupport:fullDebugSupport 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: / 5.11.1998 / 14:25:59 / cg"
-!
-
-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 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) )
- ).
- ] 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).
- ].
-
- requestor 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"
-!
-
-editSettingsFor:requestor
- "open a dialog on edit settings"
-
- |box
- st80EditingMode st80DoubleClickSelectMode resources y
- |
-
- resources := requestor class classResources.
-
- "/
- "/ extract relevant system settings ...
- "/
- st80EditingMode := EditTextView st80Mode asValue.
- st80DoubleClickSelectMode := TextView st80SelectMode asValue.
-
- "/
- "/ create a box on those values ...
- "/
- box := DialogBox new.
- box label:(resources string:'Edit settings').
-
- box addCheckBox:(resources string:'cursor has ST80 line end behavior') on:st80EditingMode.
- box addCheckBox:(resources string:'double click select behavior as in ST80') on:st80DoubleClickSelectMode.
-
- box addHorizontalLine.
-
- box
- addHelpButtonFor:'Launcher/editSettings.html';
- addAbortButton;
- addOkButton.
-
- "/
- "/ show the box ...
- "/
- box open.
-
- "/
- "/ update system settings
- "/
- box accepted ifTrue:[
- EditTextView st80Mode:(st80EditingMode value).
- TextView st80SelectMode:(st80DoubleClickSelectMode value).
- ].
- box destroy
-
- "Created: / 6.1.1999 / 14:12:09 / cg"
- "Modified: / 6.1.1999 / 14:17:51 / cg"
-!
-
-fontSettingsFor:requestor
- "open a dialog on font related settings"
-
- (self fontBoxForEncoding:nil for:requestor) ifTrue:[
- requestor reopenLauncher.
- ]
-
- "Created: 26.2.1996 / 22:52:51 / cg"
- "Modified: 8.1.1997 / 14:52:49 / cg"
-!
-
-javaSettingsFor:requestor
- "open a dialog on settings related to the java subsystem"
-
- |box audio javaHome resources component
- extraFileSecurityChecks extraSocketSecurityChecks
- supportsJustInTimeCompilation
- javaJustInTimeCompilation javaNativeCodeOptimization
- showJavaByteCode exceptionDebug|
-
- resources := requestor class classResources.
-
- audio := JavaVM audioEnabled asValue.
- extraFileSecurityChecks := JavaVM fileOpenConfirmation asValue.
- extraSocketSecurityChecks := JavaVM socketConnectConfirmation asValue.
- (supportsJustInTimeCompilation := ObjectMemory supportsJustInTimeCompilation) ifTrue:[
- javaJustInTimeCompilation := ObjectMemory javaJustInTimeCompilation asValue.
- javaNativeCodeOptimization := ObjectMemory javaNativeCodeOptimization asValue.
- ] ifFalse:[
- javaJustInTimeCompilation := javaNativeCodeOptimization := false
- ].
- showJavaByteCode := JavaMethod forceByteCodeDisplay asValue.
- exceptionDebug := JavaVM exceptionDebug asValue.
-
- javaHome := (Java javaHome ? '') asValue.
-
- box := DialogBox new.
- box label:(resources string:'Java').
-
- box addCheckBox:(resources string:'Audio Enabled') on:audio.
- box addCheckBox:(resources string:'Confirm file open for write') on:extraFileSecurityChecks.
- box addCheckBox:(resources string:'Confirm socket connect') on:extraSocketSecurityChecks.
- box addCheckBox:(resources string:'Debug Exceptions') on:exceptionDebug.
- box addHorizontalLine.
- supportsJustInTimeCompilation ifTrue:[
- box
- addCheckBox:(resources string:'java just in time compilation to machine code')
- on:javaJustInTimeCompilation.
- box
- addCheckBox:(resources string:'optimize native code')
- on:javaNativeCodeOptimization.
- ].
- box addHorizontalLine.
- box addCheckBox:(resources string:'Display java byteCode (i.e. not source)') on:showJavaByteCode.
- box addHorizontalLine.
- component := box
- addLabelledInputField:(resources string:'java home:')
- adjust:#right
- on:javaHome
- tabable:true
- separateAtX:0.3.
- component acceptOnLeave:false.
-
- box addVerticalSpace.
- box addComponent:(Button
- label:(resources string:'Reinit VM now')
- action:[
- Java classPath size == 0 ifTrue:[
- Java initialize.
- ].
- Java classPath size == 0 ifTrue:[
- self warn:'No JDK found'.
- ] ifFalse:[
- JavaVM initializeVM
- ]
- ]).
-
- box addComponent:(Button
- label:(resources string:'Remove all Java classes now')
- action:[
- Java flushAllJavaResources
- ]).
-
- "/ box addHorizontalLine.
-
-"/ box addHelpButtonFor:'Launcher/javaSettings.html'.
- box addAbortButton; addOkButton.
- box open.
-
- box accepted ifTrue:[
- JavaMethod forceByteCodeDisplay:showJavaByteCode value.
- JavaVM audioEnabled:audio value.
- JavaVM exceptionDebug:exceptionDebug value.
- JavaVM fileOpenConfirmation: extraFileSecurityChecks value.
- JavaVM socketConnectConfirmation: extraSocketSecurityChecks value.
- javaJustInTimeCompilation value ~~ ObjectMemory javaJustInTimeCompilation ifTrue:[
- ObjectMemory javaJustInTimeCompilation:javaJustInTimeCompilation value.
- javaJustInTimeCompilation value ifTrue:[
- JavaMethod allSubInstancesDo:[:m | m checked:false].
- ].
- ].
- javaNativeCodeOptimization value ~~ ObjectMemory javaNativeCodeOptimization ifTrue:[
- ObjectMemory javaNativeCodeOptimization:javaNativeCodeOptimization value.
- ].
- ].
- box destroy
-
- "Created: / 18.7.1998 / 22:32:58 / cg"
- "Modified: / 27.1.1999 / 20:16:03 / cg"
-!
-
-keyboardSettingsFor:requestor
- "open a dialog on keyboard related settings"
-
- |mappings listOfRawKeys listOfFunctions
- box l
- list1 list2 listView1 listView2
- frame selectionForwarder macroForwarder macroTextView y resources|
-
- resources := requestor class classResources.
-
- 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 at:'KEY_MSG' default:'keyboard mapping:') 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: / 4.5.1998 / 12:40:02 / cg"
-!
-
-languageSettingsFor:requestor
- "open a dialog on language related settings"
-
- |listOfLanguages translatedLanguages switch box languageList flags resources|
-
- resources := requestor class classResources.
-
- "
- 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 at:'LANG_MSG' default:'select a language') withCRs.
- box label:(resources string:'Language selection').
- box list:languageList.
- box initialText:(Language).
- box action:[:newLanguage |
- requestor 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.
- "/ refetch resources ...
- resources := requestor class classResources.
- fontPref := resources 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:[
- "/ flush and try again - just in case, the font path has changed.
- Screen current flushListOfAvailableFonts.
- 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 := (requestor fontBoxForEncoding:fontPref)
- ]
- ].
- ].
- ].
-
- switch ifTrue:[
- Transcript showCR:'change language to ' , newLanguage , ' ...'.
- Smalltalk language:language asSymbol.
- ResourcePack flushCachedResourcePacks
- ].
- ].
- switch ifTrue:[
- requestor reopenLauncher.
- DebugView newDebugger.
- ]
- ].
- box
- addHelpButtonFor:'Launcher/languageSetting.html'.
- box open.
- box destroy
-
- "Modified: / 9.9.1996 / 22:43:27 / stefan"
- "Modified: / 4.8.1998 / 16:54:32 / cg"
-!
-
-memorySettingsFor:requestor
- "open a dialog on objectMemory related settings"
-
- |box igcLimit igcFreeLimit igcFreeAmount newSpaceSize
- compressLimit
- oldIncr component fields codeLimit codeTrigger stackLimit resources|
-
- resources := requestor class classResources.
-
- "/
- "/ 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"
-!
-
-messageSettingsFor:requestor
- "open a dialog on infoMessage related settings"
-
- |box vmInfo vmErrors displayErrors classInfos resources|
-
- resources := requestor class classResources.
-
- 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"
-!
-
-miscSettingsFor:requestor
- "open a dialog on misc other settings"
-
- |box check shadows takeFocus returnFocus hasRDoitServer rDoitsEnabled
- rDoitLogging rDoitErrorLogging rDoitErrorDebugging hostNameInLabel showAccelerators
- preemptive dynamicPrios hostNameInLabelHolder st80EditingMode resources y
- activateOnClick|
-
- resources := requestor class classResources.
-
- "/
- "/ extract relevant system settings ...
- "/
- shadows := PopUpView shadows asValue.
- hostNameInLabel := StandardSystemView includeHostNameInLabel.
- hostNameInLabelHolder := hostNameInLabel asValue.
- returnFocus := StandardSystemView returnFocusWhenClosingModalBoxes asValue.
- takeFocus := StandardSystemView takeFocusWhenMapped asValue.
- activateOnClick := (Display class activateOnClick:nil) asValue.
-
- showAccelerators := MenuView showAcceleratorKeys asValue.
- preemptive := Processor isTimeSlicing asValue.
- dynamicPrios := Processor supportDynamicPriorities asValue.
-
- rDoitsEnabled := rDoitLogging := rDoitErrorLogging := false.
- (hasRDoitServer := RDoItServer notNil) ifTrue:[
- RDoItServer isLoaded ifTrue:[
- rDoitsEnabled := RDoItServer serverRunning.
- rDoitLogging := RDoItServer isLogging.
- rDoitErrorLogging := RDoItServer isErrorLogging.
- rDoitErrorDebugging := RDoItServer isErrorCatching not.
- ]
- ].
- rDoitsEnabled := rDoitsEnabled asValue.
- rDoitLogging := rDoitLogging asValue.
- rDoitErrorLogging := rDoitErrorLogging asValue.
- rDoitErrorDebugging := rDoitErrorDebugging 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 addCheckBox:(resources string:'raise & activate windows on click') on:activateOnClick.
-
- box addHorizontalLine.
-
- box addCheckBox:(resources string:'preemptive scheduling') on:preemptive.
- box leftIndent:20.
- check := box addCheckBox:(resources string:'dynamic priorities') on:dynamicPrios.
- check enableChannel:preemptive.
- box leftIndent:0.
-
- box addHorizontalLine.
-
- check := box addCheckBox:(resources string:'remote doits enabled') on:rDoitsEnabled.
- hasRDoitServer ifFalse:[
- check disable
- ].
- box leftIndent:20.
- y := box yPosition.
- check := box addCheckBox:(resources string:'log errors') on:rDoitErrorLogging.
- check width:0.4.
- check enableChannel:rDoitsEnabled.
- hasRDoitServer ifFalse:[
- check disable
- ].
- box yPosition:y.
- check := box addCheckBox:(resources string:'log requests') on:rDoitLogging.
- check left:0.4; width:0.5.
- check enableChannel:rDoitsEnabled.
- hasRDoitServer ifFalse:[
- check disable
- ].
- check := box addCheckBox:(resources string:'debug errors') on:rDoitErrorDebugging.
- check width:0.4.
- check enableChannel:rDoitsEnabled.
- hasRDoitServer ifFalse:[
- check disable
- ].
- box leftIndent:0.
-
- 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.
- l notNil ifTrue:[
- aView label:(l , ' '); label:l. "/ force a change
- ]
- ]
- ]
- ]
- ].
- StandardSystemView returnFocusWhenClosingModalBoxes:returnFocus value.
- StandardSystemView takeFocusWhenMapped:takeFocus value.
- Display class activateOnClick:(activateOnClick value).
-
- MenuView showAcceleratorKeys:showAccelerators value.
- Processor isTimeSlicing ~~ preemptive value ifTrue:[
- preemptive value ifTrue:[
- Processor startTimeSlicing
- ] ifFalse:[
- Processor stopTimeSlicing
- ]
- ].
- Processor supportDynamicPriorities ~~ dynamicPrios value ifTrue:[
- Processor supportDynamicPriorities:dynamicPrios value
- ].
-
- hasRDoitServer ifTrue:[
- (RDoItServer isLoaded
- or:[rDoitLogging value ~~ RDoItServer isLogging
- or:[rDoitErrorDebugging value ~~ RDoItServer isErrorCatching not
- or:[rDoitErrorLogging value ~~ RDoItServer isErrorLogging
- or:[rDoitsEnabled value ~~ false]]]]) ifTrue:[
- RDoItServer logging:(rDoitLogging value).
- RDoItServer errorLogging:(rDoitErrorLogging value).
- RDoItServer errorCatching:(rDoitErrorDebugging value not).
- rDoitsEnabled := rDoitsEnabled value.
- rDoitsEnabled ~~ RDoItServer serverRunning ifTrue:[
- rDoitsEnabled ifFalse:[
- RDoItServer killAll
- ] ifTrue:[
- RDoItServer start.
- RDoItServer serverRunning ifFalse:[
- self warn:'RDoit startup failed (see stderr).'
- ]
- ]
- ].
- ].
- ]
- ].
- box destroy
-
- "Modified: / 9.9.1996 / 22:43:36 / stefan"
- "Modified: / 6.1.1999 / 14:15:53 / cg"
-!
-
-printerSettingsFor:requestor
- "open a dialog on printer related settings"
-
- |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 resources|
-
- resources := requestor class classResources.
-
- 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"
-
-!
-
-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.
- Will move entries over to UserPreferences over time;
- new items should always go there."
-
- |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.
-
- (fileName isNil or:[fileName isEmpty]) ifTrue:[
- "/ canceled
- ^ self
- ].
-
- self withWaitCursorDo:[
- Smalltalk fileIn:fileName.
-
- self reopenLauncher.
- ].
-
- "Modified: / 21.7.1998 / 11:37:54 / cg"
-!
-
-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.
- Will move entries over to UserPreferences over time;
- new items should always go there."
-
- |s screen fileName resources|
-
- resources := requestor class classResources.
-
- 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:'ObjectFileLoader linkArgs: ' , (ObjectFileLoader linkArgs storeString) , '.';
- nextPutLine:'ObjectFileLoader linkCommand: ' , (ObjectFileLoader linkCommand 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:'"/ Edit settings:'.
- s nextPutLine:'"/'.
- s nextPutLine:'EditTextView st80Mode: ' , (EditTextView st80Mode storeString) , '.'.
- s nextPutLine:'TextView st80SelectMode: ' , (TextView st80SelectMode storeString) , '.'.
- s nextPutLine:'UserPreferences current syntaxColoring: ' , (UserPreferences current syntaxColoring storeString) , '.'.
-
- s cr.
- s nextPutLine:'"/'.
- s nextPutLine:'"/ Tool settings:'.
- s nextPutLine:'"/'.
- s nextPutLine:'UserPreferences current useNewInspector: ' , (UserPreferences current useNewInspector storeString) , '.'.
- s nextPutLine:'UserPreferences current useNewChangesBrowser: ' , (UserPreferences current useNewChangesBrowser 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:'Display class activateOnClick: ' , ((Display class activateOnClick:nil) storeString) , '.';
- nextPutLine:'MenuView showAcceleratorKeys: ' , (MenuView showAcceleratorKeys storeString) , '.';
- nextPutLine:'Class tryLocalSourceFirst: ' , (Class tryLocalSourceFirst storeString) , '.'.
- (Exception emergencyHandler == Launcher notifyingEmergencyHandler) ifTrue:[
- s nextPutLine:'Exception emergencyHandler:(Launcher notifyingEmergencyHandler).'.
- ].
- Processor isTimeSlicing ifTrue:[
- s nextPutLine:'Processor startTimeSlicing.'.
- s nextPutLine:('Processor supportDynamicPriorities:' , (Processor supportDynamicPriorities ? false) storeString , '.').
- ] ifFalse:[
- s nextPutLine:'Processor stopTimeSlicing.'.
- ].
-
- 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: / 6.1.1999 / 14:24:16 / cg"
-!
-
-sourceAndDebuggerSettingsFor:requestor
- "open a dialog on source&debugger other settings"
-
- |box check butt setupButt logDoits updChanges changeFileName
- useManager hasManager cvsIsSetup
- repository repositoryHolder localSourceFirst
- sourceCacheDir cacheEntry
- component localCheck oldIndent nm fn manager
- showErrorNotifier showVerboseStack
- syntaxColoring resources useNewInspector pos currentUserPrefs|
-
- currentUserPrefs := UserPreferences current.
-
- resources := requestor class classResources.
-
- "/
- "/ extract relevant system settings ...
- "/
- logDoits := Smalltalk logDoits asValue.
- updChanges := Class updatingChanges asValue.
- changeFileName := ObjectMemory nameForChanges asValue.
-
- (AbstractSourceCodeManager notNil
- and:[AbstractSourceCodeManager isLoaded not]) ifTrue:[
- AbstractSourceCodeManager autoload.
- ].
-
- hasManager := AbstractSourceCodeManager notNil
- and:[AbstractSourceCodeManager isLoaded].
-
- repositoryHolder := '' asValue.
- 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.
- ].
- cvsIsSetup := true.
- ] ifFalse:[
- cvsIsSetup := false asValue.
- ]
- ] ifFalse:[
- useManager := false.
- localSourceFirst := false.
- cvsIsSetup := false.
- ].
- showErrorNotifier := (Exception emergencyHandler == Launcher notifyingEmergencyHandler) asValue.
- showVerboseStack := (DebugView defaultVerboseBacktrace ? false) asValue.
- syntaxColoring := currentUserPrefs 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:'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:[
- pos := box yPosition.
- check := box addCheckBox:(resources string:'sourcecode management') on:useManager.
- check enableChannel:cvsIsSetup.
- box makeTabable:check.
-
- cvsIsSetup value ifFalse:[
- AbstractSourceCodeManager notNil ifTrue:[
- check width:0.6.
- box yPosition:pos.
- setupButt := box addComponent:(Button label:(resources string:'setup...')
- action:[|manager|
-
- self cvsConfigurationDialogFor:requestor.
- manager := (Smalltalk at:#SourceCodeManager).
- cvsIsSetup value:manager notNil.
- manager notNil ifTrue:[
- repositoryHolder value: manager repositoryName.
- sourceCacheDir value:(AbstractSourceCodeManager cacheDirectoryName).
- setupButt beInvisible.
- ].
- ]).
- box makeTabable:setupButt.
- setupButt left:0.6; width:0.4.
- ].
- ].
- oldIndent := box leftIndent.
- box leftIndent:30.
-
- 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.
- "/ localCheck enable.
- ] ifFalse:[
- sourceCacheDir value:(AbstractSourceCodeManager cacheDirectoryName).
- ].
- box addHorizontalLine.
- ].
-
- pos := box yPosition.
- check := box addCheckBox:(resources string:'syntax coloring') on:syntaxColoring.
- check width:0.6.
- box yPosition:pos.
- butt := box addComponent:(Button label:(resources string:'configure...') action:[self syntaxColorConfigurationDialogFor:requestor]).
- box makeTabable:butt.
- butt enableChannel:syntaxColoring.
- butt left:0.6; width:0.4.
-
- 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
- addHelpButtonFor:'Launcher/sourceSettings.html';
- addAbortButton;
- addOkButton.
-
- "/
- "/ show the box ...
- "/
- box open.
-
- "/
- "/ update system settings
- "/
- box accepted ifTrue:[
- 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 notNil 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).
- currentUserPrefs syntaxColoring:syntaxColoring value.
- ].
- box destroy
-
- "Modified: / 9.9.1996 / 22:43:36 / stefan"
- "Created: / 17.1.1997 / 17:39:33 / cg"
- "Modified: / 16.4.1998 / 17:18:47 / ca"
- "Modified: / 13.10.1998 / 15:47:31 / cg"
-!
-
-stcCompilerSettingsFor:requestor
- "open an extra dialog on stc-compiler related settings"
-
- |box
- stcCompilationOptions stcIncludes stcDefines stcOptions
- stcLibraries stcLibraryPath cc stc ccOptions
- linkCommand linkArgs
- component t y y2 yMax
- canLoadBinaries strings idx thisIsADemoVersion
- resources|
-
- resources := requestor class classResources.
-
- canLoadBinaries := ObjectFileLoader notNil and:[ObjectFileLoader canLoadObjectFiles].
-
- stcIncludes := Compiler stcCompilationIncludes asValue.
- stcDefines := Compiler stcCompilationDefines asValue.
- stcOptions := Compiler stcCompilationOptions asValue.
- ccOptions := Compiler ccCompilationOptions asValue.
-
- cc := Compiler ccPath asValue.
- stc := Compiler stcPath asValue.
- linkCommand := ObjectFileLoader linkCommand asValue.
- linkArgs := ObjectFileLoader linkArgs asValue.
-
- ObjectFileLoader notNil ifTrue:[
- (t := ObjectFileLoader searchedLibraries) notNil ifTrue:[
- stcLibraries := (String fromStringCollection:t separatedBy:' ') asValue.
- ].
- (t := ObjectFileLoader libPath) notNil ifTrue:[
- stcLibraryPath := t asValue.
- ]
- ].
-
- box := DialogBox new.
- box label:(resources string:'STC Compilation settings').
-
- thisIsADemoVersion := (Smalltalk releaseIdentification = 'ST/X_free_demo_vsn').
- ObjectFileLoader notNil ifTrue:[
- thisIsADemoVersion ifFalse:[
-
- component := box
- addLabelledInputField:(resources string:'stc command:')
- adjust:#right
- on:stc
- tabable:true
- separateAtX:0.3.
- component immediateAccept:true; acceptOnLeave:false; cursorMovementWhenUpdating:#beginOfLine.
- component preferredExtent:(100 @ component preferredExtent y).
- canLoadBinaries ifFalse:[component disable].
-
- 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].
-
- 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:(150 @ 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].
-
- 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.
-
-"/ box addVerticalSpace.
-
- component := box
- addLabelledInputField:(resources string:'link command:')
- adjust:#right
- on:linkCommand
- 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:'link args:')
- adjust:#right
- on:linkArgs
- 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
- addHelpButtonFor:'Launcher/compilerSettings.html';
- addAbortButton;
- addOkButton.
-
- box open.
-
- box accepted ifTrue:[
- thisIsADemoVersion ifFalse:[
- Compiler stcCompilationIncludes:stcIncludes value.
- Compiler stcCompilationDefines:stcDefines value.
- Compiler stcCompilationOptions:stcOptions value.
- Compiler ccCompilationOptions:ccOptions value.
- Compiler ccPath:cc value.
- stc value ~= Compiler stcPath ifTrue:[
- Compiler stcPath:stc value
- ].
- ObjectFileLoader linkCommand:linkCommand value.
- ObjectFileLoader linkArgs:linkArgs value.
- ].
-
- ObjectFileLoader notNil ifTrue:[
- stcLibraries notNil ifTrue:[
- ObjectFileLoader searchedLibraries:(stcLibraries value asCollectionOfWords).
- ].
- stcLibraryPath notNil ifTrue:[
- ObjectFileLoader libPath:(stcLibraryPath value).
- ]
- ].
- ].
- box destroy
-
- "Modified: / 10.9.1995 / 19:19:18 / claus"
- "Modified: / 9.9.1996 / 22:42:47 / stefan"
- "Created: / 2.10.1998 / 16:27:49 / cg"
- "Modified: / 21.10.1998 / 19:15:10 / cg"
-!
-
-toolSettingsFor:requestor
- "open a dialog on tool settings"
-
- |box
- component
- resources useNewInspector useNewChangesBrowser currentUserPrefs|
-
- currentUserPrefs := UserPreferences current.
-
- resources := requestor class classResources.
-
- "/
- "/ extract relevant system settings ...
- "/
- useNewInspector := currentUserPrefs useNewInspector asValue.
- useNewChangesBrowser := currentUserPrefs useNewChangesBrowser asValue.
-
- "/
- "/ create a box on those values ...
- "/
- box := DialogBox new.
- box label:(resources string:'Tool settings').
-
-
-
- box addCheckBox:(resources string:'Use the new Changes Browser') on:useNewChangesBrowser.
- box addHorizontalLine.
- box addCheckBox:(resources string:'Use hierarchical inspector') on:useNewInspector.
-
- box
- addHelpButtonFor:'Launcher/toolSettings.html';
- addAbortButton;
- addOkButton.
-
- "/
- "/ show the box ...
- "/
- box open.
-
- "/
- "/ update system settings
- "/
- box accepted ifTrue:[
- currentUserPrefs useNewInspector:useNewInspector value.
- currentUserPrefs useNewChangesBrowser:useNewChangesBrowser value.
- useNewInspector value ifTrue:[
- Inspector := NewInspector::InspectorView
- ] ifFalse:[
- Inspector := InspectorView
- ].
- ].
- box destroy
-
- "Modified: / 9.9.1996 / 22:43:36 / stefan"
- "Modified: / 16.4.1998 / 17:18:47 / ca"
- "Created: / 13.10.1998 / 15:44:36 / cg"
- "Modified: / 13.10.1998 / 16:03:43 / cg"
-!
-
-viewStyleSettingsFor:requestor
- "open a dialog on viewStyle related settings"
-
- | resourceDir dir box
- list listView scrView infoLabel infoForwarder newStyle
- someRsrcFile b didApply resources listUpdater showStandardStylesOnly standardStyles|
-
- showStandardStylesOnly := true asValue.
- standardStyles := #('iris' 'motif' 'mswindows95' 'next' 'os2' 'st80' 'normal').
-
- 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
- ] ifFalse:[
- resourceDir := Smalltalk getSystemFileName:'resources'.
- ].
-
- resourceDir isNil ifTrue:[
- self warn:'no styles found (missing ''resources'' directory)'.
- ^ self
- ].
- dir := resourceDir asFilename directoryContents.
-
- list := SelectionInList new.
-
- listUpdater := [
- |listOfStyles lastSelection|
-
- lastSelection := list selection.
- 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 remove:'generic' ifAbsent:nil; remove:'mswindows3' ifAbsent:nil.
- showStandardStylesOnly value ifTrue:[
- listOfStyles := listOfStyles select:[:aStyleName | standardStyles includes:aStyleName].
- ].
-
- listOfStyles sort.
- list list:listOfStyles.
- list selection:lastSelection.
- ].
- listUpdater value.
-
- showStandardStylesOnly onChangeSend:#value to:listUpdater.
-
- infoForwarder := [
- |nm sheet comment|
-
- comment := ''.
- nm := list selection.
- nm notNil ifTrue:[
- sheet := ViewStyle fromFile:(nm , '.style').
- comment := (sheet at:#comment ifAbsent:'') withoutSeparators.
- ].
- comment := comment withCRs asStringCollection.
- comment size == 1 ifTrue:[
- comment := comment first
- ].
- infoLabel label:comment
- ].
-
- list onChangeSend:#value to:infoForwarder.
-
- box := Dialog new.
- box label:(resources string:'Style selection').
-
- (box addTextLabel:(resources at:'STYLE_MSG' default:'select a style') withCRs) adjust:#left.
- listView := SelectionInListView on:list.
- listView doubleClickAction:[:sel | box accept value:true. box hide].
- box addCheckBox:(resources string:'standard styles only') on:showStandardStylesOnly.
- scrView := box addComponent:(ScrollableView forView:listView) tabable:true.
-
- box addVerticalSpace.
-
- (infoLabel := box addTextLabel:'\\' withCRs) adjust:#centerLeft.
-
- box addAbortButton.
-
-"/ mhmh - the newLauncher does not yet handle apply (without close) correctly
-"/ b := box addButton:(Button label:(resources string:'apply')).
-"/ b action:[didApply := true. requestor changeViewStyleTo:(list selection)].
-
- box addOkButton.
-
- (standardStyles includes:View defaultStyle) ifFalse:[
- showStandardStylesOnly value:false
- ].
- list selection:(View defaultStyle).
-
- box stickAtBottomWithVariableHeight:scrView.
- box stickAtBottomWithFixHeight:infoLabel.
- box open.
-
- box destroy.
- box accepted ifTrue:[
- ((newStyle := list selection) ~= View defaultStyle
- or:[didApply ~~ true]) ifTrue:[
- requestor changeViewStyleTo:newStyle.
- ].
- ].
-
- "
- self viewStyleSettingsFor:nil
- "
-
- "Modified: / 14.9.1998 / 20:33:59 / cg"
-! !
-
-!Launcher::LauncherDialogs class methodsFor:'dialogs - file'!
-
-objectModuleDialogFor:requestor
- "opens a moduleInfo dialog"
-
- <resource: #programMenu >
-
- |allModules moduleNames
- allObjects methodObjects methodNames
- cObjects cObjectNames
- otherObjects otherObjectNames
- box l handles unloadButton unloadAndRemoveButton
- list1 list2 listView1 listView2
- y panel
- showBuiltIn showModules showMethods showCObjects showOthers
- moduleListUpdater check canDoIt menu
- resources middleLabel|
-
- resources := requestor class classResources.
-
- showBuiltIn := true asValue.
- canDoIt := ObjectFileLoader notNil and:[ObjectFileLoader canLoadObjectFiles].
-
- showModules := canDoIt asValue.
- showMethods := canDoIt asValue.
- showCObjects := canDoIt asValue.
- showOthers := canDoIt asValue.
-
- list1 := SelectionInList new.
- 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.
- ].
-
- showBuiltIn value ifTrue:[
- l := #('VM') , l.
- handles := #(VM) , handles.
- allModules := #(VM) , allModules.
- ].
-
- list1 list:l.
- unloadButton disable.
- unloadAndRemoveButton disable.
- ].
-
- showBuiltIn onChangeSend:#value to:moduleListUpdater.
- showModules onChangeSend:#value to:moduleListUpdater.
- showMethods onChangeSend:#value to:moduleListUpdater.
- showCObjects onChangeSend:#value to:moduleListUpdater.
- showOthers onChangeSend:#value to:moduleListUpdater.
-
- box := Dialog new.
- box label:(resources string:'ST/X & Module Version information').
-
- listView1 := HVScrollableView for:SelectionInListView miniScrollerH:true.
- 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 l|
-
- tabs := TabulatorSpecification unit:#inch positions:#(0 2.6 3.5).
-
- (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:[
- middleLabel label:'contains method:'.
-
- (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 address hexPrintString leftPaddedTo:8 with:$0)).
-
- list2 list:(Array with:entry1 with:entry2 with:entry3).
- ] ifFalse:[
- (module isFunctionObjectHandle
- and:[module functions notEmpty]) ifTrue:[
- middleLabel label:'contains function:'.
-
- 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 address hexPrintString leftPaddedTo:8 with:$0)).
- entry
- ]).
- ] ifFalse:[
- list2 list:#('nothing known about contents (no functions have been extracted)').
- ]
- ].
-
- unloadButton enable.
- unloadAndRemoveButton disable.
- ] ifFalse:[
- info == #VM ifTrue:[
- "/ dummy entry for VM;
- "/ show file versions in lower view.
-
- middleLabel label:'contains modules:'.
- l := (ObjectMemory getVMIdentificationStrings).
- l := l select:[:entry | entry includesString:'$Header'].
- l := l select:[:entry | entry includesString:',v'].
- l := l collect:[:entry |
- |i1 i2 file revision date listEntry|
-
- listEntry := MultiColListEntry new:3 tabulatorSpecification:tabs.
-
- i1 := entry indexOfSubCollection:'librun'.
- i1 ~~ 0 ifTrue:[
- i2 := entry indexOfSubCollection:',v' startingAt:i1.
- i2 ~~ 0 ifTrue:[
- file := entry copyFrom:i1+7 to:(i2-1).
- listEntry colAt:1 put:file.
-
- i1 := i2+3.
- i2 := entry indexOfSeparatorStartingAt:i1.
- revision := entry copyFrom:i1 to:(i2-1).
- listEntry colAt:2 put:revision.
-
- i1 := i2+1.
- i2 := entry indexOfSeparatorStartingAt:i1.
- date := entry copyFrom:i1 to:(i2-1).
- listEntry colAt:3 put:date.
- ].
- ].
- listEntry.
- "/ entry
- ].
- list2 list:l.
-
- unloadButton disable.
- unloadAndRemoveButton disable.
- ] ifFalse:[
- "/ selected a package
-
- "/ fill bottom list with class-info
-
- middleLabel label:'contains classes:'.
- 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.
- ].
- ].
- ]
- ]
- ].
-
-
- panel := HorizontalPanelView new.
-
- panel add:(l := Label label:'show:').
- l adjust:#left; borderWidth:0.
- panel add:(check := CheckBox label:'builtin' model:showBuiltIn).
- box makeTabable:check.
- panel add:(check := CheckBox label:'classLibs' model:showModules).
- canDoIt ifFalse:[
- check disable
- ] ifTrue:[
- box makeTabable:check.
- ].
- panel add:(check := CheckBox label:'methods' model:showMethods).
- canDoIt ifFalse:[
- check disable
- ] ifTrue:[
- box makeTabable:check.
- ].
- panel add:(check := CheckBox label:'c-objects' model:showCObjects).
- canDoIt ifFalse:[
- check disable
- ] ifTrue:[
- box makeTabable:check.
- ].
- panel add:(check := CheckBox label:'others' model:showOthers).
- canDoIt ifFalse:[
- check disable
- ] ifTrue:[
- box makeTabable:check.
- ].
-
- panel horizontalLayout:#fitSpace.
- "/ panel horizontalLayout:#leftSpace.
-
- box addComponent:panel tabable:false.
-
- box addVerticalSpace.
- box addComponent:listView1 tabable:true.
- listView1 topInset:(View viewSpacing + panel preferredExtent y).
- listView1 origin:0.0@0.0 corner:1.0@0.4. "/ ; inset:2.
-
- l := box addTextLabel:(resources string:'contains:').
- l adjust:#left; borderWidth:0.
- l origin:0.0@0.4 corner:1.0@0.4.
- l topInset:(View viewSpacing).
- l bottomInset:((l preferredExtent y) negated - View viewSpacing).
- middleLabel := l.
-
- listView2 := HVScrollableView for:SelectionInListView miniScrollerH:true.
- listView2 model:list2; printItems:false.
- box addComponent:listView2 tabable:true.
- listView2 origin:0.0@0.4 corner:1.0@1.0. "/ ; inset:2.
- listView2 disable.
-
- unloadButton := Button label:(resources string:'unload').
- unloadButton action:[
- 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:[
- 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.
-
- box addButton:unloadButton.
- box addButton:unloadAndRemoveButton.
- box addAbortButtonLabelled:(resources string:'dismiss').
-
- y := box yPosition.
- listView2 topInset:(l preferredExtent y + 5).
- listView2 bottomInset:(box preferredExtent y - y).
-
- box width:(400 min:(box device width * 2 // 3));
- height:(450 min:(box device height - 50)).
-
-"/ box sizeFixed:true.
- box openWithExtent:(600 min:(box device width * 2 // 3))
- @
- (500 min:(box device height - 50)) .
-
- box destroy.
-
- "Modified: / 17.9.1995 / 16:47:50 / claus"
- "Created: / 31.7.1998 / 15:49:45 / cg"
- "Modified: / 10.8.1998 / 11:33:22 / cg"
-! !
-
-!Launcher::LauncherDialogs class methodsFor:'dialogs-private'!
-
-cvsConfigurationDialogFor:requestor
- |box y cvsRootHolder component resources defaultsList|
-
- resources := requestor class classResources.
-
- OperatingSystem isUNIXlike ifTrue:[
- defaultsList := #('/files/CVS' '/CVS' 'host:/files/CVS' 'host:/CVS').
- ] ifFalse:[
- OperatingSystem isMSDOSlike ifTrue:[
- defaultsList := #(':local:c:\files\CVS' ':local:c:\CVS' 'host:/files/CVS' 'host:/CVS').
- ] ifFalse:[
- defaultsList := #('host:/files/CVS' 'host:/CVS').
- ]
- ].
-
- cvsRootHolder := CVSSourceCodeManager repositoryName ? '/files/CVS'.
- cvsRootHolder := cvsRootHolder asValue.
-
- "/
- "/ create a box to input the CVSRoot ...
- "/
- box := DialogBox new.
- box label:(resources string:'CVS Setup').
-
- component := (box addTextLabel:'CVS SourceCodeManager setup').
- component adjust:#left.
-
- y := box yPosition.
- component := box addTextLabel:(resources string:'CVSRoot:').
- component width:0.25; adjust:#right; borderWidth:0.
- box yPosition:y.
- component := box addComboBoxOn:nil tabable:true.
-"/ commandListPop := box addInputFieldOn:printCommand tabable:true.
- component width:0.75; left:0.25; immediateAccept:true; acceptOnLeave:false; cursorMovementWhenUpdating:#beginOfLine.
- component list:defaultsList.
- component model:cvsRootHolder.
-
-"/ component := box
-"/ addLabelledInputField:(resources string:'CVSRoot:')
-"/ adjust:#right
-"/ on:nil
-"/ tabable:true
-"/ separateAtX:0.5.
-"/ component acceptOnLeave:false.
-"/ component model:cvsRootHolder.
-
- box
- addHelpButtonFor:'Launcher/sourceSettings.html';
- addAbortButton;
- addOkButton.
-
- "/
- "/ show the box ...
- "/
- box extent:400@300.
- box showAtPointer.
-
- "/
- "/ update system settings
- "/
- box accepted ifTrue:[
- CVSSourceCodeManager initializeForRepository:cvsRootHolder value
- ].
- box destroy
-
- "Modified: / 16.4.1998 / 17:18:16 / ca"
- "Modified: / 12.8.1998 / 17:09:02 / cg"
-!
-
-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 resources|
-
- resources := requestor class classResources.
-
- 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 readStyleSheetAndUpdateAllStyleCaches.
- 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: / 15.9.1998 / 22:04:51 / cg"
-!
-
-syntaxColorConfigurationDialogFor:requestor
- |box frame exampleView
- component
- resources exampleText coloredText recolorAction
- syntaxColor syntaxColors colorMenu oldUserPreferences
- syntaxEmphasises syntaxColorSelector syntaxEmphasisSelector syntaxColoringBox
- syntaxEmphasisesBox syntaxColoringResetBox syntaxColoringEnableBlock|
-
- resources := requestor class classResources.
-
- exampleText :=
-'methodSelector:methodArg
- "method comment:
- some stupid code to show the current settings"
-
- |methodVar|
-
- "/ another comment ...
- self foo:methodArg.
- self bar:methodVar.
- "self bar:methodVar. detect commented code easily"
- 1 to:5 do:[:i | self baz:i + 1].
- Transcript showCR:''some string'' , #someSymbol.
-'.
-
- coloredText := '' asValue.
- recolorAction := [ coloredText value:(SyntaxHighlighter formatMethod:exampleText in:nil) ].
- recolorAction value.
-
- "/
- "/ create a box on those values ...
- "/
- box := DialogBox new.
- box label:(resources string:'Syntax Colors').
-
- frame := View new.
- frame extent:1.0 @ 200.
- frame borderWidth:0.
-
- exampleView := HVScrollableView for:TextView in:frame.
- exampleView model:coloredText.
- exampleView origin:0.0@0.0 corner:1.0@1.0; inset:2.
-
- frame topInset:box yPosition.
- box addComponent:frame withExtent:1.0@200.
- box makeTabable:exampleView.
- frame width:1.0.
-
- box addVerticalSpace.
-
- oldUserPreferences := UserPreferences current copy.
-
- syntaxColoringBox := box addComboListOn: (syntaxColors := SelectionInList with:UserPreferences syntaxColors initialSelection:1).
- syntaxColorSelector := [(syntaxColors selection replChar:$ withString: '') asLowercaseFirst asSymbol].
- syntaxEmphasisSelector := [((syntaxColorSelector value readStream upToAll: 'Color'), 'Emphasis') asLowercaseFirst asSymbol].
- syntaxColor := (UserPreferences current perform: syntaxColorSelector value) asValue.
- colorMenu := ColorMenu new.
- colorMenu model: syntaxColor.
- syntaxColor onChangeSend: #value to:
- [UserPreferences current at: syntaxColorSelector value put: syntaxColor value.
- recolorAction value.].
- syntaxColors onChangeSend: #value to:
- [syntaxColor value: (UserPreferences current perform:syntaxColorSelector value).
- syntaxEmphasises selection: (UserPreferences current perform: syntaxEmphasisSelector value).
- recolorAction value.].
- syntaxEmphasisesBox := box addComboListOn: (syntaxEmphasises := SelectionInList with:#(normal underline bold boldUnderline italic italicUnderline reverse) initialSelection:1).
- syntaxEmphasises onChangeSend: #value to:
- [UserPreferences current at: syntaxEmphasisSelector value put: syntaxEmphasises selection asSymbol.
- recolorAction value].
- syntaxColors changed:#value. "/ to force initial update of emphasis
- box addComponent:colorMenu tabable:true.
- syntaxColoringResetBox := box addComponent:(Button new label: (resources string:'reset'); action: [UserPreferences reset. syntaxColor value: (UserPreferences current perform:syntaxColorSelector value)]).
- box makeTabable:syntaxColoringResetBox.
-
- syntaxColoringBox enable. colorMenu enable. syntaxEmphasisesBox enable. syntaxColoringResetBox enable.
-
- box
-"/ addHelpButtonFor:'Launcher/sourceSettings.html';
- addAbortButton;
- addOkButton.
-
- "/
- "/ show the box ...
- "/
- box extent:400@300.
- box openModal.
-
- "/
- "/ update system settings
- "/
- box accepted ifTrue:[
- ] ifFalse: [
- (UserPreferences reset; current) declareAllFrom: oldUserPreferences
- ].
- box destroy
-
- "Modified: / 16.4.1998 / 17:18:16 / ca"
- "Modified: / 31.7.1998 / 01:37:46 / cg"
-! !
-
!Launcher class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/Launcher.st,v 1.399 1999-02-10 01:36:04 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Launcher.st,v 1.400 1999-02-11 11:14:21 cg Exp $'
! !