diff -r 8c9e77aa7780 -r 3d4249692d25 AbstractLauncherApplication.st --- /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" + + + + |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 $' +! !