"

 COPYRIGHT (c) 1998 by eXept Software AG

	      All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

"{ Package: 'stx:libbasic' }"

"{ NameSpace: Smalltalk }"

IdentityDictionary subclass:#UserPreferences

	instanceVariableNames:''

	classVariableNames:'CurrentPreferences DefaultPreferences'

	poolDictionaries:''

	category:'System-Support'

!

!UserPreferences class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1998 by eXept Software AG

	      All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

!

documentation

"

    A Dictionary for user preference values.

    For non-existing keys, either a defaultValue (false),

    or the value from a defaultDictionary is returned.

    This will eventually keep track of ALL user preferences.

    For now, not all preferences are found here -

    (some of them are currently spread over the system - especially, in Class-Variables)

    - but this will change over time.

    If more prefs are added, think about adding a corresponding UI to the SystemSettingsDialog too.

    UserPreferences current at:#foo

"

! !

!UserPreferences class methodsFor:'initialization'!

initializeDefaultPreferences

    DefaultPreferences := self new.

    Color isNil "Smalltalk isStandAloneApp" ifTrue:[

        ^ self.

    ].

    #(

        #useNewChangesBrowser           false

        #useNewInspector                false

        #showClockInLauncher            true

        #autoFormatting                 false

        #syntaxColoring                 true

        #fullSelectorCheck              false

        #defaultSyntaxColor             (Color black)

        #defaultSyntaxEmphasis          normal

        #errorColor                     (Color red)

        "/ #commentColor                   (Color 12.5 12.5 100)

        #commentColor                   (Color 0 50 0)

        #commentEmphasis                normal

        #methodSelectorEmphasis         bold

        #selectorEmphasis               bold

        #unimplementedSelectorColor     (Color red)

        #unimplementedSelectorEmphasis  normal

        "/ I prefer red-underwave over red identifier ...

        "/      #badIdentifierColor                 (Color red)

        #instVarIdentifierColor         (Color 33 0 33)

        "/ I prefer redish background

        "/      #sideEffectAssignmentColor          (Color 75 0 0)

        "/ #sideEffectAssignmentBackgroundColor    (Color 100 86 86)

        #jsKeywordEmphasis              bold

        "/ #jsKeywordColor                 (Color black)

        #jsKeywordColor                 (Color 33 33 0)

        #controlFlowSelectorColor       (Color 0 0 100)

        #debugSelectorColor             (Color 80 0 0)

        #errorRaisingSelectorColor      (Color 80 0 0)

        "/ #constantColor                  (Color 25 0 0)

        #constantColor                  (Color 64 8 8)

        #globalIdentifierColor          (Color 67 0 67)

        #unknownIdentifierColor         (Color 67 0 67)

        #returnColor                    (Color 0 0 100)

        #returnEmphasis                 bold

     ) pairWiseDo:[:k :v |

        DefaultPreferences at:k put:(v decodeAsLiteralArray).

    ].

    "/ I prefer red-underwave over red identifier ...

    DefaultPreferences at:#badIdentifierEmphasis put:(Array with:#underwave with:(#underlineColor->Color red)).

    "

     self initializeDefaultPreferences

    "

    "Modified: / 16-03-2012 / 10:35:42 / cg"

! !

!UserPreferences class methodsFor:'accessing'!

current

    CurrentPreferences isNil ifTrue:[

	CurrentPreferences := self new.

	CurrentPreferences addAll:self default.

	CurrentPreferences flyByHelpSettingChanged.

    ].

    ^ CurrentPreferences.

    "

     CurrentPreferences := nil

    "

!

default

    DefaultPreferences isNil ifTrue:[

	self initializeDefaultPreferences

    ].

    ^ DefaultPreferences.

    "

     DefaultPreferences := nil.

    "

!

reset

    "resets the CurrentPreferences to its default values"

    CurrentPreferences := nil

!

