--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/AbstractLauncherApplication.st Thu Feb 11 12:14:01 1999 +0100
@@ -0,0 +1,3486 @@
+ToolApplicationModel subclass:#AbstractLauncherApplication
+ instanceVariableNames:''
+ classVariableNames:'NotifyingEmergencyHandler OpenLaunchers'
+ poolDictionaries:''
+ category:'Interface-Smalltalk'
+!
+
+Object subclass:#LauncherDialogs
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:AbstractLauncherApplication
+!
+
+
+!AbstractLauncherApplication 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)
+! !
+
+!AbstractLauncherApplication class methodsFor:'defaults'!
+
+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"
+! !
+
+!AbstractLauncherApplication methodsFor:'private'!
+
+showDocumentation:aRelativeDocFilePath
+ "open an HTML browser on some document"
+
+ "
+ although that one is not yet finished,
+ its better than nothing ...
+ "
+ HTMLDocumentView notNil ifTrue:[
+ self withWaitCursorDo:[
+ "
+ 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: / 25.2.1998 / 21:24:20 / cg"
+! !
+
+!AbstractLauncherApplication methodsFor:'user actions - about'!
+
+openLicenseConditions
+ "open an HTML browser on the 'LICENCE' document"
+
+ self withWaitCursorDo:[
+ |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: / 5.2.1998 / 21:43:19 / cg"
+ "Modified: / 23.4.1998 / 11:45:53 / cg"
+! !
+
+!AbstractLauncherApplication methodsFor:'user actions - file'!
+
+objectModuleDialog
+ "opens a moduleInfo dialog"
+
+ ^ LauncherDialogs objectModuleDialogFor:self
+
+ "Modified: / 31.7.1998 / 17:33:24 / cg"
+!
+
+saveImageAs: aFileName
+ "save image in aFilename"
+
+ aFileName notNil ifTrue:[
+ self withCursor:Cursor write do:[
+ (ObjectMemory snapShotOn:aFileName) ifFalse:[
+ self warn:(resources string:'Failed to save snapshot image (disk full or not writable)').
+ ]
+ ].
+ ].
+! !
+
+!AbstractLauncherApplication methodsFor:'user actions - help'!
+
+showBookPrintDocument
+ "open an HTML browser on the 'book'-printing document"
+
+ self showDocumentation:'BOOK.html'
+!
+
+startClassDocumentation
+ "open an HTML browser on the 'classDoc/TOP' document"
+
+ self showDocumentation:'classDoc/TOP.html'
+
+!
+
+startDocumentationIndex
+ "open an HTML browser on the 'index' document"
+
+ self showDocumentation:'index.html'
+!
+
+startDocumentationTool
+ "open an HTML browser on the 'TOP' document"
+
+ self showDocumentation:'TOP.html'
+
+!
+
+startWhatsNewDocumentation
+ "open an HTML browser on the 'whatsNew.html' document"
+
+ self showDocumentation:'whatsNew.html'
+
+! !
+
+!AbstractLauncherApplication methodsFor:'user actions - settings'!
+
+compilerSettings
+ "open a dialog on compiler related settings"
+
+ self settingsDialog:#compilerSettingsFor:
+!
+
+displaySettings
+ "open a dialog on display related settings"
+
+ self settingsDialog:#displaySettingsFor:
+
+ "Modified: / 31.7.1998 / 22:45:38 / cg"
+!
+
+editSettings
+ "open a dialog on edit settings"
+
+ self settingsDialog:#editSettingsFor:
+
+ "Modified: / 31.7.1998 / 22:46:56 / cg"
+ "Created: / 6.1.1999 / 14:14:48 / cg"
+!
+
+fontSettings
+ "open a dialog on font related settings"
+
+ self settingsDialog:#fontSettingsFor:
+
+ "Modified: / 31.7.1998 / 22:45:44 / cg"
+!
+
+javaSettings
+ "open a dialog on java-subsystem related settings"
+
+ self settingsDialog:#javaSettingsFor:
+
+ "Modified: / 31.7.1998 / 22:46:13 / cg"
+!
+
+keyboardSetting
+ "open a dialog on keyboard related settings"
+
+ self settingsDialog:#keyboardSettingsFor:
+
+ "Modified: / 31.7.1998 / 22:45:56 / cg"
+!
+
+languageSetting
+ "open a dialog on language related settings"
+
+ self settingsDialog:#languageSettingsFor:
+
+ "Modified: / 31.7.1998 / 22:46:13 / cg"
+!
+
+loadSettings
+ "restore settings from a settings-file."
+
+ "a temporary kludge - we need a central systemSettings object for this,
+ which can be saved/restored with a single store/read."
+
+ |fileName|
+
+ fileName := Dialog
+ requestFileName:(resources string:'load settings from:')
+ default:'settings.stx'
+ ok:(resources string:'load')
+ abort:(resources string:'cancel')
+ pattern:'*.stx'
+ fromDirectory:nil.
+
+ (fileName isNil or:[fileName isEmpty]) ifTrue:[
+ "/ canceled
+ ^ self
+ ].
+
+ self withWaitCursorDo:[
+ Smalltalk fileIn:fileName.
+ self reOpen
+ ].
+
+
+!
+
+memorySettings
+ "open a dialog on objectMemory related settings"
+
+ self settingsDialog:#memorySettingsFor:
+
+ "Modified: / 31.7.1998 / 22:46:33 / cg"
+!
+
+messageSettings
+ "open a dialog on infoMessage related settings"
+
+ self settingsDialog:#messageSettingsFor:
+
+ "Modified: / 31.7.1998 / 22:46:45 / cg"
+!
+
+miscSettings
+ "open a dialog on misc other settings"
+
+ self settingsDialog:#miscSettingsFor:
+
+ "Modified: / 31.7.1998 / 22:46:56 / cg"
+!
+
+printerSettings
+ "open a dialog on printer related settings"
+
+ self settingsDialog:#printerSettingsFor:
+
+ "Modified: / 31.7.1998 / 22:47:05 / cg"
+!
+
+saveSettings
+ "save settings to a settings-file."
+
+ self settingsDialog:#saveSettingsFor:
+
+ "Modified: / 31.7.1998 / 22:48:38 / cg"
+!
+
+settingsDialog:symbol
+ "open a dialog on viewStyle related settings"
+
+ LauncherDialogs perform:symbol with:self.
+
+ "Modified: / 31.7.1998 / 22:47:33 / cg"
+!
+
+sourceAndDebuggerSettings
+ "open a dialog on misc other settings"
+
+ self settingsDialog:#sourceAndDebuggerSettingsFor:
+
+ "Modified: / 31.7.1998 / 22:47:21 / cg"
+!
+
+toolSettings
+ "open a dialog on tool settings"
+
+ self settingsDialog:#toolSettingsFor:
+
+ "Modified: / 31.7.1998 / 22:46:56 / cg"
+ "Created: / 13.10.1998 / 15:50:53 / cg"
+!
+
+viewStyleSetting
+ "open a dialog on viewStyle related settings"
+
+ self settingsDialog:#viewStyleSettingsFor:
+
+ "Modified: / 31.7.1998 / 22:47:33 / cg"
+! !
+
+!AbstractLauncherApplication::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"
+! !
+
+!AbstractLauncherApplication::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"
+! !
+
+!AbstractLauncherApplication::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"
+! !
+
+!AbstractLauncherApplication class methodsFor:'documentation'!
+
+version
+ ^ '$Header: /cvs/stx/stx/libtool/AbstractLauncherApplication.st,v 1.1 1999-02-11 11:14:01 cg Exp $'
+! !