2819 ^ transcript |
2494 ^ transcript |
2820 |
2495 |
2821 "Created: 5.7.1996 / 13:04:36 / cg" |
2496 "Created: 5.7.1996 / 13:04:36 / cg" |
2822 ! ! |
2497 ! ! |
2823 |
2498 |
2824 !Launcher::LauncherDialogs class methodsFor:'dialogs'! |
2499 !Launcher class methodsFor:'documentation'! |
2825 |
2500 |
2826 compilerSettingsFor:requestor |
2501 version |
2827 "open a dialog on compiler related settings" |
2502 ^ '$Header: /cvs/stx/stx/libtool/Launcher.st,v 1.400 1999-02-11 11:14:21 cg Exp $' |
2828 |
|
2829 |box warnings warnSTX warnUnderscore warnDollar warnOldStyle |
|
2830 allowDollar allowUnderscore immutableArrays |
|
2831 warnSTXBox warnUnderscoreBox warnOldStyleBox warnCommonMistakes warnCommonMistakesBox |
|
2832 warnCompatibility warnCompatibilityBox warnDollarBox |
|
2833 stcCompilation compilationList stcCompilationOptions stcIncludes stcDefines stcOptions |
|
2834 stcLibraries stcLibraryPath cc stc ccOptions historyLines fullHistoryUpdate |
|
2835 catchMethodRedefs catchClassRedefs keepSourceOptions keepSource |
|
2836 constantFoldingOptions constantFolding justInTimeCompilation |
|
2837 warnEnabler check component oldIndent t supportsJustInTimeCompilation y |
|
2838 y2 fullDebugSupport yMax |
|
2839 compileLazy loadBinaries canLoadBinaries strings idx thisIsADemoVersion |
|
2840 resources stcSetupButt| |
|
2841 |
|
2842 resources := requestor class classResources. |
|
2843 |
|
2844 canLoadBinaries := ObjectFileLoader notNil and:[ObjectFileLoader canLoadObjectFiles]. |
|
2845 loadBinaries := Smalltalk loadBinaries asValue. |
|
2846 compileLazy := Autoload compileLazy asValue. |
|
2847 |
|
2848 warnings := Compiler warnings asValue. |
|
2849 |
|
2850 warnSTX := Compiler warnSTXSpecials asValue. |
|
2851 warnUnderscore := Compiler warnUnderscoreInIdentifier asValue. |
|
2852 warnDollar := Compiler warnDollarInIdentifier asValue. |
|
2853 warnOldStyle := Compiler warnOldStyleAssignment asValue. |
|
2854 warnCommonMistakes := Compiler warnCommonMistakes asValue. |
|
2855 warnCompatibility := Compiler warnPossibleIncompatibilities asValue. |
|
2856 allowUnderscore := Compiler allowUnderscoreInIdentifier asValue. |
|
2857 allowDollar := Compiler allowDollarInIdentifier asValue. |
|
2858 immutableArrays := Compiler arraysAreImmutable asValue. |
|
2859 |
|
2860 constantFoldingOptions := #( nil #level1 #level2 #full ). |
|
2861 constantFolding := SelectionInList new list:(resources array:#('disabled' 'level1 (always safe)' 'level2 (usually safe)' 'full')). |
|
2862 constantFolding selectionIndex:3. |
|
2863 |
|
2864 thisIsADemoVersion := (Smalltalk releaseIdentification = 'ST/X_free_demo_vsn'). |
|
2865 thisIsADemoVersion ifTrue:[ |
|
2866 stcCompilationOptions := #( never). |
|
2867 strings := #('never'). |
|
2868 idx := 1. |
|
2869 ] ifFalse:[ |
|
2870 stcCompilationOptions := #( always default never). |
|
2871 strings := #('always' 'primitive code only' 'never'). |
|
2872 idx := 2. |
|
2873 ]. |
|
2874 |
|
2875 stcCompilation := SelectionInList new list:(resources array:strings). |
|
2876 stcCompilation selectionIndex:idx. |
|
2877 |
|
2878 (supportsJustInTimeCompilation := ObjectMemory supportsJustInTimeCompilation) |
|
2879 ifTrue:[ |
|
2880 justInTimeCompilation := ObjectMemory justInTimeCompilation. |
|
2881 fullDebugSupport := ObjectMemory fullSingleStepSupport. |
|
2882 ] ifFalse:[ |
|
2883 justInTimeCompilation := false. |
|
2884 fullDebugSupport := (Compiler lineNumberInfo == #full) asValue. |
|
2885 ]. |
|
2886 justInTimeCompilation := justInTimeCompilation asValue. |
|
2887 fullDebugSupport := fullDebugSupport asValue. |
|
2888 |
|
2889 catchMethodRedefs := Class catchMethodRedefinitions asValue. |
|
2890 catchClassRedefs := Class catchClassRedefinitions asValue. |
|
2891 historyLines := HistoryManager notNil and:[HistoryManager isLoaded and:[HistoryManager isActive]]. |
|
2892 historyLines ifFalse:[ |
|
2893 fullHistoryUpdate := false asValue |
|
2894 ] ifTrue:[ |
|
2895 fullHistoryUpdate := HistoryManager fullHistoryUpdate asValue. |
|
2896 ]. |
|
2897 historyLines := historyLines asValue. |
|
2898 |
|
2899 keepSourceOptions := #( keep reference absReference sourceReference discard ). |
|
2900 keepSource := SelectionInList new list:(resources array:#('keep as string' 'reference to filename' 'reference to full path' 'append and ref in `st.src''' 'discard' )). |
|
2901 keepSource selectionIndex:1. |
|
2902 |
|
2903 warnEnabler := [ |
|
2904 warnings value ifTrue:[ |
|
2905 warnSTXBox enable. |
|
2906 warnOldStyleBox enable. |
|
2907 warnCommonMistakesBox enable. |
|
2908 warnCompatibilityBox enable. |
|
2909 allowUnderscore value ifTrue:[ |
|
2910 warnUnderscoreBox enable. |
|
2911 ] ifFalse:[ |
|
2912 warnUnderscoreBox disable. |
|
2913 ]. |
|
2914 allowDollar value ifTrue:[ |
|
2915 warnDollarBox enable. |
|
2916 ] ifFalse:[ |
|
2917 warnDollarBox disable. |
|
2918 ]. |
|
2919 ] ifFalse:[ |
|
2920 warnSTXBox disable. |
|
2921 warnUnderscoreBox disable. |
|
2922 warnDollarBox disable. |
|
2923 warnOldStyleBox disable. |
|
2924 warnCommonMistakesBox disable. |
|
2925 warnCompatibilityBox disable. |
|
2926 ]]. |
|
2927 |
|
2928 warnings onChangeSend:#value to:warnEnabler. |
|
2929 allowUnderscore onChangeSend:#value to:warnEnabler. |
|
2930 allowDollar onChangeSend:#value to:warnEnabler. |
|
2931 |
|
2932 box := DialogBox new. |
|
2933 box label:(resources string:'Compiler settings'). |
|
2934 |
|
2935 y := box yPosition. |
|
2936 check := box addCheckBox:(resources string:'catch method redefinitions') on:catchMethodRedefs. |
|
2937 check width:0.5. |
|
2938 |
|
2939 box yPosition:y. |
|
2940 check := box addCheckBox:(resources string:'catch class redefinitions') on:catchClassRedefs. |
|
2941 check left:0.5; width:0.5. |
|
2942 |
|
2943 y := box yPosition. |
|
2944 check := box addCheckBox:(resources string:'keep history line in methods') on:historyLines. |
|
2945 check width:0.5. |
|
2946 HistoryManager isNil ifTrue:[check disable]. |
|
2947 box yPosition:y. |
|
2948 check := box addCheckBox:(resources string:'keep full class history') on:fullHistoryUpdate. |
|
2949 check left:0.5; width:0.5. |
|
2950 HistoryManager isNil ifTrue:[check disable] ifFalse:[check enableChannel:historyLines]. |
|
2951 |
|
2952 box addPopUpList:(resources string:'fileIn source mode:') on:keepSource. |
|
2953 keepSource selectionIndex:( keepSourceOptions indexOf:(ClassCategoryReader sourceMode) ifAbsent:1). |
|
2954 |
|
2955 box addHorizontalLine. |
|
2956 |
|
2957 box addCheckBox:(resources string:'lazy compilation when autoloading') on:compileLazy. |
|
2958 check := box addCheckBox:(resources string:'if present, load binary objects when autoloading') on:loadBinaries. |
|
2959 canLoadBinaries ifFalse:[ |
|
2960 loadBinaries value:false. |
|
2961 check disable |
|
2962 ]. |
|
2963 supportsJustInTimeCompilation ifTrue:[ |
|
2964 component := box |
|
2965 addCheckBox:(resources string:'just in time compilation to machine code') |
|
2966 on:justInTimeCompilation. |
|
2967 ]. |
|
2968 |
|
2969 box addHorizontalLine. |
|
2970 |
|
2971 ObjectFileLoader notNil ifTrue:[ |
|
2972 compilationList := box addPopUpList:(resources string:'stc compilation to machine code') on:stcCompilation. |
|
2973 |
|
2974 thisIsADemoVersion ifFalse:[ |
|
2975 stcCompilation selectionIndex:( stcCompilationOptions indexOf:(Compiler stcCompilation) ifAbsent:2). |
|
2976 |
|
2977 stcSetupButt := box addComponent:(Button label:(resources string:'stc compilation parameters...') |
|
2978 action:[|manager| |
|
2979 |
|
2980 self stcCompilerSettingsFor:requestor. |
|
2981 ]). |
|
2982 ]. |
|
2983 |
|
2984 box addHorizontalLine. |
|
2985 |
|
2986 "/ if there is no compiler around, |
|
2987 "/ change to compile nothing, and disable the checkBoxes |
|
2988 Compiler canCreateMachineCode ifFalse:[ |
|
2989 stcCompilation selectionIndex:(3 min:stcCompilationOptions size). |
|
2990 compilationList disable. |
|
2991 ]. |
|
2992 ]. |
|
2993 |
|
2994 y := box yPosition. |
|
2995 |
|
2996 component := box addCheckBox:(resources string:'allow underscore in identifiers') on:allowUnderscore. |
|
2997 component width:0.4. |
|
2998 |
|
2999 component := box addCheckBox:(resources string:'allow dollar in identifiers') on:allowDollar. |
|
3000 component width:0.4. |
|
3001 |
|
3002 component := box addCheckBox:(resources string:'literal arrays are immutable') on:immutableArrays. |
|
3003 component width:0.4. |
|
3004 y2 := box yPosition. |
|
3005 |
|
3006 box yPosition:y. |
|
3007 box leftIndent:0. |
|
3008 |
|
3009 component :=box addPopUpList:(resources string:'constant folding:') on:constantFolding. |
|
3010 component superView left:0.5; width:0.5. |
|
3011 constantFolding selectionIndex:( constantFoldingOptions indexOf:(Compiler foldConstants) ifAbsent:1). |
|
3012 |
|
3013 component := box addCheckBox:(resources string:'full debug info') on:fullDebugSupport. |
|
3014 component left:0.5; width:0.4. |
|
3015 box yPosition:(box yPosition max:y2). |
|
3016 |
|
3017 |
|
3018 box addHorizontalLine. |
|
3019 |
|
3020 box addCheckBox:(resources string:'warnings') on:warnings. |
|
3021 "/ box addVerticalSpace. |
|
3022 oldIndent := box leftIndent. |
|
3023 box leftIndent:30. |
|
3024 |
|
3025 y := box yPosition. |
|
3026 |
|
3027 warnSTXBox := box addCheckBox:(resources string:'ST/X extensions') on:warnSTX. |
|
3028 warnSTXBox width:0.4. |
|
3029 |
|
3030 warnUnderscoreBox := box addCheckBox:(resources string:'underscores in identifiers') on:warnUnderscore. |
|
3031 warnUnderscoreBox width:0.4. |
|
3032 |
|
3033 warnDollarBox := box addCheckBox:(resources string:'dollars in identifiers') on:warnDollar. |
|
3034 warnDollarBox width:0.4. |
|
3035 |
|
3036 yMax := box yPosition. |
|
3037 |
|
3038 box yPosition:y. |
|
3039 box leftIndent:0. |
|
3040 warnOldStyleBox := box addCheckBox:(resources string:'oldStyle assignment') on:warnOldStyle. |
|
3041 warnOldStyleBox left:0.5; width:0.4. |
|
3042 |
|
3043 warnCommonMistakesBox := box addCheckBox:(resources string:'common mistakes') on:warnCommonMistakes. |
|
3044 warnCommonMistakesBox left:0.5; width:0.4. |
|
3045 |
|
3046 warnCompatibilityBox := box addCheckBox:(resources string:'possible incompatibilities') on:warnCompatibility. |
|
3047 warnCompatibilityBox left:0.5; width:0.4. |
|
3048 |
|
3049 box leftIndent:oldIndent. |
|
3050 box yPosition:(yMax max: box yPosition). |
|
3051 |
|
3052 box |
|
3053 addHelpButtonFor:'Launcher/compilerSettings.html'; |
|
3054 addAbortButton; |
|
3055 addOkButton. |
|
3056 |
|
3057 warnEnabler value. |
|
3058 box open. |
|
3059 |
|
3060 box accepted ifTrue:[ |
|
3061 HistoryManager notNil ifTrue:[ |
|
3062 HistoryManager fullHistoryUpdate:fullHistoryUpdate value. |
|
3063 historyLines value ifTrue:[ |
|
3064 HistoryManager activate |
|
3065 ] ifFalse:[ |
|
3066 HistoryManager deactivate |
|
3067 ]. |
|
3068 ]. |
|
3069 Class catchMethodRedefinitions:catchMethodRedefs value. |
|
3070 Class catchClassRedefinitions:catchClassRedefs value. |
|
3071 ClassCategoryReader sourceMode:(keepSourceOptions at:keepSource selectionIndex). |
|
3072 Compiler warnings:warnings value. |
|
3073 Compiler warnSTXSpecials:warnSTX value. |
|
3074 Compiler warnOldStyleAssignment:warnOldStyle value. |
|
3075 Compiler warnUnderscoreInIdentifier:warnUnderscore value. |
|
3076 Compiler warnDollarInIdentifier:warnDollar value. |
|
3077 Compiler warnCommonMistakes:warnCommonMistakes value. |
|
3078 Compiler warnPossibleIncompatibilities:warnCompatibility value. |
|
3079 Compiler allowUnderscoreInIdentifier:allowUnderscore value. |
|
3080 Compiler allowDollarInIdentifier:allowDollar value. |
|
3081 Compiler arraysAreImmutable:immutableArrays value. |
|
3082 fullDebugSupport value ifTrue:[ |
|
3083 Compiler lineNumberInfo:#full. |
|
3084 ] ifFalse:[ |
|
3085 Compiler lineNumberInfo:true |
|
3086 ]. |
|
3087 |
|
3088 Compiler stcCompilation:(stcCompilationOptions at:stcCompilation selectionIndex). |
|
3089 Compiler foldConstants:(constantFoldingOptions at:constantFolding selectionIndex). |
|
3090 |
|
3091 supportsJustInTimeCompilation ifTrue:[ |
|
3092 justInTimeCompilation := justInTimeCompilation value. |
|
3093 justInTimeCompilation ifTrue:[ |
|
3094 Method allInstancesDo:[:m | m checked:false]. |
|
3095 ]. |
|
3096 ObjectMemory justInTimeCompilation:justInTimeCompilation. |
|
3097 ObjectMemory fullSingleStepSupport:fullDebugSupport value. |
|
3098 ]. |
|
3099 Autoload compileLazy:compileLazy value. |
|
3100 Smalltalk loadBinaries:loadBinaries value. |
|
3101 ]. |
|
3102 box destroy |
|
3103 |
|
3104 "Modified: / 10.9.1995 / 19:19:18 / claus" |
|
3105 "Modified: / 9.9.1996 / 22:42:47 / stefan" |
|
3106 "Modified: / 5.11.1998 / 14:25:59 / cg" |
|
3107 ! |
|
3108 |
|
3109 displaySettingsFor:requestor |
|
3110 "open a dialog on display related settings" |
|
3111 |
|
3112 |box listOfSizes sizeInfos |
|
3113 sizes sizeNames sizeList sizeX sizeY deepIcons |
|
3114 isColorMonitor useFixPalette useFixGrayPalette idx ditherStyles ditherSyms ditherList |
|
3115 y component screen visual clipEncodings clipEncodingSyms clipEncodingList resources| |
|
3116 |
|
3117 resources := requestor class classResources. |
|
3118 |
|
3119 listOfSizes := resources at:'LIST_OF_OFFERED_SCREEN_SIZES' default:#default. |
|
3120 listOfSizes == #default ifTrue:[ |
|
3121 "/ nothing in resource file; offer at least some. |
|
3122 sizeInfos := #( |
|
3123 ( '11.3'' (235mm x 175mm) LCD' (235 175) ) |
|
3124 ( '17'' (325mm x 245mm)' (325 245) ) |
|
3125 ( '19'' (340mm x 270mm)' (340 270) ) |
|
3126 ( '20'' (350mm x 280mm)' (350 280) ) |
|
3127 ( '21'' (365mm x 285mm)' (365 285) ) |
|
3128 ). |
|
3129 ] ifFalse:[ |
|
3130 sizeInfos := resources array:listOfSizes. |
|
3131 ]. |
|
3132 sizeNames := sizeInfos collect:[:entry | entry at:1]. |
|
3133 sizes := sizeInfos collect:[:entry | entry at:2]. |
|
3134 |
|
3135 screen := Screen current. |
|
3136 visual := screen visualType. |
|
3137 |
|
3138 isColorMonitor := screen hasColors asValue. |
|
3139 deepIcons := screen supportsDeepIcons asValue. |
|
3140 useFixPalette := screen fixColors notNil asValue. |
|
3141 useFixGrayPalette := screen fixGrayColors notNil asValue. |
|
3142 |
|
3143 sizeList := SelectionInList with:sizeNames. |
|
3144 sizeX := screen widthInMillimeter asValue. |
|
3145 sizeY := screen heightInMillimeter asValue. |
|
3146 |
|
3147 clipEncodingSyms := #(nil #iso8859 #jis #jis7 #sjis #euc #big5). |
|
3148 clipEncodings := resources array:#('untranslated' 'iso8859' 'jis' 'jis7' 'shift-JIS' 'EUC' 'big5'). |
|
3149 clipEncodingList := SelectionInList new. |
|
3150 clipEncodingList list:clipEncodings. |
|
3151 clipEncodingList selectionIndex:(clipEncodingSyms indexOf:screen clipBoardEncoding ifAbsent:1). |
|
3152 |
|
3153 ditherList := SelectionInList new. |
|
3154 |
|
3155 (visual == #StaticGray or:[visual == #GrayScale]) ifTrue:[ |
|
3156 ditherStyles := #('threshold' 'ordered dither' 'error diffusion'). |
|
3157 ditherSyms := #(threshold ordered floydSteinberg). |
|
3158 ] ifFalse:[ |
|
3159 visual ~~ #TrueColor ifTrue:[ |
|
3160 ditherStyles := #('nearest color' 'error diffusion'). |
|
3161 ditherSyms := #(ordered floydSteinberg). |
|
3162 ] |
|
3163 ]. |
|
3164 ditherSyms notNil ifTrue:[ |
|
3165 ditherList list:ditherStyles. |
|
3166 ditherList selectionIndex:(ditherSyms indexOf:(Image ditherAlgorithm) ifAbsent:#threshold). |
|
3167 ]. |
|
3168 |
|
3169 box := DialogBox new. |
|
3170 box label:(resources string:'Display screen settings'). |
|
3171 |
|
3172 (box addTextLabel:(resources string:'Actual visible screen area:')) |
|
3173 adjust:#left. |
|
3174 |
|
3175 (box addPopUpList:(resources string:'common sizes:') on:sizeList) |
|
3176 label:'monitor size'. |
|
3177 |
|
3178 idx := sizes findFirst:[:entry | |
|
3179 ((entry at:1) = sizeX value) |
|
3180 and:[((entry at:2) = sizeY value)] |
|
3181 ]. |
|
3182 idx ~~ 0 ifTrue:[ |
|
3183 sizeList selectionIndex:idx |
|
3184 ]. |
|
3185 |
|
3186 sizeList onChangeSend:#value to:[ |
|
3187 |idx| |
|
3188 |
|
3189 idx := sizeList selectionIndex. |
|
3190 sizeX value:((sizes at:idx) at:1). |
|
3191 sizeY value:((sizes at:idx) at:2). |
|
3192 ]. |
|
3193 |
|
3194 y := box yPosition. |
|
3195 component := box addTextLabel:(resources string:'screen size:'). |
|
3196 component width:0.3; adjust:#right; borderWidth:0. |
|
3197 |
|
3198 box yPosition:y. |
|
3199 component := box addInputFieldOn:nil tabable:true. |
|
3200 component width:0.25; left:0.3; |
|
3201 immediateAccept:false; acceptOnLeave:false; |
|
3202 cursorMovementWhenUpdating:#beginOfLine; |
|
3203 converter:(PrintConverter new initForInteger); |
|
3204 model:sizeX. |
|
3205 |
|
3206 box yPosition:y. |
|
3207 component := box addTextLabel:(' x '). |
|
3208 component width:0.1; left:0.55; adjust:#center; borderWidth:0. |
|
3209 |
|
3210 box yPosition:y. |
|
3211 component := box addInputFieldOn:nil tabable:true. |
|
3212 component width:0.25; left:0.65; |
|
3213 immediateAccept:false; acceptOnLeave:false; |
|
3214 cursorMovementWhenUpdating:#beginOfLine; |
|
3215 converter:(PrintConverter new initForInteger); |
|
3216 model:sizeY. |
|
3217 |
|
3218 box yPosition:y. |
|
3219 component := box addTextLabel:('(mm)'). |
|
3220 component width:0.1; left:0.9; adjust:#center; borderWidth:0. |
|
3221 |
|
3222 box addVerticalSpace; addHorizontalLine; addVerticalSpace. |
|
3223 |
|
3224 (box addTextLabel:(resources string:'Screen: depth: %1 visual: %2 (%3)' |
|
3225 with:Screen current depth printString |
|
3226 with:Screen current visualType |
|
3227 with:Screen current serverVendor)) |
|
3228 adjust:#left. |
|
3229 |
|
3230 box addVerticalSpace; addHorizontalLine; addVerticalSpace. |
|
3231 |
|
3232 box addCheckBox:(resources string:'color monitor') on:isColorMonitor. |
|
3233 |
|
3234 visual == #PseudoColor ifTrue:[ |
|
3235 box addVerticalSpace. |
|
3236 component := box addCheckBox:(resources string:'use fix color palette %1' with:'(4x8x4)') on:useFixPalette. |
|
3237 |
|
3238 box addVerticalSpace. |
|
3239 component := box addCheckBox:(resources string:'use fix gray color palette %1' with:'(32)') on:useFixGrayPalette. |
|
3240 ]. |
|
3241 |
|
3242 ditherSyms notNil ifTrue:[ |
|
3243 box addVerticalSpace. |
|
3244 component := box addPopUpList:(resources string:'image display:') on:ditherList. |
|
3245 component defaultLabel:'image display'. |
|
3246 component superView horizontalLayout:#leftSpace. |
|
3247 ]. |
|
3248 |
|
3249 box addVerticalSpace. |
|
3250 box addCheckBox:(resources string:'allow colored/grayscale icons') on:deepIcons. |
|
3251 |
|
3252 box addVerticalSpace; addHorizontalLine; addVerticalSpace. |
|
3253 |
|
3254 component := box addPopUpList:(resources string:'clipBoard encoding:') on:clipEncodingList. |
|
3255 component superView horizontalLayout:#leftSpace. |
|
3256 |
|
3257 box |
|
3258 addHelpButtonFor:'Launcher/screenSettings.html'; |
|
3259 addAbortButton; addOkButton. |
|
3260 box open. |
|
3261 |
|
3262 box accepted ifTrue:[ |
|
3263 Image flushDeviceImages. |
|
3264 |
|
3265 screen visualType == #PseudoColor ifTrue:[ |
|
3266 useFixPalette value ifTrue:[ |
|
3267 Color colorAllocationFailSignal handle:[:ex | |
|
3268 self warn:(resources string:'Could not allocate colors.'). |
|
3269 ] do:[ |
|
3270 Color getColorsRed:4 green:8 blue:4 on:screen |
|
3271 ] |
|
3272 ] ifFalse:[ |
|
3273 screen releaseFixColors |
|
3274 ]. |
|
3275 |
|
3276 useFixGrayPalette value ifTrue:[ |
|
3277 Color colorAllocationFailSignal handle:[:ex | |
|
3278 self warn:(resources string:'Could not allocate colors.'). |
|
3279 ] do:[ |
|
3280 Color getGrayColors:32 on:screen |
|
3281 ] |
|
3282 ] ifFalse:[ |
|
3283 screen releaseFixGrayColors |
|
3284 ] |
|
3285 ]. |
|
3286 screen hasColors:isColorMonitor value. |
|
3287 screen widthInMillimeter:sizeX value. |
|
3288 screen heightInMillimeter:sizeY value. |
|
3289 |
|
3290 screen supportsDeepIcons:deepIcons value. |
|
3291 ditherSyms notNil ifTrue:[ |
|
3292 Image ditherAlgorithm:(ditherSyms at:ditherList selectionIndex). |
|
3293 ]. |
|
3294 |
|
3295 requestor withWaitCursorDo:[ |
|
3296 View defaultStyle:(View defaultStyle). |
|
3297 ]. |
|
3298 |
|
3299 screen clipBoardEncoding:(clipEncodingSyms at:clipEncodingList selectionIndex). |
|
3300 ]. |
|
3301 box destroy |
|
3302 |
|
3303 "Modified: 9.9.1996 / 22:43:04 / stefan" |
|
3304 "Modified: 21.7.1997 / 19:26:49 / cg" |
|
3305 ! |
|
3306 |
|
3307 editSettingsFor:requestor |
|
3308 "open a dialog on edit settings" |
|
3309 |
|
3310 |box |
|
3311 st80EditingMode st80DoubleClickSelectMode resources y |
|
3312 | |
|
3313 |
|
3314 resources := requestor class classResources. |
|
3315 |
|
3316 "/ |
|
3317 "/ extract relevant system settings ... |
|
3318 "/ |
|
3319 st80EditingMode := EditTextView st80Mode asValue. |
|
3320 st80DoubleClickSelectMode := TextView st80SelectMode asValue. |
|
3321 |
|
3322 "/ |
|
3323 "/ create a box on those values ... |
|
3324 "/ |
|
3325 box := DialogBox new. |
|
3326 box label:(resources string:'Edit settings'). |
|
3327 |
|
3328 box addCheckBox:(resources string:'cursor has ST80 line end behavior') on:st80EditingMode. |
|
3329 box addCheckBox:(resources string:'double click select behavior as in ST80') on:st80DoubleClickSelectMode. |
|
3330 |
|
3331 box addHorizontalLine. |
|
3332 |
|
3333 box |
|
3334 addHelpButtonFor:'Launcher/editSettings.html'; |
|
3335 addAbortButton; |
|
3336 addOkButton. |
|
3337 |
|
3338 "/ |
|
3339 "/ show the box ... |
|
3340 "/ |
|
3341 box open. |
|
3342 |
|
3343 "/ |
|
3344 "/ update system settings |
|
3345 "/ |
|
3346 box accepted ifTrue:[ |
|
3347 EditTextView st80Mode:(st80EditingMode value). |
|
3348 TextView st80SelectMode:(st80DoubleClickSelectMode value). |
|
3349 ]. |
|
3350 box destroy |
|
3351 |
|
3352 "Created: / 6.1.1999 / 14:12:09 / cg" |
|
3353 "Modified: / 6.1.1999 / 14:17:51 / cg" |
|
3354 ! |
|
3355 |
|
3356 fontSettingsFor:requestor |
|
3357 "open a dialog on font related settings" |
|
3358 |
|
3359 (self fontBoxForEncoding:nil for:requestor) ifTrue:[ |
|
3360 requestor reopenLauncher. |
|
3361 ] |
|
3362 |
|
3363 "Created: 26.2.1996 / 22:52:51 / cg" |
|
3364 "Modified: 8.1.1997 / 14:52:49 / cg" |
|
3365 ! |
|
3366 |
|
3367 javaSettingsFor:requestor |
|
3368 "open a dialog on settings related to the java subsystem" |
|
3369 |
|
3370 |box audio javaHome resources component |
|
3371 extraFileSecurityChecks extraSocketSecurityChecks |
|
3372 supportsJustInTimeCompilation |
|
3373 javaJustInTimeCompilation javaNativeCodeOptimization |
|
3374 showJavaByteCode exceptionDebug| |
|
3375 |
|
3376 resources := requestor class classResources. |
|
3377 |
|
3378 audio := JavaVM audioEnabled asValue. |
|
3379 extraFileSecurityChecks := JavaVM fileOpenConfirmation asValue. |
|
3380 extraSocketSecurityChecks := JavaVM socketConnectConfirmation asValue. |
|
3381 (supportsJustInTimeCompilation := ObjectMemory supportsJustInTimeCompilation) ifTrue:[ |
|
3382 javaJustInTimeCompilation := ObjectMemory javaJustInTimeCompilation asValue. |
|
3383 javaNativeCodeOptimization := ObjectMemory javaNativeCodeOptimization asValue. |
|
3384 ] ifFalse:[ |
|
3385 javaJustInTimeCompilation := javaNativeCodeOptimization := false |
|
3386 ]. |
|
3387 showJavaByteCode := JavaMethod forceByteCodeDisplay asValue. |
|
3388 exceptionDebug := JavaVM exceptionDebug asValue. |
|
3389 |
|
3390 javaHome := (Java javaHome ? '') asValue. |
|
3391 |
|
3392 box := DialogBox new. |
|
3393 box label:(resources string:'Java'). |
|
3394 |
|
3395 box addCheckBox:(resources string:'Audio Enabled') on:audio. |
|
3396 box addCheckBox:(resources string:'Confirm file open for write') on:extraFileSecurityChecks. |
|
3397 box addCheckBox:(resources string:'Confirm socket connect') on:extraSocketSecurityChecks. |
|
3398 box addCheckBox:(resources string:'Debug Exceptions') on:exceptionDebug. |
|
3399 box addHorizontalLine. |
|
3400 supportsJustInTimeCompilation ifTrue:[ |
|
3401 box |
|
3402 addCheckBox:(resources string:'java just in time compilation to machine code') |
|
3403 on:javaJustInTimeCompilation. |
|
3404 box |
|
3405 addCheckBox:(resources string:'optimize native code') |
|
3406 on:javaNativeCodeOptimization. |
|
3407 ]. |
|
3408 box addHorizontalLine. |
|
3409 box addCheckBox:(resources string:'Display java byteCode (i.e. not source)') on:showJavaByteCode. |
|
3410 box addHorizontalLine. |
|
3411 component := box |
|
3412 addLabelledInputField:(resources string:'java home:') |
|
3413 adjust:#right |
|
3414 on:javaHome |
|
3415 tabable:true |
|
3416 separateAtX:0.3. |
|
3417 component acceptOnLeave:false. |
|
3418 |
|
3419 box addVerticalSpace. |
|
3420 box addComponent:(Button |
|
3421 label:(resources string:'Reinit VM now') |
|
3422 action:[ |
|
3423 Java classPath size == 0 ifTrue:[ |
|
3424 Java initialize. |
|
3425 ]. |
|
3426 Java classPath size == 0 ifTrue:[ |
|
3427 self warn:'No JDK found'. |
|
3428 ] ifFalse:[ |
|
3429 JavaVM initializeVM |
|
3430 ] |
|
3431 ]). |
|
3432 |
|
3433 box addComponent:(Button |
|
3434 label:(resources string:'Remove all Java classes now') |
|
3435 action:[ |
|
3436 Java flushAllJavaResources |
|
3437 ]). |
|
3438 |
|
3439 "/ box addHorizontalLine. |
|
3440 |
|
3441 "/ box addHelpButtonFor:'Launcher/javaSettings.html'. |
|
3442 box addAbortButton; addOkButton. |
|
3443 box open. |
|
3444 |
|
3445 box accepted ifTrue:[ |
|
3446 JavaMethod forceByteCodeDisplay:showJavaByteCode value. |
|
3447 JavaVM audioEnabled:audio value. |
|
3448 JavaVM exceptionDebug:exceptionDebug value. |
|
3449 JavaVM fileOpenConfirmation: extraFileSecurityChecks value. |
|
3450 JavaVM socketConnectConfirmation: extraSocketSecurityChecks value. |
|
3451 javaJustInTimeCompilation value ~~ ObjectMemory javaJustInTimeCompilation ifTrue:[ |
|
3452 ObjectMemory javaJustInTimeCompilation:javaJustInTimeCompilation value. |
|
3453 javaJustInTimeCompilation value ifTrue:[ |
|
3454 JavaMethod allSubInstancesDo:[:m | m checked:false]. |
|
3455 ]. |
|
3456 ]. |
|
3457 javaNativeCodeOptimization value ~~ ObjectMemory javaNativeCodeOptimization ifTrue:[ |
|
3458 ObjectMemory javaNativeCodeOptimization:javaNativeCodeOptimization value. |
|
3459 ]. |
|
3460 ]. |
|
3461 box destroy |
|
3462 |
|
3463 "Created: / 18.7.1998 / 22:32:58 / cg" |
|
3464 "Modified: / 27.1.1999 / 20:16:03 / cg" |
|
3465 ! |
|
3466 |
|
3467 keyboardSettingsFor:requestor |
|
3468 "open a dialog on keyboard related settings" |
|
3469 |
|
3470 |mappings listOfRawKeys listOfFunctions |
|
3471 box l |
|
3472 list1 list2 listView1 listView2 |
|
3473 frame selectionForwarder macroForwarder macroTextView y resources| |
|
3474 |
|
3475 resources := requestor class classResources. |
|
3476 |
|
3477 mappings := Screen current keyboardMap. |
|
3478 |
|
3479 listOfRawKeys := (mappings keys asArray collect:[:key | key asString]) sort. |
|
3480 listOfFunctions := (mappings values asSet asArray collect:[:key | key asString]) sort. |
|
3481 |
|
3482 selectionForwarder := Plug new. |
|
3483 selectionForwarder respondTo:#showFunction |
|
3484 with:[ |
|
3485 |raw| |
|
3486 raw := list1 selection. |
|
3487 list2 retractInterestsFor:selectionForwarder. |
|
3488 list2 selection:(mappings at:raw asSymbol) asString. |
|
3489 list2 onChangeSend:#showRawKey to:selectionForwarder. |
|
3490 ]. |
|
3491 selectionForwarder respondTo:#showRawKey |
|
3492 with:[ |
|
3493 |f raw| |
|
3494 |
|
3495 f := list2 selection. |
|
3496 list1 retractInterestsFor:selectionForwarder. |
|
3497 raw := mappings keyAtValue:f asString. |
|
3498 raw isNil ifTrue:[ |
|
3499 raw := mappings keyAtValue:f first. |
|
3500 raw isNil ifTrue:[ |
|
3501 raw := mappings keyAtValue:f asSymbol. |
|
3502 ] |
|
3503 ]. |
|
3504 list1 selection:raw. |
|
3505 list1 onChangeSend:#showFunction to:selectionForwarder. |
|
3506 ]. |
|
3507 |
|
3508 macroForwarder := [ |
|
3509 |f macro indent| |
|
3510 f := list2 selection. |
|
3511 (f startsWith:'Cmd') ifTrue:[ |
|
3512 f := f copyFrom:4 |
|
3513 ]. |
|
3514 macro := FunctionKeySequences at:(f asSymbol) ifAbsent:nil. |
|
3515 macro notNil ifTrue:[ |
|
3516 macro := macro asStringCollection. |
|
3517 indent := macro |
|
3518 inject:99999 into:[:min :element | |
|
3519 |stripped| |
|
3520 |
|
3521 stripped := element withoutLeadingSeparators. |
|
3522 stripped size == 0 ifTrue:[ |
|
3523 min |
|
3524 ] ifFalse:[ |
|
3525 min min:(element size - stripped size) |
|
3526 ] |
|
3527 ]. |
|
3528 indent ~~ 0 ifTrue:[ |
|
3529 macro := macro collect:[:line | |
|
3530 line size > indent ifTrue:[ |
|
3531 line copyFrom:indent+1 |
|
3532 ] ifFalse:[ |
|
3533 line |
|
3534 ]. |
|
3535 ] |
|
3536 ]. |
|
3537 ]. |
|
3538 macroTextView contents:macro. |
|
3539 ]. |
|
3540 |
|
3541 list1 := SelectionInList with:listOfRawKeys. |
|
3542 list1 onChangeSend:#showFunction to:selectionForwarder. |
|
3543 |
|
3544 list2 := SelectionInList with:listOfFunctions. |
|
3545 list2 onChangeSend:#showRawKey to:selectionForwarder. |
|
3546 list2 onChangeSend:#value to:macroForwarder. |
|
3547 |
|
3548 box := Dialog new. |
|
3549 box label:(resources string:'Keyboard mappings'). |
|
3550 |
|
3551 l := box addTextLabel:(resources at:'KEY_MSG' default:'keyboard mapping:') withCRs. |
|
3552 l adjust:#left; borderWidth:0. |
|
3553 |
|
3554 frame := View new. |
|
3555 frame extent:300 @ 300. |
|
3556 frame borderWidth:0. |
|
3557 |
|
3558 listView1 := ScrollableView for:SelectionInListView in:frame. |
|
3559 listView1 model:list1. |
|
3560 listView1 origin:0.0@0.0 corner:0.5@1.0; inset:2. |
|
3561 |
|
3562 listView2 := ScrollableView for:SelectionInListView in:frame. |
|
3563 listView2 model:list2. |
|
3564 listView2 origin:0.5@0.0 corner:1.0@1.0; inset:2. |
|
3565 |
|
3566 frame topInset:box yPosition. |
|
3567 box addComponent:frame withExtent:350@200. |
|
3568 box makeTabable:listView1. |
|
3569 box makeTabable:listView2. |
|
3570 frame origin:0.0@0.0 corner:1.0@0.6. |
|
3571 |
|
3572 box addVerticalSpace. |
|
3573 |
|
3574 l := box addTextLabel:(resources string:'Macro text (if any):') withCRs. |
|
3575 l adjust:#left; borderWidth:0. |
|
3576 l origin:0.0@0.6 corner:1.0@0.6. |
|
3577 l topInset:(View viewSpacing). |
|
3578 l bottomInset:(l preferredExtent y negated - View viewSpacing). |
|
3579 |
|
3580 macroTextView := HVScrollableView for:TextView miniScroller:true. |
|
3581 box addComponent:macroTextView tabable:true. |
|
3582 macroTextView origin:0.0@0.6 corner:1.0@1.0. |
|
3583 y := box yPosition. |
|
3584 |
|
3585 box |
|
3586 addHelpButtonFor:'Launcher/keyboardSetting.html'; |
|
3587 "addAbortButton;" |
|
3588 addOkButtonLabelled:(resources string:'dismiss'). |
|
3589 |
|
3590 macroTextView topInset:(l preferredExtent y + 5). |
|
3591 macroTextView bottomInset:(box preferredExtent y - y). |
|
3592 |
|
3593 box open. |
|
3594 |
|
3595 box accepted ifTrue:[ |
|
3596 "no action yet ..." |
|
3597 ]. |
|
3598 box destroy |
|
3599 |
|
3600 "Modified: / 9.9.1996 / 22:43:17 / stefan" |
|
3601 "Modified: / 4.5.1998 / 12:40:02 / cg" |
|
3602 ! |
|
3603 |
|
3604 languageSettingsFor:requestor |
|
3605 "open a dialog on language related settings" |
|
3606 |
|
3607 |listOfLanguages translatedLanguages switch box languageList flags resources| |
|
3608 |
|
3609 resources := requestor class classResources. |
|
3610 |
|
3611 " |
|
3612 get list of supported languages from the launchers resources ... |
|
3613 " |
|
3614 listOfLanguages := resources at:'LIST_OF_OFFERED_LANGUAGES' default:#('default'). |
|
3615 listOfLanguages := listOfLanguages asOrderedCollection. |
|
3616 translatedLanguages := listOfLanguages collect:[:lang | |item| |
|
3617 item := resources at:lang. |
|
3618 item isString ifTrue:[ |
|
3619 item |
|
3620 ] ifFalse:[ |
|
3621 item at:1 |
|
3622 ] |
|
3623 ]. |
|
3624 flags := listOfLanguages collect:[:lang | |item| |
|
3625 item := resources at:lang. |
|
3626 item isArray ifTrue:[ |
|
3627 item at:2 |
|
3628 ] ifFalse:[ |
|
3629 nil |
|
3630 ] |
|
3631 ]. |
|
3632 flags := flags collect:[:nm | nm notNil ifTrue:[Image fromFile:nm] ifFalse:[nil]]. |
|
3633 |
|
3634 languageList := translatedLanguages with:flags collect:[:lang :flag | |
|
3635 LabelAndIcon icon:flag string:lang. |
|
3636 ]. |
|
3637 |
|
3638 box := ListSelectionBox title:(resources at:'LANG_MSG' default:'select a language') withCRs. |
|
3639 box label:(resources string:'Language selection'). |
|
3640 box list:languageList. |
|
3641 box initialText:(Language). |
|
3642 box action:[:newLanguage | |
|
3643 requestor withWaitCursorDo:[ |
|
3644 |fontPref idx language oldLanguage enc answer matchingFonts| |
|
3645 |
|
3646 idx := translatedLanguages indexOf:newLanguage withoutSeparators. |
|
3647 idx ~~ 0 ifTrue:[ |
|
3648 language := listOfLanguages at:idx |
|
3649 ] ifFalse:[ |
|
3650 language := newLanguage |
|
3651 ]. |
|
3652 |
|
3653 "/ check if the new language needs a differently encoded font; |
|
3654 "/ ask user to switch font and allow cancellation. |
|
3655 "/ Otherwise, you are left with unreadable menu & button items ... |
|
3656 |
|
3657 oldLanguage := Smalltalk language. |
|
3658 Smalltalk language:language asSymbol. |
|
3659 ResourcePack flushCachedResourcePacks. |
|
3660 "/ refetch resources ... |
|
3661 resources := requestor class classResources. |
|
3662 fontPref := resources at:'PREFERRED_FONT_ENCODING' default:'iso8859*'. |
|
3663 Smalltalk language:oldLanguage. |
|
3664 |
|
3665 switch := true. |
|
3666 enc := MenuView defaultFont encoding. |
|
3667 (fontPref match:enc) ifFalse:[ |
|
3668 "/ look if there is one at all. |
|
3669 matchingFonts := Screen current listOfAvailableFonts select:[:f | fontPref match:f encoding]. |
|
3670 matchingFonts size == 0 ifTrue:[ |
|
3671 "/ flush and try again - just in case, the font path has changed. |
|
3672 Screen current flushListOfAvailableFonts. |
|
3673 matchingFonts := Screen current listOfAvailableFonts select:[:f | fontPref match:f encoding]. |
|
3674 ]. |
|
3675 matchingFonts size == 0 ifTrue:[ |
|
3676 (Dialog |
|
3677 confirm:(resources |
|
3678 string:'Your display does not offer any %1-encoded font.\\Change the language anyway ?\ (texts will probably be unreadable then)' |
|
3679 with:fontPref) withCRs) |
|
3680 ifFalse:[ |
|
3681 switch := false |
|
3682 ] |
|
3683 ] ifFalse:[ |
|
3684 answer := Dialog |
|
3685 confirmWithCancel:(resources |
|
3686 string:'menu font is not %1-encoded.\\Change it ?' |
|
3687 with:fontPref) withCRs |
|
3688 labels:(resources |
|
3689 array:#('cancel' 'no' 'yes')) |
|
3690 default:3. |
|
3691 answer isNil ifTrue:[ |
|
3692 switch := false |
|
3693 ] ifFalse:[ |
|
3694 answer ifTrue:[ |
|
3695 switch := (requestor fontBoxForEncoding:fontPref) |
|
3696 ] |
|
3697 ]. |
|
3698 ]. |
|
3699 ]. |
|
3700 |
|
3701 switch ifTrue:[ |
|
3702 Transcript showCR:'change language to ' , newLanguage , ' ...'. |
|
3703 Smalltalk language:language asSymbol. |
|
3704 ResourcePack flushCachedResourcePacks |
|
3705 ]. |
|
3706 ]. |
|
3707 switch ifTrue:[ |
|
3708 requestor reopenLauncher. |
|
3709 DebugView newDebugger. |
|
3710 ] |
|
3711 ]. |
|
3712 box |
|
3713 addHelpButtonFor:'Launcher/languageSetting.html'. |
|
3714 box open. |
|
3715 box destroy |
|
3716 |
|
3717 "Modified: / 9.9.1996 / 22:43:27 / stefan" |
|
3718 "Modified: / 4.8.1998 / 16:54:32 / cg" |
|
3719 ! |
|
3720 |
|
3721 memorySettingsFor:requestor |
|
3722 "open a dialog on objectMemory related settings" |
|
3723 |
|
3724 |box igcLimit igcFreeLimit igcFreeAmount newSpaceSize |
|
3725 compressLimit |
|
3726 oldIncr component fields codeLimit codeTrigger stackLimit resources| |
|
3727 |
|
3728 resources := requestor class classResources. |
|
3729 |
|
3730 "/ |
|
3731 "/ extract relevant system settings ... |
|
3732 "/ |
|
3733 igcLimit := ObjectMemory incrementalGCLimit asValue. |
|
3734 igcFreeLimit := ObjectMemory freeSpaceGCLimit asValue. |
|
3735 igcFreeAmount := ObjectMemory freeSpaceGCAmount asValue. |
|
3736 newSpaceSize := ObjectMemory newSpaceSize asValue. |
|
3737 oldIncr := ObjectMemory oldSpaceIncrement asValue. |
|
3738 compressLimit := ObjectMemory oldSpaceCompressLimit asValue. |
|
3739 codeLimit := ObjectMemory dynamicCodeLimit asValue. |
|
3740 codeTrigger := ObjectMemory dynamicCodeGCTrigger asValue. |
|
3741 stackLimit := Process defaultMaximumStackSize asValue. |
|
3742 |
|
3743 "/ |
|
3744 "/ create a box on those values ... |
|
3745 "/ |
|
3746 fields := OrderedCollection new. |
|
3747 |
|
3748 box := DialogBox new. |
|
3749 box label:(resources string:'Memory manager settings'). |
|
3750 |
|
3751 (box addTextLabel:'Warning - invalid settings may result in failures or poor performance |
|
3752 |
|
3753 You have been warned.') adjust:#left. |
|
3754 box addHorizontalLine. |
|
3755 |
|
3756 component := box |
|
3757 addLabelledInputField:(resources string:'size of newSpace:') |
|
3758 adjust:#right |
|
3759 on:nil "/ newSpaceSize |
|
3760 tabable:true |
|
3761 separateAtX:0.7. |
|
3762 component acceptOnLeave:false. |
|
3763 component converter:(PrintConverter new initForNumber). |
|
3764 component model:newSpaceSize. |
|
3765 fields add:component. |
|
3766 |
|
3767 box addHorizontalLine. |
|
3768 |
|
3769 |
|
3770 component := box |
|
3771 addLabelledInputField:(resources string:'incremental GC allocation trigger:') |
|
3772 adjust:#right |
|
3773 on:nil "/ igcLimit |
|
3774 tabable:true |
|
3775 separateAtX:0.7. |
|
3776 component acceptOnLeave:false. |
|
3777 component converter:(PrintConverter new initForNumber). |
|
3778 component model:igcLimit. |
|
3779 fields add:component. |
|
3780 |
|
3781 box addTextLabel:'(start IGC whenever this amount has been allocated)'. |
|
3782 box addHorizontalLine. |
|
3783 |
|
3784 component := box |
|
3785 addLabelledInputField:(resources string:'incremental GC freespace trigger:') |
|
3786 adjust:#right |
|
3787 on:nil "/ igcFreeLimit |
|
3788 tabable:true |
|
3789 separateAtX:0.7. |
|
3790 component acceptOnLeave:false. |
|
3791 component converter:(PrintConverter new initForNumber). |
|
3792 component model:igcFreeLimit. |
|
3793 fields add:component. |
|
3794 |
|
3795 box addTextLabel:'(start IGC whenever freespace drops below this)'. |
|
3796 box addHorizontalLine. |
|
3797 |
|
3798 component := box |
|
3799 addLabelledInputField:(resources string:'incremental GC amount:') |
|
3800 adjust:#right |
|
3801 on:nil "/ igcFreeAmount |
|
3802 tabable:true |
|
3803 separateAtX:0.7. |
|
3804 component acceptOnLeave:false. |
|
3805 component converter:(PrintConverter new initForNumber). |
|
3806 component model:igcFreeAmount. |
|
3807 fields add:component. |
|
3808 |
|
3809 box addTextLabel:'(try to keep this amount for peak requests)'. |
|
3810 box addHorizontalLine. |
|
3811 |
|
3812 component := box |
|
3813 addLabelledInputField:(resources string:'oldspace increment:') |
|
3814 adjust:#right |
|
3815 on:nil "/ oldIncr |
|
3816 tabable:true |
|
3817 separateAtX:0.7. |
|
3818 component acceptOnLeave:false. |
|
3819 component converter:(PrintConverter new initForNumber). |
|
3820 component model:oldIncr. |
|
3821 fields add:component. |
|
3822 |
|
3823 box addTextLabel:'(increase oldSpace in chunks of this size)'. |
|
3824 box addHorizontalLine. |
|
3825 |
|
3826 component := box |
|
3827 addLabelledInputField:(resources string:'oldspace compress limit:') |
|
3828 adjust:#right |
|
3829 on:nil "/ compressLimit |
|
3830 tabable:true |
|
3831 separateAtX:0.7. |
|
3832 component acceptOnLeave:false. |
|
3833 component converter:(PrintConverter new initForNumber). |
|
3834 component model:compressLimit. |
|
3835 fields add:component. |
|
3836 |
|
3837 box addTextLabel:'(suppress compressing GC if more memory is in use)'. |
|
3838 box addHorizontalLine. |
|
3839 |
|
3840 component := box |
|
3841 addLabelledInputField:(resources string:'stack limit:') |
|
3842 adjust:#right |
|
3843 on:nil |
|
3844 tabable:true |
|
3845 separateAtX:0.7. |
|
3846 component acceptOnLeave:false. |
|
3847 component converter:(PrintConverter new initForNumber). |
|
3848 component model:stackLimit. |
|
3849 fields add:component. |
|
3850 |
|
3851 box addTextLabel:'(trigger recursionInterrupt if more stack is used by a process)'. |
|
3852 box addHorizontalLine. |
|
3853 |
|
3854 ObjectMemory supportsJustInTimeCompilation ifTrue:[ |
|
3855 component := box |
|
3856 addLabelledInputField:(resources string:'dynamic code limit:') |
|
3857 adjust:#right |
|
3858 on:nil |
|
3859 tabable:true |
|
3860 separateAtX:0.7. |
|
3861 component acceptOnLeave:false. |
|
3862 component converter:(PrintConverter new initForNumberOrNil). |
|
3863 component model:codeLimit. |
|
3864 fields add:component. |
|
3865 |
|
3866 box addTextLabel:'(flush dynamic compiled code to stay within this limit)'. |
|
3867 box addHorizontalLine. |
|
3868 |
|
3869 component := box |
|
3870 addLabelledInputField:(resources string:'dynamic code GC trigger:') |
|
3871 adjust:#right |
|
3872 on:nil |
|
3873 tabable:true |
|
3874 separateAtX:0.7. |
|
3875 component acceptOnLeave:false. |
|
3876 component converter:(PrintConverter new initForNumberOrNil). |
|
3877 component model:codeTrigger. |
|
3878 fields add:component. |
|
3879 |
|
3880 box addTextLabel:'(start incremental GC whenever this amount of code has been allocated)'. |
|
3881 box addHorizontalLine. |
|
3882 ]. |
|
3883 |
|
3884 box addAbortButton; addOkButton. |
|
3885 box |
|
3886 addHelpButtonFor:'Launcher/memorySettings.html'. |
|
3887 |
|
3888 "/ |
|
3889 "/ show the box ... |
|
3890 "/ |
|
3891 box open. |
|
3892 |
|
3893 "/ |
|
3894 "/ update system settings |
|
3895 "/ |
|
3896 box accepted ifTrue:[ |
|
3897 fields do:[:comp | comp accept]. |
|
3898 |
|
3899 igcFreeAmount value ~~ ObjectMemory freeSpaceGCAmount ifTrue:[ |
|
3900 ObjectMemory freeSpaceGCAmount:igcFreeAmount value. |
|
3901 ]. |
|
3902 igcFreeLimit value ~~ ObjectMemory freeSpaceGCLimit ifTrue:[ |
|
3903 ObjectMemory freeSpaceGCLimit:igcFreeLimit value. |
|
3904 ]. |
|
3905 igcLimit value ~~ ObjectMemory incrementalGCLimit ifTrue:[ |
|
3906 ObjectMemory incrementalGCLimit:igcLimit value. |
|
3907 ]. |
|
3908 newSpaceSize value ~~ ObjectMemory newSpaceSize ifTrue:[ |
|
3909 ObjectMemory newSpaceSize:newSpaceSize value. |
|
3910 ]. |
|
3911 oldIncr value ~~ ObjectMemory oldSpaceIncrement ifTrue:[ |
|
3912 ObjectMemory oldSpaceIncrement:oldIncr value. |
|
3913 ]. |
|
3914 stackLimit value ~~ Process defaultMaximumStackSize ifTrue:[ |
|
3915 Process defaultMaximumStackSize:stackLimit value. |
|
3916 ]. |
|
3917 ObjectMemory oldSpaceCompressLimit:compressLimit value. |
|
3918 ObjectMemory dynamicCodeLimit:codeLimit value. |
|
3919 ObjectMemory dynamicCodeGCTrigger:codeTrigger value. |
|
3920 ]. |
|
3921 box destroy |
|
3922 |
|
3923 "Modified: 27.2.1997 / 16:50:12 / cg" |
|
3924 ! |
|
3925 |
|
3926 messageSettingsFor:requestor |
|
3927 "open a dialog on infoMessage related settings" |
|
3928 |
|
3929 |box vmInfo vmErrors displayErrors classInfos resources| |
|
3930 |
|
3931 resources := requestor class classResources. |
|
3932 |
|
3933 vmInfo := ObjectMemory infoPrinting asValue. |
|
3934 vmErrors := ObjectMemory debugPrinting asValue. |
|
3935 classInfos := Object infoPrinting asValue. |
|
3936 displayErrors := DeviceWorkstation errorPrinting asValue. |
|
3937 |
|
3938 box := DialogBox new. |
|
3939 box label:(resources string:'Messages'). |
|
3940 |
|
3941 box addCheckBox:(resources string:'VM info messages') on:vmInfo. |
|
3942 box addCheckBox:(resources string:'VM error messages') on:vmErrors. |
|
3943 box addHorizontalLine. |
|
3944 |
|
3945 box addCheckBox:(resources string:'Display error messages (Xlib, Xtlib ...)') on:displayErrors. |
|
3946 box addCheckBox:(resources string:'Other info messages') on:classInfos. |
|
3947 |
|
3948 box addHelpButtonFor:'Launcher/messageSettings.html'. |
|
3949 box addAbortButton; addOkButton. |
|
3950 box open. |
|
3951 |
|
3952 box accepted ifTrue:[ |
|
3953 ObjectMemory infoPrinting:vmInfo value. |
|
3954 ObjectMemory debugPrinting:vmErrors value. |
|
3955 Object infoPrinting:classInfos value. |
|
3956 DeviceWorkstation errorPrinting:displayErrors value. |
|
3957 ]. |
|
3958 box destroy |
|
3959 |
|
3960 "Modified: 27.1.1997 / 17:46:01 / cg" |
|
3961 ! |
|
3962 |
|
3963 miscSettingsFor:requestor |
|
3964 "open a dialog on misc other settings" |
|
3965 |
|
3966 |box check shadows takeFocus returnFocus hasRDoitServer rDoitsEnabled |
|
3967 rDoitLogging rDoitErrorLogging rDoitErrorDebugging hostNameInLabel showAccelerators |
|
3968 preemptive dynamicPrios hostNameInLabelHolder st80EditingMode resources y |
|
3969 activateOnClick| |
|
3970 |
|
3971 resources := requestor class classResources. |
|
3972 |
|
3973 "/ |
|
3974 "/ extract relevant system settings ... |
|
3975 "/ |
|
3976 shadows := PopUpView shadows asValue. |
|
3977 hostNameInLabel := StandardSystemView includeHostNameInLabel. |
|
3978 hostNameInLabelHolder := hostNameInLabel asValue. |
|
3979 returnFocus := StandardSystemView returnFocusWhenClosingModalBoxes asValue. |
|
3980 takeFocus := StandardSystemView takeFocusWhenMapped asValue. |
|
3981 activateOnClick := (Display class activateOnClick:nil) asValue. |
|
3982 |
|
3983 showAccelerators := MenuView showAcceleratorKeys asValue. |
|
3984 preemptive := Processor isTimeSlicing asValue. |
|
3985 dynamicPrios := Processor supportDynamicPriorities asValue. |
|
3986 |
|
3987 rDoitsEnabled := rDoitLogging := rDoitErrorLogging := false. |
|
3988 (hasRDoitServer := RDoItServer notNil) ifTrue:[ |
|
3989 RDoItServer isLoaded ifTrue:[ |
|
3990 rDoitsEnabled := RDoItServer serverRunning. |
|
3991 rDoitLogging := RDoItServer isLogging. |
|
3992 rDoitErrorLogging := RDoItServer isErrorLogging. |
|
3993 rDoitErrorDebugging := RDoItServer isErrorCatching not. |
|
3994 ] |
|
3995 ]. |
|
3996 rDoitsEnabled := rDoitsEnabled asValue. |
|
3997 rDoitLogging := rDoitLogging asValue. |
|
3998 rDoitErrorLogging := rDoitErrorLogging asValue. |
|
3999 rDoitErrorDebugging := rDoitErrorDebugging asValue. |
|
4000 |
|
4001 "/ |
|
4002 "/ create a box on those values ... |
|
4003 "/ |
|
4004 box := DialogBox new. |
|
4005 box label:(resources string:'Other settings'). |
|
4006 |
|
4007 box addCheckBox:(resources string:'shadows under popup views') on:shadows. |
|
4008 box addCheckBox:(resources string:'boxes return focus to previously active view') on:returnFocus. |
|
4009 box addCheckBox:(resources string:'views catch focus when mapped') on:takeFocus. |
|
4010 box addCheckBox:(resources string:'hostname in window labels') on:hostNameInLabelHolder. |
|
4011 box addCheckBox:(resources string:'show accelerator keys in menus') on:showAccelerators. |
|
4012 box addCheckBox:(resources string:'raise & activate windows on click') on:activateOnClick. |
|
4013 |
|
4014 box addHorizontalLine. |
|
4015 |
|
4016 box addCheckBox:(resources string:'preemptive scheduling') on:preemptive. |
|
4017 box leftIndent:20. |
|
4018 check := box addCheckBox:(resources string:'dynamic priorities') on:dynamicPrios. |
|
4019 check enableChannel:preemptive. |
|
4020 box leftIndent:0. |
|
4021 |
|
4022 box addHorizontalLine. |
|
4023 |
|
4024 check := box addCheckBox:(resources string:'remote doits enabled') on:rDoitsEnabled. |
|
4025 hasRDoitServer ifFalse:[ |
|
4026 check disable |
|
4027 ]. |
|
4028 box leftIndent:20. |
|
4029 y := box yPosition. |
|
4030 check := box addCheckBox:(resources string:'log errors') on:rDoitErrorLogging. |
|
4031 check width:0.4. |
|
4032 check enableChannel:rDoitsEnabled. |
|
4033 hasRDoitServer ifFalse:[ |
|
4034 check disable |
|
4035 ]. |
|
4036 box yPosition:y. |
|
4037 check := box addCheckBox:(resources string:'log requests') on:rDoitLogging. |
|
4038 check left:0.4; width:0.5. |
|
4039 check enableChannel:rDoitsEnabled. |
|
4040 hasRDoitServer ifFalse:[ |
|
4041 check disable |
|
4042 ]. |
|
4043 check := box addCheckBox:(resources string:'debug errors') on:rDoitErrorDebugging. |
|
4044 check width:0.4. |
|
4045 check enableChannel:rDoitsEnabled. |
|
4046 hasRDoitServer ifFalse:[ |
|
4047 check disable |
|
4048 ]. |
|
4049 box leftIndent:0. |
|
4050 |
|
4051 box |
|
4052 addHelpButtonFor:'Launcher/miscSettings.html'; |
|
4053 addAbortButton; |
|
4054 addOkButton. |
|
4055 |
|
4056 "/ |
|
4057 "/ show the box ... |
|
4058 "/ |
|
4059 box open. |
|
4060 |
|
4061 "/ |
|
4062 "/ update system settings |
|
4063 "/ |
|
4064 box accepted ifTrue:[ |
|
4065 PopUpView shadows:shadows value. |
|
4066 hostNameInLabelHolder value ~~ hostNameInLabel ifTrue:[ |
|
4067 StandardSystemView includeHostNameInLabel:hostNameInLabelHolder value. |
|
4068 |
|
4069 Screen allScreens do:[:aDisplay | |
|
4070 aDisplay allViewsDo:[:aView | |
|
4071 |l| |
|
4072 |
|
4073 aView isTopView ifTrue:[ |
|
4074 l := aView label. |
|
4075 l notNil ifTrue:[ |
|
4076 aView label:(l , ' '); label:l. "/ force a change |
|
4077 ] |
|
4078 ] |
|
4079 ] |
|
4080 ] |
|
4081 ]. |
|
4082 StandardSystemView returnFocusWhenClosingModalBoxes:returnFocus value. |
|
4083 StandardSystemView takeFocusWhenMapped:takeFocus value. |
|
4084 Display class activateOnClick:(activateOnClick value). |
|
4085 |
|
4086 MenuView showAcceleratorKeys:showAccelerators value. |
|
4087 Processor isTimeSlicing ~~ preemptive value ifTrue:[ |
|
4088 preemptive value ifTrue:[ |
|
4089 Processor startTimeSlicing |
|
4090 ] ifFalse:[ |
|
4091 Processor stopTimeSlicing |
|
4092 ] |
|
4093 ]. |
|
4094 Processor supportDynamicPriorities ~~ dynamicPrios value ifTrue:[ |
|
4095 Processor supportDynamicPriorities:dynamicPrios value |
|
4096 ]. |
|
4097 |
|
4098 hasRDoitServer ifTrue:[ |
|
4099 (RDoItServer isLoaded |
|
4100 or:[rDoitLogging value ~~ RDoItServer isLogging |
|
4101 or:[rDoitErrorDebugging value ~~ RDoItServer isErrorCatching not |
|
4102 or:[rDoitErrorLogging value ~~ RDoItServer isErrorLogging |
|
4103 or:[rDoitsEnabled value ~~ false]]]]) ifTrue:[ |
|
4104 RDoItServer logging:(rDoitLogging value). |
|
4105 RDoItServer errorLogging:(rDoitErrorLogging value). |
|
4106 RDoItServer errorCatching:(rDoitErrorDebugging value not). |
|
4107 rDoitsEnabled := rDoitsEnabled value. |
|
4108 rDoitsEnabled ~~ RDoItServer serverRunning ifTrue:[ |
|
4109 rDoitsEnabled ifFalse:[ |
|
4110 RDoItServer killAll |
|
4111 ] ifTrue:[ |
|
4112 RDoItServer start. |
|
4113 RDoItServer serverRunning ifFalse:[ |
|
4114 self warn:'RDoit startup failed (see stderr).' |
|
4115 ] |
|
4116 ] |
|
4117 ]. |
|
4118 ]. |
|
4119 ] |
|
4120 ]. |
|
4121 box destroy |
|
4122 |
|
4123 "Modified: / 9.9.1996 / 22:43:36 / stefan" |
|
4124 "Modified: / 6.1.1999 / 14:15:53 / cg" |
|
4125 ! |
|
4126 |
|
4127 printerSettingsFor:requestor |
|
4128 "open a dialog on printer related settings" |
|
4129 |
|
4130 |box |
|
4131 possiblePrinters possibleTypes printerType printCommand |
|
4132 pageFormat landscape updater |
|
4133 formatLabel formatComponent landscapeLabel landscapeComponent |
|
4134 topMargin leftMargin rightMargin bottomMargin unitList unit |
|
4135 topMarginComponent leftMarginComponent |
|
4136 rightMarginComponent |
|
4137 bottomMarginComponent supportsColor supportsColorComponent |
|
4138 y y1 commandListPop component commandList row resources| |
|
4139 |
|
4140 resources := requestor class classResources. |
|
4141 |
|
4142 possiblePrinters := PrinterStream withAllSubclasses asArray. |
|
4143 possibleTypes := possiblePrinters collect:[:cls | cls printerTypeName]. |
|
4144 |
|
4145 printerType := SelectionInList new list:(resources array:possibleTypes). |
|
4146 printerType selectionIndex:(possiblePrinters identityIndexOf:Printer). |
|
4147 printCommand := Printer printCommand asValue. |
|
4148 |
|
4149 pageFormat := SelectionInList new list:(Printer defaultPageFormats). |
|
4150 pageFormat selection:(Printer pageFormat). |
|
4151 landscape := Printer landscape asValue. |
|
4152 |
|
4153 topMargin := Printer topMargin asValue. |
|
4154 leftMargin := Printer leftMargin asValue. |
|
4155 rightMargin := Printer rightMargin asValue. |
|
4156 bottomMargin := Printer bottomMargin asValue. |
|
4157 supportsColor := Printer supportsColor asValue. |
|
4158 |
|
4159 box := DialogBox new. |
|
4160 box label:(resources string:'Printer settings'). |
|
4161 |
|
4162 "/ either use a popUpList ... |
|
4163 "/ box addPopUpList:(resources string:'printer type:') on:printerType. |
|
4164 |
|
4165 "/ or a comboList; |
|
4166 "/ which one looks better ? |
|
4167 y := box yPosition. |
|
4168 component := box addTextLabel:(resources string:'printer type:'). |
|
4169 component width:0.25; adjust:#right; borderWidth:0. |
|
4170 box yPosition:y. |
|
4171 component := box addComboListOn:printerType tabable:true. |
|
4172 component aspect:#selectionIndex; changeMessage:#selectionIndex:; useIndex:true. |
|
4173 component width:0.75; left:0.25. |
|
4174 "/ end of question |
|
4175 |
|
4176 y := box yPosition. |
|
4177 component := box addTextLabel:(resources string:'print command:'). |
|
4178 component width:0.25; adjust:#right; borderWidth:0. |
|
4179 box yPosition:y. |
|
4180 commandListPop := box addComboBoxOn:printCommand tabable:true. |
|
4181 "/ commandListPop := box addInputFieldOn:printCommand tabable:true. |
|
4182 commandListPop width:0.75; left:0.25; immediateAccept:true; acceptOnLeave:false; cursorMovementWhenUpdating:#beginOfLine. |
|
4183 "/ some common print commands ... |
|
4184 |
|
4185 commandList := resources at:'PRINT_COMMANDS' ifAbsent:nil. |
|
4186 commandList isNil ifTrue:[ |
|
4187 commandList := PrinterStream defaultCommands. |
|
4188 commandList isNil ifTrue:[ |
|
4189 commandList := #('lpr' |
|
4190 'lp' |
|
4191 ). |
|
4192 ] |
|
4193 ]. |
|
4194 |
|
4195 commandListPop list:commandList. |
|
4196 |
|
4197 box addVerticalSpace; addHorizontalLine; addVerticalSpace. |
|
4198 |
|
4199 row := OrderedCollection new. |
|
4200 row add:(formatLabel := Label label:(resources string:'page format:')). |
|
4201 formatLabel borderWidth:0. |
|
4202 row add:(formatComponent := PopUpList on:pageFormat). |
|
4203 formatComponent label:'unknown'. |
|
4204 |
|
4205 row add:(landscapeLabel := Label label:(resources string:'landscape:')). |
|
4206 landscapeLabel borderWidth:0. |
|
4207 row add:(landscapeComponent := CheckToggle on:landscape). |
|
4208 |
|
4209 y := box yPosition. |
|
4210 box |
|
4211 addRow:(1 to:2) |
|
4212 fromX:0 |
|
4213 toX:0.5 |
|
4214 collect:[:idx | row at:idx] |
|
4215 tabable:false |
|
4216 horizontalLayout:#leftSpace |
|
4217 verticalLayout:#center. |
|
4218 y1 := box yPosition. |
|
4219 box yPosition:y. |
|
4220 |
|
4221 box |
|
4222 addRow:(3 to:4) |
|
4223 fromX:0.5 |
|
4224 toX:1.0 |
|
4225 collect:[:idx | row at:idx] |
|
4226 tabable:false |
|
4227 horizontalLayout:#leftSpace |
|
4228 verticalLayout:#center. |
|
4229 |
|
4230 box yPosition:(box yPosition max:y1). |
|
4231 |
|
4232 box makeTabable:(formatComponent). |
|
4233 box makeTabable:(landscapeComponent). |
|
4234 |
|
4235 box addVerticalSpace; addHorizontalLine; addVerticalSpace. |
|
4236 |
|
4237 y := box yPosition. |
|
4238 |
|
4239 topMarginComponent := box |
|
4240 addLabelledInputField:(resources string:'top margin:') |
|
4241 adjust:#right |
|
4242 on:nil "/ topMargin |
|
4243 tabable:true |
|
4244 from:0.0 to:0.5 |
|
4245 separateAtX:0.6. |
|
4246 topMarginComponent converter:(PrintConverter new initForNumber). |
|
4247 topMarginComponent model:topMargin. |
|
4248 y1 := box yPosition. |
|
4249 |
|
4250 box yPosition:y. |
|
4251 unitList := SelectionInList with:#('inch' 'mm'). |
|
4252 unitList selectionIndex:1. |
|
4253 |
|
4254 component := box addComponent:(PopUpList on:unitList). |
|
4255 component |
|
4256 left:0.6; |
|
4257 width:0.3. |
|
4258 |
|
4259 box yPosition:y1. |
|
4260 |
|
4261 leftMarginComponent := box |
|
4262 addLabelledInputField:(resources string:'left margin:') |
|
4263 adjust:#right |
|
4264 on:nil "/ leftMargin |
|
4265 tabable:true |
|
4266 from:0.0 to:0.5 |
|
4267 separateAtX:0.6. |
|
4268 leftMarginComponent converter:(PrintConverter new initForNumber). |
|
4269 leftMarginComponent model:leftMargin. |
|
4270 |
|
4271 rightMarginComponent := box |
|
4272 addLabelledInputField:(resources string:'right margin:') |
|
4273 adjust:#right |
|
4274 on:nil "/ rightMargin |
|
4275 tabable:true |
|
4276 from:0.0 to:0.5 |
|
4277 separateAtX:0.6. |
|
4278 rightMarginComponent converter:(PrintConverter new initForNumber). |
|
4279 rightMarginComponent model:rightMargin. |
|
4280 |
|
4281 bottomMarginComponent := box |
|
4282 addLabelledInputField:(resources string:'bottom margin:') |
|
4283 adjust:#right |
|
4284 on:nil "/ bottomMargin |
|
4285 tabable:true |
|
4286 from:0.0 to:0.5 |
|
4287 separateAtX:0.6. |
|
4288 bottomMarginComponent converter:(PrintConverter new initForNumber). |
|
4289 bottomMarginComponent model:bottomMargin. |
|
4290 |
|
4291 box addHorizontalLine. |
|
4292 supportsColorComponent := box addCheckBox:(resources string:'Color printer') on:supportsColor. |
|
4293 box addVerticalSpace. |
|
4294 |
|
4295 updater := [ |p fg hasPageSize hasMargins| |
|
4296 |
|
4297 printerType selectionIndex ~~ 0 ifTrue:[ |
|
4298 p := possiblePrinters at:(printerType selectionIndex). |
|
4299 hasPageSize := p supportsPageSizes. |
|
4300 hasMargins := p supportsMargins. |
|
4301 ] ifFalse:[ |
|
4302 hasPageSize := false. |
|
4303 hasMargins := false. |
|
4304 ]. |
|
4305 hasPageSize ifTrue:[ |
|
4306 fg := Button new foregroundColor. |
|
4307 formatComponent enable. |
|
4308 landscapeComponent enable. |
|
4309 |
|
4310 formatComponent label:p pageFormat. |
|
4311 pageFormat value:(p pageFormat). |
|
4312 landscape value:(p landscape). |
|
4313 ] ifFalse:[ |
|
4314 fg := Button new disabledForegroundColor. |
|
4315 formatComponent disable. |
|
4316 landscapeComponent disable. |
|
4317 |
|
4318 formatComponent label:'unknown'. |
|
4319 landscape value:nil. |
|
4320 ]. |
|
4321 hasMargins ifTrue:[ |
|
4322 unitList selectionIndex == 2 ifTrue:[ |
|
4323 unit := #mm |
|
4324 ] ifFalse:[ |
|
4325 unit := #inch |
|
4326 ]. |
|
4327 |
|
4328 topMargin value:(UnitConverter convert:p topMargin from:#inch to:unit). |
|
4329 leftMargin value:(UnitConverter convert:p leftMargin from:#inch to:unit). |
|
4330 rightMargin value:(UnitConverter convert:p rightMargin from:#inch to:unit). |
|
4331 bottomMargin value:(UnitConverter convert:p bottomMargin from:#inch to:unit). |
|
4332 |
|
4333 topMarginComponent enable. |
|
4334 leftMarginComponent enable. |
|
4335 rightMarginComponent enable. |
|
4336 bottomMarginComponent enable. |
|
4337 ] ifFalse:[ |
|
4338 topMarginComponent disable. |
|
4339 leftMarginComponent disable. |
|
4340 rightMarginComponent disable. |
|
4341 bottomMarginComponent disable. |
|
4342 ]. |
|
4343 formatLabel foregroundColor:fg. |
|
4344 landscapeLabel foregroundColor:fg. |
|
4345 |
|
4346 p notNil ifTrue:[ |
|
4347 commandList := p defaultCommands. |
|
4348 commandList notNil ifTrue:[ |
|
4349 commandListPop list:commandList |
|
4350 ]. |
|
4351 |
|
4352 printCommand value:(p printCommand). |
|
4353 ]. |
|
4354 p supportsPostscript ifFalse:[ |
|
4355 supportsColorComponent disable. |
|
4356 supportsColor value:false |
|
4357 ] ifTrue:[ |
|
4358 supportsColorComponent enable. |
|
4359 supportsColor value:(Printer supportsColor). |
|
4360 ] |
|
4361 ]. |
|
4362 unitList onChangeSend:#value to:updater. |
|
4363 printerType onChangeSend:#value to:updater. |
|
4364 updater value. |
|
4365 |
|
4366 box addVerticalSpace; |
|
4367 addHelpButtonFor:'Launcher/printerSettings.html'; |
|
4368 addAbortButton; addOkButton. |
|
4369 box open. |
|
4370 |
|
4371 box accepted ifTrue:[ |
|
4372 Printer := possiblePrinters at:(printerType selectionIndex). |
|
4373 Printer printCommand:printCommand value. |
|
4374 |
|
4375 Printer supportsPageSizes ifTrue:[ |
|
4376 Printer pageFormat:(pageFormat selection). |
|
4377 Printer landscape:(landscape value). |
|
4378 ]. |
|
4379 Printer supportsMargins ifTrue:[ |
|
4380 unitList selectionIndex == 2 ifTrue:[ |
|
4381 unit := #mm |
|
4382 ] ifFalse:[ |
|
4383 unit := #inch |
|
4384 ]. |
|
4385 Printer topMargin:(UnitConverter convert:topMargin value from:unit to:#inch). |
|
4386 Printer leftMargin:(UnitConverter convert:leftMargin value from:unit to:#inch). |
|
4387 Printer rightMargin:(UnitConverter convert:rightMargin value from:unit to:#inch). |
|
4388 Printer bottomMargin:(UnitConverter convert:bottomMargin value from:unit to:#inch). |
|
4389 ]. |
|
4390 Printer supportsPostscript ifTrue:[ |
|
4391 Printer supportsColor:supportsColor value. |
|
4392 ]. |
|
4393 ]. |
|
4394 box destroy |
|
4395 |
|
4396 "Modified: 9.9.1996 / 22:43:51 / stefan" |
|
4397 "Modified: 28.2.1997 / 14:00:13 / cg" |
|
4398 |
|
4399 ! |
|
4400 |
|
4401 restoreSettingsFor:requestor |
|
4402 "restore settings from a settings-file." |
|
4403 |
|
4404 "a temporary kludge - we need a central systemSettings object for this, |
|
4405 which can be saved/restored with a single store/read. |
|
4406 Will move entries over to UserPreferences over time; |
|
4407 new items should always go there." |
|
4408 |
|
4409 |fileName resources| |
|
4410 |
|
4411 resources := requestor class classResources. |
|
4412 |
|
4413 fileName := Dialog |
|
4414 requestFileName:(resources string:'restore settings from:') |
|
4415 default:'settings.stx' |
|
4416 ok:(resources string:'restore') |
|
4417 abort:(resources string:'cancel') |
|
4418 pattern:'*.stx' |
|
4419 fromDirectory:nil. |
|
4420 |
|
4421 (fileName isNil or:[fileName isEmpty]) ifTrue:[ |
|
4422 "/ canceled |
|
4423 ^ self |
|
4424 ]. |
|
4425 |
|
4426 self withWaitCursorDo:[ |
|
4427 Smalltalk fileIn:fileName. |
|
4428 |
|
4429 self reopenLauncher. |
|
4430 ]. |
|
4431 |
|
4432 "Modified: / 21.7.1998 / 11:37:54 / cg" |
|
4433 ! |
|
4434 |
|
4435 saveSettingsFor:requestor |
|
4436 "save settings to a settings-file." |
|
4437 |
|
4438 "a temporary kludge - we need a central systemSettings object for this, |
|
4439 which can be saved/restored with a single store/read. |
|
4440 Will move entries over to UserPreferences over time; |
|
4441 new items should always go there." |
|
4442 |
|
4443 |s screen fileName resources| |
|
4444 |
|
4445 resources := requestor class classResources. |
|
4446 |
|
4447 fileName := Dialog |
|
4448 requestFileName:(resources string:'save settings in:') |
|
4449 default:'settings.stx' |
|
4450 ok:(resources string:'save') |
|
4451 abort:(resources string:'cancel') |
|
4452 pattern:'*.stx' |
|
4453 fromDirectory:nil. |
|
4454 |
|
4455 (fileName isNil or:[fileName isEmpty]) ifTrue:[ |
|
4456 "/ canceled |
|
4457 ^ self |
|
4458 ]. |
|
4459 |
|
4460 s := fileName asFilename writeStream. |
|
4461 s isNil ifTrue:[ |
|
4462 self warn:'cannot write the ''' , fileName , ''' file'. |
|
4463 ^ self |
|
4464 ]. |
|
4465 |
|
4466 s nextPutLine:'"/ ST/X saved settings'; |
|
4467 nextPutLine:'"/ DO NOT MODIFY MANUALLY'; |
|
4468 nextPutLine:'"/ (modifications would be lost with next save-settings)'; |
|
4469 nextPutLine:'"/'; |
|
4470 nextPutLine:'"/ this file was automatically generated by the'; |
|
4471 nextPutLine:'"/ ''save settings'' function of the Launcher'; |
|
4472 nextPutLine:'"/'. |
|
4473 s cr. |
|
4474 |
|
4475 s nextPutLine:'"/'. |
|
4476 s nextPutLine:'"/ saved by ' , OperatingSystem getLoginName , '@' , OperatingSystem getHostName , ' at ' , AbsoluteTime now printString. |
|
4477 s nextPutLine:'"/'. |
|
4478 s cr. |
|
4479 |
|
4480 s nextPutLine:'"/'. |
|
4481 s nextPutLine:'"/ Display settings:'. |
|
4482 s nextPutLine:'"/'. |
|
4483 s nextPutLine:'"/ only restore the display settings, if on the same Display ...'. |
|
4484 s nextPutLine:'Display displayName = ' , (Display displayName storeString) , ' ifTrue:['. |
|
4485 screen := Screen current. |
|
4486 screen fixColors notNil ifTrue:[ |
|
4487 s nextPutLine:' Image flushDeviceImages.'. |
|
4488 s nextPutLine:' Color colorAllocationFailSignal catch:['. |
|
4489 s nextPutLine:' Color getColorsRed:6 green:6 blue:4 on:Display'. |
|
4490 s nextPutLine:' ].'. |
|
4491 ] ifFalse:[ |
|
4492 s nextPutLine:' Display releaseFixColors.'. |
|
4493 ]. |
|
4494 s nextPutLine:' Display hasColors: ' , (screen hasColors storeString) , '.'. |
|
4495 s nextPutLine:' Display widthInMillimeter: ' , (screen widthInMillimeter storeString) , '.'. |
|
4496 s nextPutLine:' Display heightInMillimeter: ' , (screen heightInMillimeter storeString) , '.'. |
|
4497 s nextPutLine:' Display supportsDeepIcons: ' , (screen supportsDeepIcons storeString) , '.'. |
|
4498 s nextPutLine:' Image ditherAlgorithm: ' , (Image ditherAlgorithm storeString) , '.'. |
|
4499 s nextPutLine:' View defaultStyle:' , View defaultStyle storeString , '.'. |
|
4500 s nextPutLine:'].'. |
|
4501 s cr. |
|
4502 |
|
4503 s nextPutLine:'"/'. |
|
4504 s nextPutLine:'"/ Compiler settings:'. |
|
4505 s nextPutLine:'"/'. |
|
4506 s nextPutLine:'Compiler warnSTXSpecials: ' , (Compiler warnSTXSpecials storeString) , '.'; |
|
4507 nextPutLine:'Compiler warnUnderscoreInIdentifier: ' , (Compiler warnUnderscoreInIdentifier storeString) , '.'; |
|
4508 nextPutLine:'Compiler warnOldStyleAssignment: ' , (Compiler warnOldStyleAssignment storeString) , '.'; |
|
4509 nextPutLine:'Compiler warnCommonMistakes: ' , (Compiler warnCommonMistakes storeString) , '.'; |
|
4510 nextPutLine:'Compiler warnPossibleIncompatibilities: ' , (Compiler warnPossibleIncompatibilities storeString) , '.'; |
|
4511 nextPutLine:'Compiler allowUnderscoreInIdentifier: ' , (Compiler allowUnderscoreInIdentifier storeString) , '.'; |
|
4512 nextPutLine:'Compiler arraysAreImmutable: ' , (Compiler arraysAreImmutable storeString) , '.'; |
|
4513 nextPutLine:'Compiler lineNumberInfo: ' , (Compiler lineNumberInfo storeString) , '.'; |
|
4514 |
|
4515 nextPutLine:'Compiler foldConstants: ' , (Compiler foldConstants storeString) , '.'; |
|
4516 |
|
4517 nextPutLine:'Compiler stcCompilationIncludes: ' , (Compiler stcCompilationIncludes storeString) , '.'; |
|
4518 nextPutLine:'Compiler stcCompilationDefines: ' , (Compiler stcCompilationDefines storeString) , '.'; |
|
4519 nextPutLine:'Compiler stcCompilationOptions: ' , (Compiler stcCompilationOptions storeString) , '.'; |
|
4520 nextPutLine:'Compiler ccCompilationOptions: ' , (Compiler ccCompilationOptions storeString) , '.'; |
|
4521 nextPutLine:'Compiler ccPath: ' , (Compiler ccPath storeString) , '.'; |
|
4522 nextPutLine:'ObjectFileLoader linkArgs: ' , (ObjectFileLoader linkArgs storeString) , '.'; |
|
4523 nextPutLine:'ObjectFileLoader linkCommand: ' , (ObjectFileLoader linkCommand storeString) , '.'; |
|
4524 |
|
4525 nextPutLine:'ObjectMemory justInTimeCompilation: ' , (ObjectMemory justInTimeCompilation storeString) , '.'; |
|
4526 nextPutLine:'ObjectMemory fullSingleStepSupport: ' , (ObjectMemory fullSingleStepSupport storeString) , '.'. |
|
4527 |
|
4528 HistoryManager notNil ifTrue:[ |
|
4529 HistoryManager isActive ifTrue:[ |
|
4530 s nextPutLine:'HistoryManager notNil ifTrue:[HistoryManager activate].'. |
|
4531 s nextPutLine:'HistoryManager notNil ifTrue:[HistoryManager fullHistoryUpdate:' , HistoryManager fullHistoryUpdate storeString , '].'. |
|
4532 ] ifFalse:[ |
|
4533 s nextPutLine:'HistoryManager notNil ifTrue:[HistoryManager deactivate].'. |
|
4534 ]. |
|
4535 ]. |
|
4536 |
|
4537 ObjectFileLoader notNil ifTrue:[ |
|
4538 s nextPutLine:'ObjectFileLoader searchedLibraries: ' , (ObjectFileLoader searchedLibraries storeString) , '.'. |
|
4539 s nextPutLine:'ObjectFileLoader libPath: ' , (ObjectFileLoader libPath storeString) , '.'. |
|
4540 ]. |
|
4541 |
|
4542 s nextPutLine:'Class catchMethodRedefinitions: ' , (Class catchMethodRedefinitions storeString) , '.'. |
|
4543 s nextPutLine:'ClassCategoryReader sourceMode: ' , (ClassCategoryReader sourceMode storeString) , '.'. |
|
4544 |
|
4545 s cr. |
|
4546 s nextPutLine:'"/'. |
|
4547 s nextPutLine:'"/ Info & Debug Messages:'. |
|
4548 s nextPutLine:'"/'. |
|
4549 s nextPutLine:'ObjectMemory infoPrinting: ' , (ObjectMemory infoPrinting storeString) , '.'; |
|
4550 nextPutLine:'ObjectMemory debugPrinting: ' , (ObjectMemory debugPrinting storeString) , '.'; |
|
4551 nextPutLine:'Object infoPrinting: ' , (Object infoPrinting storeString) , '.'; |
|
4552 nextPutLine:'DeviceWorkstation errorPrinting: ' , (DeviceWorkstation errorPrinting storeString) , '.'. |
|
4553 |
|
4554 |
|
4555 s cr. |
|
4556 s nextPutLine:'"/'. |
|
4557 s nextPutLine:'"/ Edit settings:'. |
|
4558 s nextPutLine:'"/'. |
|
4559 s nextPutLine:'EditTextView st80Mode: ' , (EditTextView st80Mode storeString) , '.'. |
|
4560 s nextPutLine:'TextView st80SelectMode: ' , (TextView st80SelectMode storeString) , '.'. |
|
4561 s nextPutLine:'UserPreferences current syntaxColoring: ' , (UserPreferences current syntaxColoring storeString) , '.'. |
|
4562 |
|
4563 s cr. |
|
4564 s nextPutLine:'"/'. |
|
4565 s nextPutLine:'"/ Tool settings:'. |
|
4566 s nextPutLine:'"/'. |
|
4567 s nextPutLine:'UserPreferences current useNewInspector: ' , (UserPreferences current useNewInspector storeString) , '.'. |
|
4568 s nextPutLine:'UserPreferences current useNewChangesBrowser: ' , (UserPreferences current useNewChangesBrowser storeString) , '.'. |
|
4569 |
|
4570 s cr. |
|
4571 s nextPutLine:'"/'. |
|
4572 s nextPutLine:'"/ Misc settings:'. |
|
4573 s nextPutLine:'"/'. |
|
4574 s nextPutLine:'Class keepMethodHistory: ' , (Class methodHistory notNil storeString) , '.'; |
|
4575 nextPutLine:'Smalltalk logDoits: ' , (Smalltalk logDoits storeString) , '.'; |
|
4576 nextPutLine:'Autoload compileLazy: ' , (Autoload compileLazy storeString) , '.'; |
|
4577 nextPutLine:'Smalltalk loadBinaries: ' , (Smalltalk loadBinaries storeString) , '.'; |
|
4578 nextPutLine:'StandardSystemView includeHostNameInLabel: ' , (StandardSystemView includeHostNameInLabel storeString) , '.'; |
|
4579 |
|
4580 "/ claus - I dont think its a good idea to save those ... |
|
4581 nextPutLine:'"/ Class updateChanges: ' , (Class updatingChanges storeString) , '.'; |
|
4582 nextPutLine:'"/ ObjectMemory nameForChanges: ' , (ObjectMemory nameForChanges storeString) , '.'; |
|
4583 |
|
4584 nextPutLine:'StandardSystemView returnFocusWhenClosingModalBoxes: ' , (StandardSystemView returnFocusWhenClosingModalBoxes storeString) , '.'; |
|
4585 nextPutLine:'StandardSystemView takeFocusWhenMapped: ' , (StandardSystemView takeFocusWhenMapped storeString) , '.'; |
|
4586 nextPutLine:'Display class activateOnClick: ' , ((Display class activateOnClick:nil) storeString) , '.'; |
|
4587 nextPutLine:'MenuView showAcceleratorKeys: ' , (MenuView showAcceleratorKeys storeString) , '.'; |
|
4588 nextPutLine:'Class tryLocalSourceFirst: ' , (Class tryLocalSourceFirst storeString) , '.'. |
|
4589 (Exception emergencyHandler == Launcher notifyingEmergencyHandler) ifTrue:[ |
|
4590 s nextPutLine:'Exception emergencyHandler:(Launcher notifyingEmergencyHandler).'. |
|
4591 ]. |
|
4592 Processor isTimeSlicing ifTrue:[ |
|
4593 s nextPutLine:'Processor startTimeSlicing.'. |
|
4594 s nextPutLine:('Processor supportDynamicPriorities:' , (Processor supportDynamicPriorities ? false) storeString , '.'). |
|
4595 ] ifFalse:[ |
|
4596 s nextPutLine:'Processor stopTimeSlicing.'. |
|
4597 ]. |
|
4598 |
|
4599 s cr. |
|
4600 s nextPutLine:'"/'. |
|
4601 s nextPutLine:'"/ Printer settings:'. |
|
4602 s nextPutLine:'"/'. |
|
4603 s nextPutLine:'Printer := ' , (Printer name) , '.'; |
|
4604 nextPutLine:'Printer printCommand: ' , (Printer printCommand storeString) , '.'. |
|
4605 |
|
4606 Printer supportsPageSizes ifTrue:[ |
|
4607 s nextPutLine:'Printer pageFormat: ' , (Printer pageFormat storeString) , '.'. |
|
4608 s nextPutLine:'Printer landscape: ' , (Printer landscape storeString) , '.'. |
|
4609 ]. |
|
4610 Printer supportsMargins ifTrue:[ |
|
4611 s nextPutLine:'Printer topMargin: ' , (Printer topMargin storeString) , '.'. |
|
4612 s nextPutLine:'Printer leftMargin: ' , (Printer leftMargin storeString) , '.'. |
|
4613 s nextPutLine:'Printer rightMargin: ' , (Printer rightMargin storeString) , '.'. |
|
4614 s nextPutLine:'Printer bottomMargin: ' , (Printer bottomMargin storeString) , '.'. |
|
4615 ]. |
|
4616 Printer supportsPostscript ifTrue:[ |
|
4617 s nextPutLine:'Printer supportsColor: ' , (Printer supportsColor storeString) , '.'. |
|
4618 ]. |
|
4619 |
|
4620 s cr. |
|
4621 s nextPutLine:'"/'. |
|
4622 s nextPutLine:'"/ Font settings:'. |
|
4623 s nextPutLine:'"/'. |
|
4624 s nextPutLine:'View defaultFont: ' , (View defaultFont storeString) , '.'. |
|
4625 s nextPutLine:'Label defaultFont: ' , (Label defaultFont storeString) , '.'. |
|
4626 s nextPutLine:'Button defaultFont: ' , (Button defaultFont storeString) , '.'. |
|
4627 s nextPutLine:'Toggle defaultFont: ' , (Toggle defaultFont storeString) , '.'. |
|
4628 s nextPutLine:'SelectionInListView defaultFont: ' , (SelectionInListView defaultFont storeString) , '.'. |
|
4629 s nextPutLine:'MenuView defaultFont: ' , (MenuView defaultFont storeString) , '.'. |
|
4630 s nextPutLine:'PullDownMenu defaultFont: ' , (PullDownMenu defaultFont storeString) , '.'. |
|
4631 s nextPutLine:'TextView defaultFont: ' , (TextView defaultFont storeString) , '.'. |
|
4632 s nextPutLine:'EditTextView defaultFont: ' , (EditTextView defaultFont storeString) , '.'. |
|
4633 s nextPutLine:'CodeView defaultFont: ' , (CodeView defaultFont storeString) , '.'. |
|
4634 |
|
4635 s cr. |
|
4636 s nextPutLine:'"/'. |
|
4637 s nextPutLine:'"/ Language setting:'. |
|
4638 s nextPutLine:'"/'. |
|
4639 s nextPutLine:'Smalltalk language: ' , (Smalltalk language storeString) , '.'. |
|
4640 s nextPutLine:'Smalltalk languageTerritory: ' , (Smalltalk languageTerritory storeString) , '.'. |
|
4641 s close. |
|
4642 |
|
4643 " |
|
4644 Transcript topView application saveSettings |
|
4645 " |
|
4646 |
|
4647 "Modified: / 6.1.1999 / 14:24:16 / cg" |
|
4648 ! |
|
4649 |
|
4650 sourceAndDebuggerSettingsFor:requestor |
|
4651 "open a dialog on source&debugger other settings" |
|
4652 |
|
4653 |box check butt setupButt logDoits updChanges changeFileName |
|
4654 useManager hasManager cvsIsSetup |
|
4655 repository repositoryHolder localSourceFirst |
|
4656 sourceCacheDir cacheEntry |
|
4657 component localCheck oldIndent nm fn manager |
|
4658 showErrorNotifier showVerboseStack |
|
4659 syntaxColoring resources useNewInspector pos currentUserPrefs| |
|
4660 |
|
4661 currentUserPrefs := UserPreferences current. |
|
4662 |
|
4663 resources := requestor class classResources. |
|
4664 |
|
4665 "/ |
|
4666 "/ extract relevant system settings ... |
|
4667 "/ |
|
4668 logDoits := Smalltalk logDoits asValue. |
|
4669 updChanges := Class updatingChanges asValue. |
|
4670 changeFileName := ObjectMemory nameForChanges asValue. |
|
4671 |
|
4672 (AbstractSourceCodeManager notNil |
|
4673 and:[AbstractSourceCodeManager isLoaded not]) ifTrue:[ |
|
4674 AbstractSourceCodeManager autoload. |
|
4675 ]. |
|
4676 |
|
4677 hasManager := AbstractSourceCodeManager notNil |
|
4678 and:[AbstractSourceCodeManager isLoaded]. |
|
4679 |
|
4680 repositoryHolder := '' asValue. |
|
4681 hasManager ifTrue:[ |
|
4682 useManager := (manager := Smalltalk at:#SourceCodeManager) notNil asValue. |
|
4683 localSourceFirst := Class tryLocalSourceFirst asValue. |
|
4684 manager notNil ifTrue:[ |
|
4685 repository := manager repositoryName. |
|
4686 repository notNil ifTrue:[ |
|
4687 repositoryHolder := repository asValue. |
|
4688 ] ifFalse:[ |
|
4689 repositoryHolder := '' asValue. |
|
4690 ]. |
|
4691 cvsIsSetup := true. |
|
4692 ] ifFalse:[ |
|
4693 cvsIsSetup := false asValue. |
|
4694 ] |
|
4695 ] ifFalse:[ |
|
4696 useManager := false. |
|
4697 localSourceFirst := false. |
|
4698 cvsIsSetup := false. |
|
4699 ]. |
|
4700 showErrorNotifier := (Exception emergencyHandler == Launcher notifyingEmergencyHandler) asValue. |
|
4701 showVerboseStack := (DebugView defaultVerboseBacktrace ? false) asValue. |
|
4702 syntaxColoring := currentUserPrefs syntaxColoring asValue. |
|
4703 |
|
4704 sourceCacheDir := nil asValue. |
|
4705 |
|
4706 "/ |
|
4707 "/ create a box on those values ... |
|
4708 "/ |
|
4709 box := DialogBox new. |
|
4710 box label:(resources string:'Source & Debugger settings'). |
|
4711 |
|
4712 box addCheckBox:(resources string:'log compiles in changes file') on:updChanges. |
|
4713 box addCheckBox:(resources string:'log doIts in changes file') on:logDoits. |
|
4714 |
|
4715 component := box |
|
4716 addLabelledInputField:(resources string:'change file name:') |
|
4717 adjust:#right |
|
4718 on:changeFileName |
|
4719 tabable:true |
|
4720 separateAtX:0.4. |
|
4721 component immediateAccept:true; acceptOnLeave:false. |
|
4722 |
|
4723 "/ y := box yPosition. |
|
4724 "/ component := box addTextLabel:(resources string:'change file name:'). |
|
4725 "/ component width:0.5; adjust:#right; borderWidth:0. |
|
4726 "/ box yPosition:y. |
|
4727 "/ component := box addInputFieldOn:changeFileName tabable:true. |
|
4728 "/ component width:0.5; left:0.5; immediateAccept:true; acceptOnLeave:false. |
|
4729 |
|
4730 box addHorizontalLine. |
|
4731 |
|
4732 hasManager ifTrue:[ |
|
4733 pos := box yPosition. |
|
4734 check := box addCheckBox:(resources string:'sourcecode management') on:useManager. |
|
4735 check enableChannel:cvsIsSetup. |
|
4736 box makeTabable:check. |
|
4737 |
|
4738 cvsIsSetup value ifFalse:[ |
|
4739 AbstractSourceCodeManager notNil ifTrue:[ |
|
4740 check width:0.6. |
|
4741 box yPosition:pos. |
|
4742 setupButt := box addComponent:(Button label:(resources string:'setup...') |
|
4743 action:[|manager| |
|
4744 |
|
4745 self cvsConfigurationDialogFor:requestor. |
|
4746 manager := (Smalltalk at:#SourceCodeManager). |
|
4747 cvsIsSetup value:manager notNil. |
|
4748 manager notNil ifTrue:[ |
|
4749 repositoryHolder value: manager repositoryName. |
|
4750 sourceCacheDir value:(AbstractSourceCodeManager cacheDirectoryName). |
|
4751 setupButt beInvisible. |
|
4752 ]. |
|
4753 ]). |
|
4754 box makeTabable:setupButt. |
|
4755 setupButt left:0.6; width:0.4. |
|
4756 ]. |
|
4757 ]. |
|
4758 oldIndent := box leftIndent. |
|
4759 box leftIndent:30. |
|
4760 |
|
4761 component := box |
|
4762 addLabelledInputField:(resources string:'repository:') |
|
4763 adjust:#right |
|
4764 on:repositoryHolder |
|
4765 tabable:true |
|
4766 separateAtX:0.4. |
|
4767 component immediateAccept:true; acceptOnLeave:false. |
|
4768 component enableChannel:useManager. |
|
4769 |
|
4770 cacheEntry := box |
|
4771 addLabelledInputField:(resources string:'source cache dir:') |
|
4772 adjust:#right |
|
4773 on:sourceCacheDir |
|
4774 tabable:true |
|
4775 separateAtX:0.4. |
|
4776 cacheEntry immediateAccept:true; acceptOnLeave:false. |
|
4777 cacheEntry enableChannel:useManager. |
|
4778 |
|
4779 localCheck := box addCheckBox:(resources string:'if present, use local source (suppress checkout)') on:localSourceFirst. |
|
4780 localCheck enableChannel:useManager. |
|
4781 |
|
4782 box leftIndent:oldIndent. |
|
4783 |
|
4784 (AbstractSourceCodeManager isNil |
|
4785 or:[AbstractSourceCodeManager defaultManager isNil]) ifTrue:[ |
|
4786 useManager value:false. |
|
4787 "/ cacheEntry disable. |
|
4788 "/ localCheck enable. |
|
4789 ] ifFalse:[ |
|
4790 sourceCacheDir value:(AbstractSourceCodeManager cacheDirectoryName). |
|
4791 ]. |
|
4792 box addHorizontalLine. |
|
4793 ]. |
|
4794 |
|
4795 pos := box yPosition. |
|
4796 check := box addCheckBox:(resources string:'syntax coloring') on:syntaxColoring. |
|
4797 check width:0.6. |
|
4798 box yPosition:pos. |
|
4799 butt := box addComponent:(Button label:(resources string:'configure...') action:[self syntaxColorConfigurationDialogFor:requestor]). |
|
4800 box makeTabable:butt. |
|
4801 butt enableChannel:syntaxColoring. |
|
4802 butt left:0.6; width:0.4. |
|
4803 |
|
4804 box addHorizontalLine. |
|
4805 |
|
4806 |
|
4807 box addCheckBox:(resources string:'show error notifier before opening debugger') on:showErrorNotifier. |
|
4808 box addCheckBox:(resources string:'verbose backtrace by default in debugger') on:showVerboseStack. |
|
4809 |
|
4810 box |
|
4811 addHelpButtonFor:'Launcher/sourceSettings.html'; |
|
4812 addAbortButton; |
|
4813 addOkButton. |
|
4814 |
|
4815 "/ |
|
4816 "/ show the box ... |
|
4817 "/ |
|
4818 box open. |
|
4819 |
|
4820 "/ |
|
4821 "/ update system settings |
|
4822 "/ |
|
4823 box accepted ifTrue:[ |
|
4824 Smalltalk logDoits:logDoits value. |
|
4825 Class updateChanges:updChanges value. |
|
4826 ObjectMemory nameForChanges:changeFileName value. |
|
4827 |
|
4828 (hasManager and:[useManager value]) ifTrue:[ |
|
4829 manager isNil ifTrue:[ |
|
4830 Smalltalk at:#SourceCodeManager put:(AbstractSourceCodeManager defaultManager). |
|
4831 manager := Smalltalk at:#SourceCodeManager. |
|
4832 ]. |
|
4833 Class tryLocalSourceFirst:(localSourceFirst value). |
|
4834 |
|
4835 manager notNil ifTrue:[ |
|
4836 localSourceFirst value ifFalse:[ |
|
4837 nm := sourceCacheDir value. |
|
4838 nm size > 0 ifTrue:[ |
|
4839 (fn := nm asFilename) exists ifFalse:[ |
|
4840 (self confirm:('cache directory ''' , nm , ''' does not exists\create ?' withCRs)) ifTrue:[ |
|
4841 fn makeDirectory; |
|
4842 makeReadableForAll; |
|
4843 makeWritableForAll; |
|
4844 makeExecutableForAll. |
|
4845 ] |
|
4846 ]. |
|
4847 (fn exists |
|
4848 and:[fn isDirectory |
|
4849 and:[fn isReadable |
|
4850 and:[fn isWritable]]]) ifTrue:[ |
|
4851 AbstractSourceCodeManager cacheDirectoryName:(sourceCacheDir value). |
|
4852 ] |
|
4853 ] |
|
4854 ] |
|
4855 ]. |
|
4856 |
|
4857 repositoryHolder notNil ifTrue:[ |
|
4858 repositoryHolder value size > 0 ifTrue:[ |
|
4859 manager notNil ifTrue:[ |
|
4860 manager initializeForRepository:repositoryHolder value. |
|
4861 ] |
|
4862 ]. |
|
4863 ]. |
|
4864 ] ifFalse:[ |
|
4865 Smalltalk at:#SourceCodeManager put:nil |
|
4866 ]. |
|
4867 |
|
4868 showErrorNotifier value ifFalse:[ |
|
4869 Exception emergencyHandler:nil |
|
4870 ] ifTrue:[ |
|
4871 Exception emergencyHandler:(Launcher notifyingEmergencyHandler) |
|
4872 ]. |
|
4873 DebugView defaultVerboseBacktrace:(showVerboseStack value). |
|
4874 currentUserPrefs syntaxColoring:syntaxColoring value. |
|
4875 ]. |
|
4876 box destroy |
|
4877 |
|
4878 "Modified: / 9.9.1996 / 22:43:36 / stefan" |
|
4879 "Created: / 17.1.1997 / 17:39:33 / cg" |
|
4880 "Modified: / 16.4.1998 / 17:18:47 / ca" |
|
4881 "Modified: / 13.10.1998 / 15:47:31 / cg" |
|
4882 ! |
|
4883 |
|
4884 stcCompilerSettingsFor:requestor |
|
4885 "open an extra dialog on stc-compiler related settings" |
|
4886 |
|
4887 |box |
|
4888 stcCompilationOptions stcIncludes stcDefines stcOptions |
|
4889 stcLibraries stcLibraryPath cc stc ccOptions |
|
4890 linkCommand linkArgs |
|
4891 component t y y2 yMax |
|
4892 canLoadBinaries strings idx thisIsADemoVersion |
|
4893 resources| |
|
4894 |
|
4895 resources := requestor class classResources. |
|
4896 |
|
4897 canLoadBinaries := ObjectFileLoader notNil and:[ObjectFileLoader canLoadObjectFiles]. |
|
4898 |
|
4899 stcIncludes := Compiler stcCompilationIncludes asValue. |
|
4900 stcDefines := Compiler stcCompilationDefines asValue. |
|
4901 stcOptions := Compiler stcCompilationOptions asValue. |
|
4902 ccOptions := Compiler ccCompilationOptions asValue. |
|
4903 |
|
4904 cc := Compiler ccPath asValue. |
|
4905 stc := Compiler stcPath asValue. |
|
4906 linkCommand := ObjectFileLoader linkCommand asValue. |
|
4907 linkArgs := ObjectFileLoader linkArgs asValue. |
|
4908 |
|
4909 ObjectFileLoader notNil ifTrue:[ |
|
4910 (t := ObjectFileLoader searchedLibraries) notNil ifTrue:[ |
|
4911 stcLibraries := (String fromStringCollection:t separatedBy:' ') asValue. |
|
4912 ]. |
|
4913 (t := ObjectFileLoader libPath) notNil ifTrue:[ |
|
4914 stcLibraryPath := t asValue. |
|
4915 ] |
|
4916 ]. |
|
4917 |
|
4918 box := DialogBox new. |
|
4919 box label:(resources string:'STC Compilation settings'). |
|
4920 |
|
4921 thisIsADemoVersion := (Smalltalk releaseIdentification = 'ST/X_free_demo_vsn'). |
|
4922 ObjectFileLoader notNil ifTrue:[ |
|
4923 thisIsADemoVersion ifFalse:[ |
|
4924 |
|
4925 component := box |
|
4926 addLabelledInputField:(resources string:'stc command:') |
|
4927 adjust:#right |
|
4928 on:stc |
|
4929 tabable:true |
|
4930 separateAtX:0.3. |
|
4931 component immediateAccept:true; acceptOnLeave:false; cursorMovementWhenUpdating:#beginOfLine. |
|
4932 component preferredExtent:(100 @ component preferredExtent y). |
|
4933 canLoadBinaries ifFalse:[component disable]. |
|
4934 |
|
4935 component := box |
|
4936 addLabelledInputField:(resources string:'stc options:') |
|
4937 adjust:#right |
|
4938 on:stcOptions |
|
4939 tabable:true |
|
4940 separateAtX:0.3. |
|
4941 component immediateAccept:true; acceptOnLeave:false; cursorMovementWhenUpdating:#beginOfLine. |
|
4942 component preferredExtent:(250 @ component preferredExtent y). |
|
4943 canLoadBinaries ifFalse:[component disable]. |
|
4944 |
|
4945 component := box |
|
4946 addLabelledInputField:(resources string:'cc command:') |
|
4947 adjust:#right |
|
4948 on:cc |
|
4949 tabable:true |
|
4950 separateAtX:0.3. |
|
4951 component immediateAccept:true; acceptOnLeave:false; cursorMovementWhenUpdating:#beginOfLine. |
|
4952 component preferredExtent:(150 @ component preferredExtent y). |
|
4953 canLoadBinaries ifFalse:[component disable]. |
|
4954 |
|
4955 component := box |
|
4956 addLabelledInputField:(resources string:'cc options:') |
|
4957 adjust:#right |
|
4958 on:ccOptions |
|
4959 tabable:true |
|
4960 separateAtX:0.3. |
|
4961 component immediateAccept:true; acceptOnLeave:false; cursorMovementWhenUpdating:#beginOfLine. |
|
4962 component preferredExtent:(250 @ component preferredExtent y). |
|
4963 canLoadBinaries ifFalse:[component disable]. |
|
4964 |
|
4965 component := box |
|
4966 addLabelledInputField:(resources string:'include directories:') |
|
4967 adjust:#right |
|
4968 on:stcIncludes |
|
4969 tabable:true |
|
4970 separateAtX:0.3. |
|
4971 component immediateAccept:true; acceptOnLeave:false; cursorMovementWhenUpdating:#beginOfLine. |
|
4972 component preferredExtent:(250 @ component preferredExtent y). |
|
4973 canLoadBinaries ifFalse:[component disable]. |
|
4974 |
|
4975 "/ box addVerticalSpace. |
|
4976 |
|
4977 component := box |
|
4978 addLabelledInputField:(resources string:'defines:') |
|
4979 adjust:#right |
|
4980 on:stcDefines |
|
4981 tabable:true |
|
4982 separateAtX:0.3. |
|
4983 component immediateAccept:true; acceptOnLeave:false; cursorMovementWhenUpdating:#beginOfLine. |
|
4984 component preferredExtent:(250 @ component preferredExtent y). |
|
4985 canLoadBinaries ifFalse:[component disable]. |
|
4986 |
|
4987 "/ box addVerticalSpace. |
|
4988 |
|
4989 "/ box addVerticalSpace. |
|
4990 |
|
4991 component := box |
|
4992 addLabelledInputField:(resources string:'link command:') |
|
4993 adjust:#right |
|
4994 on:linkCommand |
|
4995 tabable:true |
|
4996 separateAtX:0.3. |
|
4997 component immediateAccept:true; acceptOnLeave:false; cursorMovementWhenUpdating:#beginOfLine. |
|
4998 component preferredExtent:(250 @ component preferredExtent y). |
|
4999 canLoadBinaries ifFalse:[component disable]. |
|
5000 |
|
5001 component := box |
|
5002 addLabelledInputField:(resources string:'link args:') |
|
5003 adjust:#right |
|
5004 on:linkArgs |
|
5005 tabable:true |
|
5006 separateAtX:0.3. |
|
5007 component immediateAccept:true; acceptOnLeave:false; cursorMovementWhenUpdating:#beginOfLine. |
|
5008 component preferredExtent:(250 @ component preferredExtent y). |
|
5009 canLoadBinaries ifFalse:[component disable]. |
|
5010 |
|
5011 stcLibraries notNil ifTrue:[ |
|
5012 "/ box addVerticalSpace. |
|
5013 |
|
5014 component := box |
|
5015 addLabelledInputField:(resources string:'C-libraries:') |
|
5016 adjust:#right |
|
5017 on:stcLibraries |
|
5018 tabable:true |
|
5019 separateAtX:0.3. |
|
5020 component immediateAccept:true; acceptOnLeave:false; cursorMovementWhenUpdating:#beginOfLine. |
|
5021 component preferredExtent:(250 @ component preferredExtent y). |
|
5022 canLoadBinaries ifFalse:[component disable]. |
|
5023 ]. |
|
5024 |
|
5025 stcLibraryPath notNil ifTrue:[ |
|
5026 "/ box addVerticalSpace. |
|
5027 |
|
5028 component := box |
|
5029 addLabelledInputField:(resources string:'stc libPath:') |
|
5030 adjust:#right |
|
5031 on:stcLibraryPath |
|
5032 tabable:true |
|
5033 separateAtX:0.3. |
|
5034 component immediateAccept:true; acceptOnLeave:false; cursorMovementWhenUpdating:#beginOfLine. |
|
5035 component preferredExtent:(250 @ component preferredExtent y). |
|
5036 canLoadBinaries ifFalse:[component disable]. |
|
5037 ]. |
|
5038 ]. |
|
5039 ]. |
|
5040 |
|
5041 box |
|
5042 addHelpButtonFor:'Launcher/compilerSettings.html'; |
|
5043 addAbortButton; |
|
5044 addOkButton. |
|
5045 |
|
5046 box open. |
|
5047 |
|
5048 box accepted ifTrue:[ |
|
5049 thisIsADemoVersion ifFalse:[ |
|
5050 Compiler stcCompilationIncludes:stcIncludes value. |
|
5051 Compiler stcCompilationDefines:stcDefines value. |
|
5052 Compiler stcCompilationOptions:stcOptions value. |
|
5053 Compiler ccCompilationOptions:ccOptions value. |
|
5054 Compiler ccPath:cc value. |
|
5055 stc value ~= Compiler stcPath ifTrue:[ |
|
5056 Compiler stcPath:stc value |
|
5057 ]. |
|
5058 ObjectFileLoader linkCommand:linkCommand value. |
|
5059 ObjectFileLoader linkArgs:linkArgs value. |
|
5060 ]. |
|
5061 |
|
5062 ObjectFileLoader notNil ifTrue:[ |
|
5063 stcLibraries notNil ifTrue:[ |
|
5064 ObjectFileLoader searchedLibraries:(stcLibraries value asCollectionOfWords). |
|
5065 ]. |
|
5066 stcLibraryPath notNil ifTrue:[ |
|
5067 ObjectFileLoader libPath:(stcLibraryPath value). |
|
5068 ] |
|
5069 ]. |
|
5070 ]. |
|
5071 box destroy |
|
5072 |
|
5073 "Modified: / 10.9.1995 / 19:19:18 / claus" |
|
5074 "Modified: / 9.9.1996 / 22:42:47 / stefan" |
|
5075 "Created: / 2.10.1998 / 16:27:49 / cg" |
|
5076 "Modified: / 21.10.1998 / 19:15:10 / cg" |
|
5077 ! |
|
5078 |
|
5079 toolSettingsFor:requestor |
|
5080 "open a dialog on tool settings" |
|
5081 |
|
5082 |box |
|
5083 component |
|
5084 resources useNewInspector useNewChangesBrowser currentUserPrefs| |
|
5085 |
|
5086 currentUserPrefs := UserPreferences current. |
|
5087 |
|
5088 resources := requestor class classResources. |
|
5089 |
|
5090 "/ |
|
5091 "/ extract relevant system settings ... |
|
5092 "/ |
|
5093 useNewInspector := currentUserPrefs useNewInspector asValue. |
|
5094 useNewChangesBrowser := currentUserPrefs useNewChangesBrowser asValue. |
|
5095 |
|
5096 "/ |
|
5097 "/ create a box on those values ... |
|
5098 "/ |
|
5099 box := DialogBox new. |
|
5100 box label:(resources string:'Tool settings'). |
|
5101 |
|
5102 |
|
5103 |
|
5104 box addCheckBox:(resources string:'Use the new Changes Browser') on:useNewChangesBrowser. |
|
5105 box addHorizontalLine. |
|
5106 box addCheckBox:(resources string:'Use hierarchical inspector') on:useNewInspector. |
|
5107 |
|
5108 box |
|
5109 addHelpButtonFor:'Launcher/toolSettings.html'; |
|
5110 addAbortButton; |
|
5111 addOkButton. |
|
5112 |
|
5113 "/ |
|
5114 "/ show the box ... |
|
5115 "/ |
|
5116 box open. |
|
5117 |
|
5118 "/ |
|
5119 "/ update system settings |
|
5120 "/ |
|
5121 box accepted ifTrue:[ |
|
5122 currentUserPrefs useNewInspector:useNewInspector value. |
|
5123 currentUserPrefs useNewChangesBrowser:useNewChangesBrowser value. |
|
5124 useNewInspector value ifTrue:[ |
|
5125 Inspector := NewInspector::InspectorView |
|
5126 ] ifFalse:[ |
|
5127 Inspector := InspectorView |
|
5128 ]. |
|
5129 ]. |
|
5130 box destroy |
|
5131 |
|
5132 "Modified: / 9.9.1996 / 22:43:36 / stefan" |
|
5133 "Modified: / 16.4.1998 / 17:18:47 / ca" |
|
5134 "Created: / 13.10.1998 / 15:44:36 / cg" |
|
5135 "Modified: / 13.10.1998 / 16:03:43 / cg" |
|
5136 ! |
|
5137 |
|
5138 viewStyleSettingsFor:requestor |
|
5139 "open a dialog on viewStyle related settings" |
|
5140 |
|
5141 | resourceDir dir box |
|
5142 list listView scrView infoLabel infoForwarder newStyle |
|
5143 someRsrcFile b didApply resources listUpdater showStandardStylesOnly standardStyles| |
|
5144 |
|
5145 showStandardStylesOnly := true asValue. |
|
5146 standardStyles := #('iris' 'motif' 'mswindows95' 'next' 'os2' 'st80' 'normal'). |
|
5147 |
|
5148 resources := requestor class classResources. |
|
5149 |
|
5150 " |
|
5151 search resources directory for a list of .style files ... |
|
5152 " |
|
5153 someRsrcFile := Smalltalk getSystemFileName:('resources' asFilename constructString:'normal.style'). |
|
5154 someRsrcFile notNil ifTrue:[ |
|
5155 resourceDir := someRsrcFile asFilename directoryName |
|
5156 ] ifFalse:[ |
|
5157 resourceDir := Smalltalk getSystemFileName:'resources'. |
|
5158 ]. |
|
5159 |
|
5160 resourceDir isNil ifTrue:[ |
|
5161 self warn:'no styles found (missing ''resources'' directory)'. |
|
5162 ^ self |
|
5163 ]. |
|
5164 dir := resourceDir asFilename directoryContents. |
|
5165 |
|
5166 list := SelectionInList new. |
|
5167 |
|
5168 listUpdater := [ |
|
5169 |listOfStyles lastSelection| |
|
5170 |
|
5171 lastSelection := list selection. |
|
5172 listOfStyles := dir select:[:aFileName | aFileName asFilename hasSuffix:'style']. |
|
5173 listOfStyles := listOfStyles collect:[:aFileName | aFileName asFilename withoutSuffix name]. |
|
5174 Filename isCaseSensitive ifFalse:[ |
|
5175 listOfStyles := listOfStyles collect:[:aStyleName | aStyleName asLowercase]. |
|
5176 ]. |
|
5177 listOfStyles remove:'generic' ifAbsent:nil; remove:'mswindows3' ifAbsent:nil. |
|
5178 showStandardStylesOnly value ifTrue:[ |
|
5179 listOfStyles := listOfStyles select:[:aStyleName | standardStyles includes:aStyleName]. |
|
5180 ]. |
|
5181 |
|
5182 listOfStyles sort. |
|
5183 list list:listOfStyles. |
|
5184 list selection:lastSelection. |
|
5185 ]. |
|
5186 listUpdater value. |
|
5187 |
|
5188 showStandardStylesOnly onChangeSend:#value to:listUpdater. |
|
5189 |
|
5190 infoForwarder := [ |
|
5191 |nm sheet comment| |
|
5192 |
|
5193 comment := ''. |
|
5194 nm := list selection. |
|
5195 nm notNil ifTrue:[ |
|
5196 sheet := ViewStyle fromFile:(nm , '.style'). |
|
5197 comment := (sheet at:#comment ifAbsent:'') withoutSeparators. |
|
5198 ]. |
|
5199 comment := comment withCRs asStringCollection. |
|
5200 comment size == 1 ifTrue:[ |
|
5201 comment := comment first |
|
5202 ]. |
|
5203 infoLabel label:comment |
|
5204 ]. |
|
5205 |
|
5206 list onChangeSend:#value to:infoForwarder. |
|
5207 |
|
5208 box := Dialog new. |
|
5209 box label:(resources string:'Style selection'). |
|
5210 |
|
5211 (box addTextLabel:(resources at:'STYLE_MSG' default:'select a style') withCRs) adjust:#left. |
|
5212 listView := SelectionInListView on:list. |
|
5213 listView doubleClickAction:[:sel | box accept value:true. box hide]. |
|
5214 box addCheckBox:(resources string:'standard styles only') on:showStandardStylesOnly. |
|
5215 scrView := box addComponent:(ScrollableView forView:listView) tabable:true. |
|
5216 |
|
5217 box addVerticalSpace. |
|
5218 |
|
5219 (infoLabel := box addTextLabel:'\\' withCRs) adjust:#centerLeft. |
|
5220 |
|
5221 box addAbortButton. |
|
5222 |
|
5223 "/ mhmh - the newLauncher does not yet handle apply (without close) correctly |
|
5224 "/ b := box addButton:(Button label:(resources string:'apply')). |
|
5225 "/ b action:[didApply := true. requestor changeViewStyleTo:(list selection)]. |
|
5226 |
|
5227 box addOkButton. |
|
5228 |
|
5229 (standardStyles includes:View defaultStyle) ifFalse:[ |
|
5230 showStandardStylesOnly value:false |
|
5231 ]. |
|
5232 list selection:(View defaultStyle). |
|
5233 |
|
5234 box stickAtBottomWithVariableHeight:scrView. |
|
5235 box stickAtBottomWithFixHeight:infoLabel. |
|
5236 box open. |
|
5237 |
|
5238 box destroy. |
|
5239 box accepted ifTrue:[ |
|
5240 ((newStyle := list selection) ~= View defaultStyle |
|
5241 or:[didApply ~~ true]) ifTrue:[ |
|
5242 requestor changeViewStyleTo:newStyle. |
|
5243 ]. |
|
5244 ]. |
|
5245 |
|
5246 " |
|
5247 self viewStyleSettingsFor:nil |
|
5248 " |
|
5249 |
|
5250 "Modified: / 14.9.1998 / 20:33:59 / cg" |
|
5251 ! ! |
2503 ! ! |
5252 |
|
5253 !Launcher::LauncherDialogs class methodsFor:'dialogs - file'! |
|
5254 |
|
5255 objectModuleDialogFor:requestor |
|
5256 "opens a moduleInfo dialog" |
|
5257 |
|
5258 <resource: #programMenu > |
|
5259 |
|
5260 |allModules moduleNames |
|
5261 allObjects methodObjects methodNames |
|
5262 cObjects cObjectNames |
|
5263 otherObjects otherObjectNames |
|
5264 box l handles unloadButton unloadAndRemoveButton |
|
5265 list1 list2 listView1 listView2 |
|
5266 y panel |
|
5267 showBuiltIn showModules showMethods showCObjects showOthers |
|
5268 moduleListUpdater check canDoIt menu |
|
5269 resources middleLabel| |
|
5270 |
|
5271 resources := requestor class classResources. |
|
5272 |
|
5273 showBuiltIn := true asValue. |
|
5274 canDoIt := ObjectFileLoader notNil and:[ObjectFileLoader canLoadObjectFiles]. |
|
5275 |
|
5276 showModules := canDoIt asValue. |
|
5277 showMethods := canDoIt asValue. |
|
5278 showCObjects := canDoIt asValue. |
|
5279 showOthers := canDoIt asValue. |
|
5280 |
|
5281 list1 := SelectionInList new. |
|
5282 list2 := SelectionInList new. |
|
5283 |
|
5284 moduleListUpdater := [ |
|
5285 |l| |
|
5286 |
|
5287 list2 list:nil. |
|
5288 |
|
5289 l := Array new. |
|
5290 handles := Array new. |
|
5291 |
|
5292 (showModules value or:[showBuiltIn value]) ifTrue:[ |
|
5293 allModules := ObjectMemory binaryModuleInfo asOrderedCollection. |
|
5294 (showBuiltIn value and:[showModules value]) ifFalse:[ |
|
5295 allModules := allModules select:[:i | |
|
5296 |wantToSee| |
|
5297 |
|
5298 wantToSee := i dynamic. |
|
5299 showBuiltIn value ifTrue:[ |
|
5300 wantToSee := wantToSee not |
|
5301 ]. |
|
5302 wantToSee |
|
5303 ] |
|
5304 ]. |
|
5305 |
|
5306 "/ sorting by reverse id brings newest ones to the top (a side effect) |
|
5307 allModules sort:[:a :b | (a id) > (b id)]. |
|
5308 moduleNames := allModules collect:[:entry | entry name]. |
|
5309 l := l , moduleNames. |
|
5310 handles := handles , allModules. |
|
5311 ]. |
|
5312 |
|
5313 showMethods value ifTrue:[ |
|
5314 allObjects := ObjectFileLoader loadedObjectHandles. |
|
5315 methodObjects := (allObjects select:[:h | h isMethodHandle]) asArray. |
|
5316 methodNames := methodObjects collect:[:mH | mH method isNil ifTrue:[ |
|
5317 'compiled method - removed' " , ' (in ' , mH pathName , ')' " |
|
5318 ] ifFalse:[ |
|
5319 'compiled method ' , mH method whoString " , ' (in ' , mH pathName , ')' " |
|
5320 ]. |
|
5321 ]. |
|
5322 l := l , methodNames. |
|
5323 handles := handles , methodObjects. |
|
5324 ]. |
|
5325 |
|
5326 showCObjects value ifTrue:[ |
|
5327 allObjects := ObjectFileLoader loadedObjectHandles. |
|
5328 cObjects := (allObjects select:[:h | h isFunctionObjectHandle]) asArray. |
|
5329 cObjectNames := cObjects collect:[:entry | entry pathName]. |
|
5330 l := l , cObjectNames. |
|
5331 handles := handles , cObjects. |
|
5332 ]. |
|
5333 |
|
5334 showOthers value ifTrue:[ |
|
5335 allObjects := ObjectFileLoader loadedObjectHandles. |
|
5336 otherObjects := (allObjects select:[:h | (h isFunctionObjectHandle |
|
5337 or:[h isMethodHandle |
|
5338 or:[h isClassLibHandle]]) not]) asArray. |
|
5339 otherObjectNames := otherObjects collect:[:entry | entry pathName]. |
|
5340 l := l , otherObjectNames. |
|
5341 handles := handles , otherObjects. |
|
5342 ]. |
|
5343 |
|
5344 showBuiltIn value ifTrue:[ |
|
5345 l := #('VM') , l. |
|
5346 handles := #(VM) , handles. |
|
5347 allModules := #(VM) , allModules. |
|
5348 ]. |
|
5349 |
|
5350 list1 list:l. |
|
5351 unloadButton disable. |
|
5352 unloadAndRemoveButton disable. |
|
5353 ]. |
|
5354 |
|
5355 showBuiltIn onChangeSend:#value to:moduleListUpdater. |
|
5356 showModules onChangeSend:#value to:moduleListUpdater. |
|
5357 showMethods onChangeSend:#value to:moduleListUpdater. |
|
5358 showCObjects onChangeSend:#value to:moduleListUpdater. |
|
5359 showOthers onChangeSend:#value to:moduleListUpdater. |
|
5360 |
|
5361 box := Dialog new. |
|
5362 box label:(resources string:'ST/X & Module Version information'). |
|
5363 |
|
5364 listView1 := HVScrollableView for:SelectionInListView miniScrollerH:true. |
|
5365 listView1 model:list1. |
|
5366 listView1 origin:0.0@0.0 corner:1.0@0.4. "/ ; inset:2. |
|
5367 listView1 action:[:sel | |
|
5368 |info classNames tabs module| |
|
5369 |
|
5370 listView1 middleButtonMenu:nil. |
|
5371 |
|
5372 box withWaitCursorDo:[ |
|
5373 |nm fileName addr entry1 entry2 entry3 method l| |
|
5374 |
|
5375 tabs := TabulatorSpecification unit:#inch positions:#(0 2.6 3.5). |
|
5376 |
|
5377 (showModules value or:[showBuiltIn value]) ifTrue:[ |
|
5378 info := allModules at:sel ifAbsent:nil. |
|
5379 ]. |
|
5380 info isNil ifTrue:[ |
|
5381 "/ selected a method, cObject or unknown |
|
5382 |
|
5383 module := handles at:sel. |
|
5384 fileName := module pathName. |
|
5385 |
|
5386 module isMethodHandle ifTrue:[ |
|
5387 middleLabel label:'contains method:'. |
|
5388 |
|
5389 (method := module method) isNil ifTrue:[ |
|
5390 nm := '** removed **'. |
|
5391 ] ifFalse:[ |
|
5392 menu := PopUpMenu |
|
5393 labels:#('inspect' 'browse') |
|
5394 selectors:#(inspect browse). |
|
5395 menu actionAt:#inspect put:[ method inspect ]. |
|
5396 menu actionAt:#browse put:[ |who| |
|
5397 who := method who. |
|
5398 SystemBrowser |
|
5399 openInClass:(who methodClass) |
|
5400 selector:(who methodSelector) |
|
5401 ]. |
|
5402 listView1 middleButtonMenu:menu. |
|
5403 |
|
5404 nm := (method whoString) asText emphasizeAllWith:(#color->Color blue). |
|
5405 ]. |
|
5406 entry1 := MultiColListEntry new:2 tabulatorSpecification:tabs. |
|
5407 entry1 colAt:1 put:'compiled method'; colAt:2 put:nm. |
|
5408 |
|
5409 entry2 := MultiColListEntry new:2 tabulatorSpecification:tabs. |
|
5410 entry2 colAt:1 put:'path'; colAt:2 put:fileName. |
|
5411 |
|
5412 entry3 := MultiColListEntry new:2 tabulatorSpecification:tabs. |
|
5413 entry3 colAt:1 put:'address'; colAt:2 put:('(16r) ' , (method code address hexPrintString leftPaddedTo:8 with:$0)). |
|
5414 |
|
5415 list2 list:(Array with:entry1 with:entry2 with:entry3). |
|
5416 ] ifFalse:[ |
|
5417 (module isFunctionObjectHandle |
|
5418 and:[module functions notEmpty]) ifTrue:[ |
|
5419 middleLabel label:'contains function:'. |
|
5420 |
|
5421 menu := PopUpMenu |
|
5422 labels:#('inspect') |
|
5423 selectors:#(inspect). |
|
5424 menu actionAt:#inspect put:[ module functions inspect ]. |
|
5425 listView1 middleButtonMenu:menu. |
|
5426 |
|
5427 list2 list:((module functions select:[:f | f notNil]) |
|
5428 collect:[:f | |entry| |
|
5429 entry := MultiColListEntry new:2 tabulatorSpecification:tabs. |
|
5430 entry colAt:1 put:(f name asText emphasizeAllWith:(#color->Color blue)). |
|
5431 entry colAt:2 put:('address: (16r) ' , (f code address hexPrintString leftPaddedTo:8 with:$0)). |
|
5432 entry |
|
5433 ]). |
|
5434 ] ifFalse:[ |
|
5435 list2 list:#('nothing known about contents (no functions have been extracted)'). |
|
5436 ] |
|
5437 ]. |
|
5438 |
|
5439 unloadButton enable. |
|
5440 unloadAndRemoveButton disable. |
|
5441 ] ifFalse:[ |
|
5442 info == #VM ifTrue:[ |
|
5443 "/ dummy entry for VM; |
|
5444 "/ show file versions in lower view. |
|
5445 |
|
5446 middleLabel label:'contains modules:'. |
|
5447 l := (ObjectMemory getVMIdentificationStrings). |
|
5448 l := l select:[:entry | entry includesString:'$Header']. |
|
5449 l := l select:[:entry | entry includesString:',v']. |
|
5450 l := l collect:[:entry | |
|
5451 |i1 i2 file revision date listEntry| |
|
5452 |
|
5453 listEntry := MultiColListEntry new:3 tabulatorSpecification:tabs. |
|
5454 |
|
5455 i1 := entry indexOfSubCollection:'librun'. |
|
5456 i1 ~~ 0 ifTrue:[ |
|
5457 i2 := entry indexOfSubCollection:',v' startingAt:i1. |
|
5458 i2 ~~ 0 ifTrue:[ |
|
5459 file := entry copyFrom:i1+7 to:(i2-1). |
|
5460 listEntry colAt:1 put:file. |
|
5461 |
|
5462 i1 := i2+3. |
|
5463 i2 := entry indexOfSeparatorStartingAt:i1. |
|
5464 revision := entry copyFrom:i1 to:(i2-1). |
|
5465 listEntry colAt:2 put:revision. |
|
5466 |
|
5467 i1 := i2+1. |
|
5468 i2 := entry indexOfSeparatorStartingAt:i1. |
|
5469 date := entry copyFrom:i1 to:(i2-1). |
|
5470 listEntry colAt:3 put:date. |
|
5471 ]. |
|
5472 ]. |
|
5473 listEntry. |
|
5474 "/ entry |
|
5475 ]. |
|
5476 list2 list:l. |
|
5477 |
|
5478 unloadButton disable. |
|
5479 unloadAndRemoveButton disable. |
|
5480 ] ifFalse:[ |
|
5481 "/ selected a package |
|
5482 |
|
5483 "/ fill bottom list with class-info |
|
5484 |
|
5485 middleLabel label:'contains classes:'. |
|
5486 classNames := info classNames asSortedCollection. |
|
5487 classNames := classNames select:[:cName | |
|
5488 |cls| |
|
5489 |
|
5490 cls := Smalltalk classNamed:cName. |
|
5491 cls isNil ifTrue:[ |
|
5492 true "a removed class" |
|
5493 ] ifFalse:[ |
|
5494 cls isPrivate not |
|
5495 ]. |
|
5496 ]. |
|
5497 |
|
5498 classNames := classNames collect:[:cName | |
|
5499 |cls entry rev listEntry| |
|
5500 |
|
5501 listEntry := MultiColListEntry new:2 tabulatorSpecification:tabs. |
|
5502 listEntry colAt:1 put:cName. |
|
5503 |
|
5504 cls := Smalltalk classNamed:cName. |
|
5505 cls isNil ifTrue:[ |
|
5506 listEntry colAt:2 put:'(class removed)'. |
|
5507 ] ifFalse:[ |
|
5508 rev := cls binaryRevision. |
|
5509 rev notNil ifTrue:[ |
|
5510 cls isLoaded ifFalse:[ |
|
5511 entry := '(stub for: ' , rev. |
|
5512 ] ifTrue:[ |
|
5513 entry :='(bin: ' , rev. |
|
5514 ]. |
|
5515 cls revision ~= rev ifTrue:[ |
|
5516 entry := entry , ' / src: ' , cls revision |
|
5517 ]. |
|
5518 listEntry colAt:2 put:entry , ')' |
|
5519 ] ifFalse:[ |
|
5520 cls revision notNil ifTrue:[ |
|
5521 listEntry colAt:2 put:'(overloaded by: ' , cls revision , ')' |
|
5522 ] |
|
5523 ] |
|
5524 ]. |
|
5525 listEntry |
|
5526 ]. |
|
5527 list2 list:classNames. |
|
5528 info dynamic ifTrue:[ |
|
5529 unloadButton enable. |
|
5530 unloadAndRemoveButton enable. |
|
5531 ] ifFalse:[ |
|
5532 unloadButton disable. |
|
5533 unloadAndRemoveButton disable. |
|
5534 ]. |
|
5535 ]. |
|
5536 ] |
|
5537 ] |
|
5538 ]. |
|
5539 |
|
5540 |
|
5541 panel := HorizontalPanelView new. |
|
5542 |
|
5543 panel add:(l := Label label:'show:'). |
|
5544 l adjust:#left; borderWidth:0. |
|
5545 panel add:(check := CheckBox label:'builtin' model:showBuiltIn). |
|
5546 box makeTabable:check. |
|
5547 panel add:(check := CheckBox label:'classLibs' model:showModules). |
|
5548 canDoIt ifFalse:[ |
|
5549 check disable |
|
5550 ] ifTrue:[ |
|
5551 box makeTabable:check. |
|
5552 ]. |
|
5553 panel add:(check := CheckBox label:'methods' model:showMethods). |
|
5554 canDoIt ifFalse:[ |
|
5555 check disable |
|
5556 ] ifTrue:[ |
|
5557 box makeTabable:check. |
|
5558 ]. |
|
5559 panel add:(check := CheckBox label:'c-objects' model:showCObjects). |
|
5560 canDoIt ifFalse:[ |
|
5561 check disable |
|
5562 ] ifTrue:[ |
|
5563 box makeTabable:check. |
|
5564 ]. |
|
5565 panel add:(check := CheckBox label:'others' model:showOthers). |
|
5566 canDoIt ifFalse:[ |
|
5567 check disable |
|
5568 ] ifTrue:[ |
|
5569 box makeTabable:check. |
|
5570 ]. |
|
5571 |
|
5572 panel horizontalLayout:#fitSpace. |
|
5573 "/ panel horizontalLayout:#leftSpace. |
|
5574 |
|
5575 box addComponent:panel tabable:false. |
|
5576 |
|
5577 box addVerticalSpace. |
|
5578 box addComponent:listView1 tabable:true. |
|
5579 listView1 topInset:(View viewSpacing + panel preferredExtent y). |
|
5580 listView1 origin:0.0@0.0 corner:1.0@0.4. "/ ; inset:2. |
|
5581 |
|
5582 l := box addTextLabel:(resources string:'contains:'). |
|
5583 l adjust:#left; borderWidth:0. |
|
5584 l origin:0.0@0.4 corner:1.0@0.4. |
|
5585 l topInset:(View viewSpacing). |
|
5586 l bottomInset:((l preferredExtent y) negated - View viewSpacing). |
|
5587 middleLabel := l. |
|
5588 |
|
5589 listView2 := HVScrollableView for:SelectionInListView miniScrollerH:true. |
|
5590 listView2 model:list2; printItems:false. |
|
5591 box addComponent:listView2 tabable:true. |
|
5592 listView2 origin:0.0@0.4 corner:1.0@1.0. "/ ; inset:2. |
|
5593 listView2 disable. |
|
5594 |
|
5595 unloadButton := Button label:(resources string:'unload'). |
|
5596 unloadButton action:[ |
|
5597 box withWaitCursorDo:[ |
|
5598 |info idx pathName| |
|
5599 |
|
5600 idx := list1 selectionIndex. |
|
5601 info := allModules at:idx ifAbsent:nil. |
|
5602 |
|
5603 list1 selectionIndex:nil. |
|
5604 |
|
5605 info isNil ifTrue:[ |
|
5606 "/ selected a method |
|
5607 "/ idx := idx - allModules size. |
|
5608 pathName := (handles at:idx) pathName. |
|
5609 |
|
5610 ] ifFalse:[ |
|
5611 "/ selected a package |
|
5612 pathName := info pathName. |
|
5613 ]. |
|
5614 ObjectFileLoader unloadObjectFile:pathName. |
|
5615 moduleListUpdater value. |
|
5616 unloadButton disable. |
|
5617 ] |
|
5618 ]. |
|
5619 |
|
5620 unloadAndRemoveButton := Button label:(resources string:'remove classes & unload'). |
|
5621 unloadAndRemoveButton action:[ |
|
5622 box withWaitCursorDo:[ |
|
5623 |info idx pathName| |
|
5624 |
|
5625 idx := list1 selectionIndex. |
|
5626 info := allModules at:idx ifAbsent:nil. |
|
5627 |
|
5628 list1 selectionIndex:nil. |
|
5629 |
|
5630 info isNil ifTrue:[ |
|
5631 "/ selected a method |
|
5632 "/ idx := idx - allModules size. |
|
5633 pathName := (handles at:idx) pathName. |
|
5634 |
|
5635 ] ifFalse:[ |
|
5636 "/ selected a package |
|
5637 pathName := info pathName. |
|
5638 ]. |
|
5639 ObjectFileLoader unloadObjectFileAndRemoveClasses:pathName. |
|
5640 moduleListUpdater value. |
|
5641 unloadAndRemoveButton disable. |
|
5642 ] |
|
5643 ]. |
|
5644 |
|
5645 moduleListUpdater value. |
|
5646 |
|
5647 box addButton:unloadButton. |
|
5648 box addButton:unloadAndRemoveButton. |
|
5649 box addAbortButtonLabelled:(resources string:'dismiss'). |
|
5650 |
|
5651 y := box yPosition. |
|
5652 listView2 topInset:(l preferredExtent y + 5). |
|
5653 listView2 bottomInset:(box preferredExtent y - y). |
|
5654 |
|
5655 box width:(400 min:(box device width * 2 // 3)); |
|
5656 height:(450 min:(box device height - 50)). |
|
5657 |
|
5658 "/ box sizeFixed:true. |
|
5659 box openWithExtent:(600 min:(box device width * 2 // 3)) |
|
5660 @ |
|
5661 (500 min:(box device height - 50)) . |
|
5662 |
|
5663 box destroy. |
|
5664 |
|
5665 "Modified: / 17.9.1995 / 16:47:50 / claus" |
|
5666 "Created: / 31.7.1998 / 15:49:45 / cg" |
|
5667 "Modified: / 10.8.1998 / 11:33:22 / cg" |
|
5668 ! ! |
|
5669 |
|
5670 !Launcher::LauncherDialogs class methodsFor:'dialogs-private'! |
|
5671 |
|
5672 cvsConfigurationDialogFor:requestor |
|
5673 |box y cvsRootHolder component resources defaultsList| |
|
5674 |
|
5675 resources := requestor class classResources. |
|
5676 |
|
5677 OperatingSystem isUNIXlike ifTrue:[ |
|
5678 defaultsList := #('/files/CVS' '/CVS' 'host:/files/CVS' 'host:/CVS'). |
|
5679 ] ifFalse:[ |
|
5680 OperatingSystem isMSDOSlike ifTrue:[ |
|
5681 defaultsList := #(':local:c:\files\CVS' ':local:c:\CVS' 'host:/files/CVS' 'host:/CVS'). |
|
5682 ] ifFalse:[ |
|
5683 defaultsList := #('host:/files/CVS' 'host:/CVS'). |
|
5684 ] |
|
5685 ]. |
|
5686 |
|
5687 cvsRootHolder := CVSSourceCodeManager repositoryName ? '/files/CVS'. |
|
5688 cvsRootHolder := cvsRootHolder asValue. |
|
5689 |
|
5690 "/ |
|
5691 "/ create a box to input the CVSRoot ... |
|
5692 "/ |
|
5693 box := DialogBox new. |
|
5694 box label:(resources string:'CVS Setup'). |
|
5695 |
|
5696 component := (box addTextLabel:'CVS SourceCodeManager setup'). |
|
5697 component adjust:#left. |
|
5698 |
|
5699 y := box yPosition. |
|
5700 component := box addTextLabel:(resources string:'CVSRoot:'). |
|
5701 component width:0.25; adjust:#right; borderWidth:0. |
|
5702 box yPosition:y. |
|
5703 component := box addComboBoxOn:nil tabable:true. |
|
5704 "/ commandListPop := box addInputFieldOn:printCommand tabable:true. |
|
5705 component width:0.75; left:0.25; immediateAccept:true; acceptOnLeave:false; cursorMovementWhenUpdating:#beginOfLine. |
|
5706 component list:defaultsList. |
|
5707 component model:cvsRootHolder. |
|
5708 |
|
5709 "/ component := box |
|
5710 "/ addLabelledInputField:(resources string:'CVSRoot:') |
|
5711 "/ adjust:#right |
|
5712 "/ on:nil |
|
5713 "/ tabable:true |
|
5714 "/ separateAtX:0.5. |
|
5715 "/ component acceptOnLeave:false. |
|
5716 "/ component model:cvsRootHolder. |
|
5717 |
|
5718 box |
|
5719 addHelpButtonFor:'Launcher/sourceSettings.html'; |
|
5720 addAbortButton; |
|
5721 addOkButton. |
|
5722 |
|
5723 "/ |
|
5724 "/ show the box ... |
|
5725 "/ |
|
5726 box extent:400@300. |
|
5727 box showAtPointer. |
|
5728 |
|
5729 "/ |
|
5730 "/ update system settings |
|
5731 "/ |
|
5732 box accepted ifTrue:[ |
|
5733 CVSSourceCodeManager initializeForRepository:cvsRootHolder value |
|
5734 ]. |
|
5735 box destroy |
|
5736 |
|
5737 "Modified: / 16.4.1998 / 17:18:16 / ca" |
|
5738 "Modified: / 12.8.1998 / 17:09:02 / cg" |
|
5739 ! |
|
5740 |
|
5741 fontBoxForEncoding:encodingMatch for:requestor |
|
5742 "open a fontBox, showing fonts which match some encoding |
|
5743 (used when changing to japanese ...)" |
|
5744 |
|
5745 |box y b |
|
5746 labelDef buttonDef listDef menuDef textDef |
|
5747 models labels allOfThem filter resources| |
|
5748 |
|
5749 resources := requestor class classResources. |
|
5750 |
|
5751 encodingMatch notNil ifTrue:[ |
|
5752 filter := [:f | f encoding notNil |
|
5753 and:[encodingMatch match:f encoding]]. |
|
5754 ]. |
|
5755 |
|
5756 models := OrderedCollection new. |
|
5757 labels := OrderedCollection new. |
|
5758 |
|
5759 models add:(allOfThem := nil asValue). |
|
5760 models add:(labelDef := Label defaultFont asValue). |
|
5761 models add:(buttonDef := Button defaultFont asValue). |
|
5762 models add:(listDef := SelectionInListView defaultFont asValue). |
|
5763 models add:(menuDef := MenuView defaultFont asValue). |
|
5764 models add:(textDef := TextView defaultFont asValue). |
|
5765 |
|
5766 box := Dialog new. |
|
5767 box label:(resources string:'Font settings'). |
|
5768 |
|
5769 models |
|
5770 with:(resources array:#('all' 'labels' 'buttons' 'lists' 'menus' 'edit text')) |
|
5771 do:[:model :title | |
|
5772 |y2 lbl f i| |
|
5773 |
|
5774 f := model value. |
|
5775 |
|
5776 (box addTextLabel:title) adjust:#left. |
|
5777 |
|
5778 y := box yPosition. |
|
5779 b := box addComponent:(Button label:(resources string:'change ...')) tabable:true. |
|
5780 b relativeExtent:nil; extent:(b preferredExtent). |
|
5781 y2 := box yPosition. |
|
5782 box yPosition:y. |
|
5783 i := box leftIndent. |
|
5784 box leftIndent:(b widthIncludingBorder + View viewSpacing). |
|
5785 (lbl := box addTextLabel:'') |
|
5786 adjust:#left; |
|
5787 font:(model value); |
|
5788 labelChannel:(BlockValue |
|
5789 with:[:v | |f| |
|
5790 f := v value. |
|
5791 f isNil ifTrue:[ |
|
5792 '' |
|
5793 ] ifFalse:[ |
|
5794 f userFriendlyName |
|
5795 ] |
|
5796 ] |
|
5797 argument:model). |
|
5798 labels add:lbl. |
|
5799 |
|
5800 box leftIndent:i. |
|
5801 box yPosition:(box yPosition max:y2). |
|
5802 |
|
5803 box addVerticalSpace; addHorizontalLine; addVerticalSpace. |
|
5804 |
|
5805 b action:[ |
|
5806 |f| |
|
5807 |
|
5808 f := FontPanel |
|
5809 fontFromUserInitial:(model value) |
|
5810 title:(resources string:'font for %1' with:title) |
|
5811 filter:filter. |
|
5812 f notNil ifTrue:[ |
|
5813 model == allOfThem ifTrue:[ |
|
5814 models do:[:m | m value:f]. |
|
5815 labels do:[:l | l font:f] |
|
5816 ] ifFalse:[ |
|
5817 model value:f. |
|
5818 lbl font:f. |
|
5819 ]. |
|
5820 ] |
|
5821 ]. |
|
5822 model == allOfThem ifTrue:[ |
|
5823 box addVerticalSpace |
|
5824 ] |
|
5825 ]. |
|
5826 |
|
5827 box addAbortButton; addOkButton. |
|
5828 (box addButton:(Button label:(resources string:'defaults')) before:nil) |
|
5829 action:[ |
|
5830 "/ fetch defaults |
|
5831 View readStyleSheetAndUpdateAllStyleCaches. |
|
5832 labelDef value: Label defaultFont. |
|
5833 buttonDef value: Button defaultFont. |
|
5834 listDef value: SelectionInListView defaultFont. |
|
5835 menuDef value: MenuView defaultFont. |
|
5836 textDef value: TextView defaultFont. |
|
5837 ]. |
|
5838 |
|
5839 box open. |
|
5840 box accepted ifTrue:[ |
|
5841 Label defaultFont:labelDef value. |
|
5842 Button defaultFont:buttonDef value. |
|
5843 Toggle defaultFont:buttonDef value. |
|
5844 SelectionInListView defaultFont:listDef value. |
|
5845 MenuView defaultFont:menuDef value. |
|
5846 PullDownMenu defaultFont:menuDef value. |
|
5847 TextView defaultFont:textDef value. |
|
5848 EditTextView defaultFont:textDef value. |
|
5849 CodeView defaultFont:textDef value. |
|
5850 ]. |
|
5851 box destroy. |
|
5852 ^ box accepted |
|
5853 |
|
5854 "Created: / 27.2.1996 / 01:44:16 / cg" |
|
5855 "Modified: / 17.6.1996 / 13:38:48 / stefan" |
|
5856 "Modified: / 15.9.1998 / 22:04:51 / cg" |
|
5857 ! |
|
5858 |
|
5859 syntaxColorConfigurationDialogFor:requestor |
|
5860 |box frame exampleView |
|
5861 component |
|
5862 resources exampleText coloredText recolorAction |
|
5863 syntaxColor syntaxColors colorMenu oldUserPreferences |
|
5864 syntaxEmphasises syntaxColorSelector syntaxEmphasisSelector syntaxColoringBox |
|
5865 syntaxEmphasisesBox syntaxColoringResetBox syntaxColoringEnableBlock| |
|
5866 |
|
5867 resources := requestor class classResources. |
|
5868 |
|
5869 exampleText := |
|
5870 'methodSelector:methodArg |
|
5871 "method comment: |
|
5872 some stupid code to show the current settings" |
|
5873 |
|
5874 |methodVar| |
|
5875 |
|
5876 "/ another comment ... |
|
5877 self foo:methodArg. |
|
5878 self bar:methodVar. |
|
5879 "self bar:methodVar. detect commented code easily" |
|
5880 1 to:5 do:[:i | self baz:i + 1]. |
|
5881 Transcript showCR:''some string'' , #someSymbol. |
|
5882 '. |
|
5883 |
|
5884 coloredText := '' asValue. |
|
5885 recolorAction := [ coloredText value:(SyntaxHighlighter formatMethod:exampleText in:nil) ]. |
|
5886 recolorAction value. |
|
5887 |
|
5888 "/ |
|
5889 "/ create a box on those values ... |
|
5890 "/ |
|
5891 box := DialogBox new. |
|
5892 box label:(resources string:'Syntax Colors'). |
|
5893 |
|
5894 frame := View new. |
|
5895 frame extent:1.0 @ 200. |
|
5896 frame borderWidth:0. |
|
5897 |
|
5898 exampleView := HVScrollableView for:TextView in:frame. |
|
5899 exampleView model:coloredText. |
|
5900 exampleView origin:0.0@0.0 corner:1.0@1.0; inset:2. |
|
5901 |
|
5902 frame topInset:box yPosition. |
|
5903 box addComponent:frame withExtent:1.0@200. |
|
5904 box makeTabable:exampleView. |
|
5905 frame width:1.0. |
|
5906 |
|
5907 box addVerticalSpace. |
|
5908 |
|
5909 oldUserPreferences := UserPreferences current copy. |
|
5910 |
|
5911 syntaxColoringBox := box addComboListOn: (syntaxColors := SelectionInList with:UserPreferences syntaxColors initialSelection:1). |
|
5912 syntaxColorSelector := [(syntaxColors selection replChar:$ withString: '') asLowercaseFirst asSymbol]. |
|
5913 syntaxEmphasisSelector := [((syntaxColorSelector value readStream upToAll: 'Color'), 'Emphasis') asLowercaseFirst asSymbol]. |
|
5914 syntaxColor := (UserPreferences current perform: syntaxColorSelector value) asValue. |
|
5915 colorMenu := ColorMenu new. |
|
5916 colorMenu model: syntaxColor. |
|
5917 syntaxColor onChangeSend: #value to: |
|
5918 [UserPreferences current at: syntaxColorSelector value put: syntaxColor value. |
|
5919 recolorAction value.]. |
|
5920 syntaxColors onChangeSend: #value to: |
|
5921 [syntaxColor value: (UserPreferences current perform:syntaxColorSelector value). |
|
5922 syntaxEmphasises selection: (UserPreferences current perform: syntaxEmphasisSelector value). |
|
5923 recolorAction value.]. |
|
5924 syntaxEmphasisesBox := box addComboListOn: (syntaxEmphasises := SelectionInList with:#(normal underline bold boldUnderline italic italicUnderline reverse) initialSelection:1). |
|
5925 syntaxEmphasises onChangeSend: #value to: |
|
5926 [UserPreferences current at: syntaxEmphasisSelector value put: syntaxEmphasises selection asSymbol. |
|
5927 recolorAction value]. |
|
5928 syntaxColors changed:#value. "/ to force initial update of emphasis |
|
5929 box addComponent:colorMenu tabable:true. |
|
5930 syntaxColoringResetBox := box addComponent:(Button new label: (resources string:'reset'); action: [UserPreferences reset. syntaxColor value: (UserPreferences current perform:syntaxColorSelector value)]). |
|
5931 box makeTabable:syntaxColoringResetBox. |
|
5932 |
|
5933 syntaxColoringBox enable. colorMenu enable. syntaxEmphasisesBox enable. syntaxColoringResetBox enable. |
|
5934 |
|
5935 box |
|
5936 "/ addHelpButtonFor:'Launcher/sourceSettings.html'; |
|
5937 addAbortButton; |
|
5938 addOkButton. |
|
5939 |
|
5940 "/ |
|
5941 "/ show the box ... |
|
5942 "/ |
|
5943 box extent:400@300. |
|
5944 box openModal. |
|
5945 |
|
5946 "/ |
|
5947 "/ update system settings |
|
5948 "/ |
|
5949 box accepted ifTrue:[ |
|
5950 ] ifFalse: [ |
|
5951 (UserPreferences reset; current) declareAllFrom: oldUserPreferences |
|
5952 ]. |
|
5953 box destroy |
|
5954 |
|
5955 "Modified: / 16.4.1998 / 17:18:16 / ca" |
|
5956 "Modified: / 31.7.1998 / 01:37:46 / cg" |
|
5957 ! ! |
|
5958 |
|
5959 !Launcher class methodsFor:'documentation'! |
|
5960 |
|
5961 version |
|
5962 ^ '$Header: /cvs/stx/stx/libtool/Launcher.st,v 1.399 1999-02-10 01:36:04 cg Exp $' |
|
5963 ! ! |
|