syntaxColorKeys

    "returns the keys of syntax color items"

    ^#(

        argumentIdentifierColor

          argumentIdentifierEmphasis

        booleanConstantColor

          booleanConstantEmphasis

        bracketColor

          bracketEmphasis

        classVariableIdentifierColor

          classVariableIdentifierEmphasis

        constantColor

          constantEmphasis

        controlFlowSelectorColor

          controlFlowSelectorEmphasis

        commentColor

          commentEmphasis

        defaultSyntaxColor

          defaultSyntaxEmphasis

        errorColor

        globalIdentifierColor

          globalIdentifierEmphasis

        globalClassIdentifierColor

          globalClassIdentifierEmphasis

        hereColor

          hereEmphasis

        identifierColor

          identifierEmphasis

        instVarIdentifierColor

          instVarIdentifierEmphasis

        localIdentifierColor

          localIdentifierEmphasis

        methodSelectorColor

          methodSelectorEmphasis

        poolVariableIdentifierColor

          poolVariableIdentifierEmphasis

        returnColor

          returnEmphasis

        selectorColor

          selectorEmphasis

        selfColor

          selfEmphasis

        stringColor

          stringEmphasis

        superColor

          superEmphasis

        symbolColor

          symbolEmphasis

        thisContextColor

          thisContextEmphasis

        unknownIdentifierColor

          unknownIdentifierEmphasis

        unimplementedSelectorColor

          unimplementedSelectorEmphasis

        sideEffectAssignmentBackgroundColor

    )

    "Modified: / 14-02-2012 / 10:17:46 / cg"

!

syntaxColorNames

    "returns the syntax colors for the settings in the launcher"

"/ warning, the strings below are presented to the user

"/ as the syntax-color boxes comboList - however, they are

"/ also used (without separators) as key into myself.

"/ Therefore, do not change the strings below.

"/ I know - this is bad coding ....

^#(

'Argument Identifier Color'

'Boolean Constant Color'

'Bracket Color'

'Class Variable Identifier Color'

'Collection Enumeration Selector Color'

'Constant Color'

'Control Flow Selector Color'

'Comment Color'

'Debug Selector Color'

'Error Raising Selector Color'

'Global Identifier Color'

'Global Class Identifier Color'

'Here Color'

'Identifier Color'

'InstVar Identifier Color'

'Local Identifier Color'

'Method Selector Color'

'Pool Variable Identifier Color'

'Return Color'

'Selector Color'

'Self Color'

'Side Effect Assignment Color'

'Side Effect Assignment Background Color'

'String Color'

'Super Color'

'Symbol Color'

'This Context Color'

'Unknown Identifier Color'

'Unimplemented Selector Color'

)

    "Modified: / 14-02-2012 / 15:51:38 / cg"

! !

!UserPreferences class methodsFor:'accessing - defaults'!

defaultUserSettingsFile

    ^ (Filename usersPrivateSmalltalkDirectory) / 'settings.stx'

    "Created: / 06-10-2008 / 08:27:15 / Jan Vrany <vranyj1@fel.cvut.cz>"

! !

!UserPreferences class methodsFor:'accessing defaultPrefs'!

defaultSettingsFilename

    ^ 'settings.stx'

!

fileBrowserClass

    "the class to be used for file browsing (used to be the simple FileBrowser, but is now the FileBrowserV2)"

    ^ self current fileBrowserClass

    "

     UserPreferences fileBrowserClass

    "

    "Modified: / 17-07-2010 / 14:50:34 / cg"

!

systemBrowserClass

    ^ self current systemBrowserClass

    "

     UserPreferences systemBrowserClass

    "

!

versionDiffViewerClass

    ^ self current versionDiffViewerClass

    "

     UserPreferences versionDiffViewerClass

    "

! !

!UserPreferences class methodsFor:'saving'!

saveSettings:userPrefs in:fileName

    "save settings to a settings-file."

    "a temporary kludge for old classVariable-based settings

     - all of those MUST go into the user-preferences dictionary eventually"

    |screen|

    screen := Screen current.

    fileName asFilename writingFileDo:[:s|

        s nextPutLine:'"/ ST/X saved settings';

          nextPutLine:'"/ DO NOT MODIFY MANUALLY';

          nextPutLine:'"/ (modifications would be lost with next save-settings)';

          nextPutLine:'"/';

          nextPutLine:'"/ this file was automatically generated by the';

          nextPutLine:'"/ ''save settings'' function of the SettingsDialog';

          nextPutLine:'"/'.

        s cr.

        s nextPutLine:'"/'.

        s nextPutLine:'"/ saved by ' , OperatingSystem getLoginName , '@' , OperatingSystem getHostName , ' at ' , Timestamp now printString.

        s nextPutLine:'"/'.

        s cr.

        s nextPutLine:'"/'.

        s nextPutLine:'"/ Display settings:'.

        s nextPutLine:'"/'.

        s nextPutLine:'"/ only restore the display settings, if on the same Display ...'.

        s nextPutLine:'Display notNil ifTrue:['.

        s nextPutLine:' Display displayName = ' , (screen displayName storeString) , ' ifTrue:['.

          screen fixColors notNil ifTrue:[

            s nextPutLine:'  Image flushDeviceImages.'.

            s nextPutLine:'  Color colorAllocationFailSignal catch:['.

            s nextPutLine:'    Color getColorsRed:6 green:6 blue:4 on:Display'.

            s nextPutLine:'  ].'.

          ] ifFalse:[

            s nextPutLine:'  Display releaseFixColors.'.

          ].

          s nextPutLine:'  Display hasColors: ' , (screen hasColors storeString) , '.'.

          s nextPutLine:'  Display widthInMillimeter: ' , (screen widthInMillimeter storeString) , '.'.

          s nextPutLine:'  Display heightInMillimeter: ' , (screen heightInMillimeter storeString) , '.'.

          s nextPutLine:'  Display supportsDeepIcons: ' , (screen supportsDeepIcons storeString) , '.'.

          s nextPutLine:'  Image ditherAlgorithm: ' , (Image ditherAlgorithm storeString) , '.'.

          s nextPutLine:'  View defaultStyle:' , View defaultStyle storeString , '.'.

        s nextPutLine:' ].'.

        s nextPutLine:'].'.

        s cr.

        s nextPutLine:'"/'.

        s nextPutLine:'"/ Parser/Compiler settings:'.

        s nextPutLine:'"/'.

        s nextPutLine:'ParserFlags warnSTXSpecials: ' , (ParserFlags warnSTXSpecials storeString) , '.';

          nextPutLine:'ParserFlags warnings: ' , (ParserFlags warnings storeString) , '.';

          nextPutLine:'ParserFlags warnUnderscoreInIdentifier: ' , (ParserFlags warnUnderscoreInIdentifier storeString) , '.';

          nextPutLine:'ParserFlags warnOldStyleAssignment: ' , (ParserFlags warnOldStyleAssignment storeString) , '.';

          nextPutLine:'ParserFlags warnCommonMistakes: ' , (ParserFlags warnCommonMistakes storeString) , '.';

          nextPutLine:'ParserFlags warnPossibleIncompatibilities: ' , (ParserFlags warnPossibleIncompatibilities storeString) , '.';

          nextPutLine:'ParserFlags allowUnderscoreInIdentifier: ' , (ParserFlags allowUnderscoreInIdentifier storeString) , '.';

          nextPutLine:'ParserFlags allowSqueakExtensions: ' , (ParserFlags allowSqueakExtensions storeString) , '.';

          nextPutLine:'ParserFlags allowDolphinExtensions: ' , (ParserFlags allowDolphinExtensions storeString) , '.';

          nextPutLine:'ParserFlags allowQualifiedNames: ' , (ParserFlags allowQualifiedNames storeString) , '.';

          nextPutLine:'ParserFlags arraysAreImmutable: ' , (ParserFlags arraysAreImmutable storeString) , '.';

          nextPutLine:'ParserFlags lineNumberInfo: ' , (ParserFlags lineNumberInfo storeString) , '.';

          nextPutLine:'Compiler foldConstants: ' , (Compiler foldConstants storeString) , '.';

          nextPutLine:'ParserFlags stcCompilation: ' , (ParserFlags stcCompilation storeString) , '.';

          nextPutLine:'OperatingSystem getOSType = ' , (OperatingSystem getOSType storeString) , ' ifTrue:[';

          nextPutLine:'  ParserFlags stcCompilationIncludes: ' , (ParserFlags stcCompilationIncludes storeString) , '.';

          nextPutLine:'  ParserFlags stcCompilationDefines: ' , (ParserFlags stcCompilationDefines storeString) , '.';

          nextPutLine:'  ParserFlags stcCompilationOptions: ' , (ParserFlags stcCompilationOptions storeString) , '.';

          nextPutLine:'  ' , (ParserFlags stcModulePath storeString) , ' asFilename exists ifTrue:[';

          nextPutLine:'    ParserFlags stcModulePath: ' , (ParserFlags stcModulePath storeString) , '.';

          nextPutLine:'  ].';

          nextPutLine:'  ParserFlags stcPath: ' , (ParserFlags stcPath storeString) , '.';

          nextPutLine:'  ParserFlags ccCompilationOptions: ' , (ParserFlags ccCompilationOptions storeString) , '.';

          nextPutLine:'  ParserFlags ccPath: ' , (ParserFlags ccPath storeString) , '.';

          nextPutLine:'  ParserFlags linkArgs: ' , (ParserFlags linkArgs storeString) , '.';

          nextPutLine:'  ParserFlags linkSharedArgs: ' , (ParserFlags linkSharedArgs storeString) , '.';

          nextPutLine:'  ParserFlags linkCommand: ' , (ParserFlags linkCommand storeString) , '.';

          nextPutLine:'  ParserFlags makeCommand: ' , (ParserFlags makeCommand storeString) , '.';

          nextPutLine:'  ParserFlags libPath: ' , (ParserFlags libPath storeString) , '.';

          nextPutLine:'  ParserFlags searchedLibraries: ' , (ParserFlags searchedLibraries storeString) , '.';

          nextPutLine:'].';

          nextPutLine:'ObjectMemory justInTimeCompilation: ' , (ObjectMemory justInTimeCompilation storeString) , '.';

          nextPutLine:'ObjectMemory fullSingleStepSupport: ' , (ObjectMemory fullSingleStepSupport storeString) , '.'.

        HistoryManager notNil ifTrue:[

            HistoryManager isActive ifTrue:[

                s nextPutLine:'HistoryManager notNil ifTrue:[HistoryManager activate].'.

                s nextPutLine:'HistoryManager notNil ifTrue:[HistoryManager fullHistoryUpdate:' , HistoryManager fullHistoryUpdate storeString , '].'.

            ] ifFalse:[

                s nextPutLine:'HistoryManager notNil ifTrue:[HistoryManager deactivate].'.

            ].

        ].

        s nextPutLine:'Class catchMethodRedefinitions: ' , (Class catchMethodRedefinitions storeString) , '.'.

        s nextPutLine:'ClassCategoryReader sourceMode: ' , (ClassCategoryReader sourceMode storeString) , '.'.

        s cr.

        s nextPutLine:'"/'.

        s nextPutLine:'"/ Info & Debug Messages:'.

        s nextPutLine:'"/'.

        s nextPutLine:'Smalltalk hasNoConsole ifFalse:[ ObjectMemory infoPrinting: ' , (ObjectMemory infoPrinting storeString) , '].';

          nextPutLine:'ObjectMemory debugPrinting: ' , (ObjectMemory debugPrinting storeString) , '.';

          nextPutLine:'Smalltalk hasNoConsole ifFalse:[ Object infoPrinting: ' , (Object infoPrinting storeString) , '].';

          nextPutLine:'DeviceWorkstation errorPrinting: ' , (DeviceWorkstation errorPrinting storeString) , '.'.

    "/    FlyByHelp isActive ifTrue:[

    "/        s nextPutLine:'FlyByHelp start.'

    "/    ].

        s cr.

        s nextPutLine:'"/'.

        s nextPutLine:'"/ Edit settings:'.

        s nextPutLine:'"/'.

        "/ s nextPutLine:'EditTextView st80Mode: ' , (EditTextView st80Mode storeString) , '.'.

        "/ s nextPutLine:'TextView st80SelectMode: ' , (TextView st80SelectMode storeString) , '.'.

        s nextPutLine:'UserPreferences current syntaxColoring: ' , (userPrefs syntaxColoring storeString) , '.'.

        (ListView userDefaultTabPositions = ListView tab4Positions) ifTrue:[

            s nextPutLine:'ListView userDefaultTabPositions:(ListView tab4Positions).'.

        ] ifFalse:[

            s nextPutLine:'ListView userDefaultTabPositions:(ListView tab8Positions).'.

        ].

        s nextPutLine:'"/'.

        s nextPutLine:'"/ User preference values:'.

        s nextPutLine:'"/'.

        userPrefs keysAndValuesDo:[:k :v |

            |putSelector|

            putSelector := (k , ':') asSymbolIfInterned.

            (UserPreferences includesSelector:putSelector) ifTrue:[

                s nextPutAll:'UserPreferences current ';

                  nextPutAll:putSelector.

            ] ifFalse:[

                s nextPutAll:'UserPreferences current at:'.

                k storeOn:s.

                s nextPutAll:' put:'.

            ].

            v storeOn:s.

            s nextPut:$.; cr.

        ].

        s cr.

        s nextPutLine:'"/'.

        s nextPutLine:'"/ GC settings:'.

        s nextPutLine:'"/'.

        s nextPutLine:'ObjectMemory newSpaceSize: ' , (ObjectMemory newSpaceSize storeString) , '.';

          nextPutLine:'ObjectMemory dynamicCodeGCTrigger: ' , (ObjectMemory dynamicCodeGCTrigger storeString) , '.';

          nextPutLine:'ObjectMemory freeSpaceGCAmount: ' , (ObjectMemory freeSpaceGCAmount storeString) , '.';

          nextPutLine:'ObjectMemory freeSpaceGCLimit: ' , (ObjectMemory freeSpaceGCLimit storeString) , '.';

          nextPutLine:'ObjectMemory incrementalGCLimit: ' , (ObjectMemory incrementalGCLimit storeString) , '.';

          nextPutLine:'ObjectMemory oldSpaceCompressLimit: ' , (ObjectMemory oldSpaceCompressLimit storeString) , '.';

          nextPutLine:'ObjectMemory oldSpaceIncrement: ' , (ObjectMemory oldSpaceIncrement storeString) , '.'.

        s cr.

        s nextPutLine:'"/'.

        s nextPutLine:'"/ Misc settings:'.

        s nextPutLine:'"/'.

        s nextPutLine:'Class keepMethodHistory: ' , (Class methodHistory notNil storeString) , '.';

          nextPutLine:'Smalltalk logDoits: ' , (Smalltalk logDoits storeString) , '.';

          nextPutLine:'Autoload compileLazy: ' , (Autoload compileLazy storeString) , '.';

          nextPutLine:'Smalltalk loadBinaries: ' , (Smalltalk loadBinaries storeString) , '.';

          nextPutLine:'StandardSystemView includeHostNameInLabel: ' , (StandardSystemView includeHostNameInLabel storeString) , '.';

          "/ claus - I dont think its a good idea to save those ...

    "/      nextPutLine:'"/ Class updateChanges: ' , (Class updatingChanges storeString) , '.';

    "/      nextPutLine:'"/ ObjectMemory nameForChanges: ' , (ObjectMemory nameForChanges storeString) , '.';

          nextPutLine:'StandardSystemView returnFocusWhenClosingModalBoxes: ' , (StandardSystemView returnFocusWhenClosingModalBoxes storeString) , '.';

          nextPutLine:'StandardSystemView takeFocusWhenMapped: ' , (StandardSystemView takeFocusWhenMapped storeString) , '.';

          nextPutLine:'Display notNil ifTrue:[';