"

 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' }"

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.

    (which are currently spread over the system).

    For now, only a few preferences are found here - but this

    will change over time.

    UserPreferences current at:#foo

"

! !

!UserPreferences class methodsFor:'initialization'!

initializeDefaultPreferences

    DefaultPreferences := self new.

    #(

        #useNewChangesBrowser           false

        #useNewInspector                false

        #autoFormatting                 false

        #syntaxColoring                 true

        #fullSelectorCheck              false

        #defaultSyntaxColor             (Color black)

        #defaultSyntaxEmphasis          normal

        #errorColor                     (Color red)

        #commentColor                   (Color 12.5 12.5 100)

        #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)

        #constantColor                  (Color 25 0 0)

        #showClockInLauncher            true

     ) 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: / 4.2.2000 / 20:06:53 / cg"

! !

!UserPreferences class methodsFor:'accessing'!

current

    CurrentPreferences isNil ifTrue:[

	CurrentPreferences := self new.

	CurrentPreferences declareAllFrom:(self default).

    ].

    ^ CurrentPreferences.

    "Created: / 31.3.1998 / 13:43:03 / cg"

!

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

	commentColor

	  commentEmphasis

	defaultSyntaxColor

	  defaultSyntaxEmphasis

	errorColor

	globalIdentifierColor

	  globalIdentifierEmphasis

	globalClassIdentifierColor

	  globalClassIdentifierEmphasis

	hereColor

	  hereEmphasis

	identifierColor

	  identifierEmphasis

	instVarIdentifierColor

	  instVarIdentifierEmphasis

	localIdentifierColor

	  localIdentifierEmphasis

	methodSelectorColor

	  methodSelectorEmphasis

	returnColor

	  returnEmphasis

	selectorColor

	  selectorEmphasis

	selfColor

	  selfEmphasis

	stringColor

	  stringEmphasis

	superColor

	  superEmphasis

	symbolColor

	  symbolEmphasis

	thisContextColor

	  thisContextEmphasis

	unknownIdentifierColor

	  unknownIdentifierEmphasis

	unimplementedSelectorColor

	  unimplementedSelectorEmphasis

    )

    "Modified: / 5.1.1980 / 00:48:09 / 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'

'Constant Color'

'Comment Color'

'Global Identifier Color'

'Global Class Identifier Color'

'Here Color'

'Identifier Color'

'InstVar Identifier Color'

'Local Identifier Color'

'Method Selector Color'

'Return Color'

'Selector Color'

'Self Color'

'String Color'

'Super Color'

'Symbol Color'

'This Context Color'

'Unknown Identifier Color'

'Unimplemented Selector Color'

)

    "Modified: / 5.1.1980 / 00:48:09 / cg"

! !

!UserPreferences class methodsFor:'accessing defaultPrefs'!

fileBrowserClass

    ^ self current fileBrowserClass

    "

     UserPreferences fileBrowserClass

    "

!

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"

    |s screen|

    s := fileName asFilename writeStream.

    s checkNilFileStream.

    screen := Screen current.

    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:'"/ Compiler settings:'.

    s nextPutLine:'"/'.

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

      nextPutLine:'  ].';

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

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

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

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

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

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

      nextPutLine:'  ObjectFileLoader searchedLibraries: ' , (ObjectFileLoader 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].'.

        ].

    ].

    ObjectFileLoader notNil ifTrue:[

        s nextPutLine:'ObjectFileLoader searchedLibraries: ' , (ObjectFileLoader searchedLibraries storeString) , '.'.

        s nextPutLine:'ObjectFileLoader libPath: ' , (ObjectFileLoader libPath storeString) , '.'.

    ].

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

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

    s cr.

    s nextPutLine:'"/'.

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

    s nextPutLine:'"/'.

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

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

      nextPutLine:'Object infoPrinting: ' , (Object infoPrinting storeString) , '.';

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

    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 |

        (UserPreferences includesSelector:(k , ':') asSymbol) ifTrue:[

            s nextPutLine:'UserPreferences current ' , k , ':' , v storeString , '.'.

        ] ifFalse:[

            s nextPutLine:'UserPreferences current at:' , k storeString , ' put:' , v 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:[';

      nextPutLine:' Display activateOnClick: ' , ((screen activateOnClick:nil) storeString) , '.';

      nextPutLine:'].';

      nextPutLine:'MenuView showAcceleratorKeys: ' , (MenuView showAcceleratorKeys storeString) , '.';

      nextPutLine:'Class tryLocalSourceFirst: ' , (Class tryLocalSourceFirst storeString) , '.'.

    (NoHandlerError emergencyHandler == AbstractLauncherApplication notifyingEmergencyHandler) ifTrue:[

        s nextPutLine:'NoHandlerError emergencyHandler:(AbstractLauncherApplication notifyingEmergencyHandler).'.

    ].

    Processor isTimeSlicing ifTrue:[

        s nextPutLine:'Processor startTimeSlicing.'.

        s nextPutLine:('Processor supportDynamicPriorities:' , (Processor supportDynamicPriorities ? false) storeString , '.').

    ] ifFalse:[

        s nextPutLine:'Processor stopTimeSlicing.'.

    ].

    s cr.

    s nextPutLine:'"/'.

    s nextPutLine:'"/ Printer settings:'.

    s nextPutLine:'"/'.

    s nextPutLine:'Printer := ' , (Printer name) , '.';

      nextPutLine:'Printer printCommand: ' , (Printer printCommand storeString) , '.'.

    Printer supportsPageSizes ifTrue:[

        s nextPutLine:'Printer pageFormat: ' , (Printer pageFormat storeString) , '.'.

        s nextPutLine:'Printer landscape: ' , (Printer landscape storeString) , '.'.

    ].

    Printer supportsMargins ifTrue:[

        s nextPutLine:'Printer topMargin: ' , (Printer topMargin storeString) , '.'.

        s nextPutLine:'Printer leftMargin: ' , (Printer leftMargin storeString) , '.'.

        s nextPutLine:'Printer rightMargin: ' , (Printer rightMargin storeString) , '.'.

        s nextPutLine:'Printer bottomMargin: ' , (Printer bottomMargin storeString) , '.'.

    ].

    Printer supportsPostscript ifTrue:[

        s nextPutLine:'Printer supportsColor: ' , (Printer supportsColor storeString) , '.'.

    ].

    s cr.

    s nextPutLine:'"/'.

    s nextPutLine:'"/ Font settings:'.

    s nextPutLine:'"/ (only restored, if image is restarted on the same display)'.

    s nextPutLine:'"/'.

    s nextPutLine:'Display notNil ifTrue:['.

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

    s nextPutLine:'  View defaultFont: ' , (View defaultFont storeString) , '.'.

    s nextPutLine:'  Label defaultFont: ' , (Label defaultFont storeString) , '.'.

    s nextPutLine:'  Button defaultFont: ' , (Button defaultFont storeString) , '.'.

    s nextPutLine:'  Toggle defaultFont: ' , (Toggle defaultFont storeString) , '.'.

    s nextPutLine:'  SelectionInListView defaultFont: ' , (SelectionInListView defaultFont storeString) , '.'.

    s nextPutLine:'  MenuView defaultFont: ' , (MenuView defaultFont storeString) , '.'.

    s nextPutLine:'  MenuPanel defaultFont: ' , (MenuPanel defaultFont storeString) , '.'.

    s nextPutLine:'  NoteBookView defaultFont: ' , (NoteBookView defaultFont storeString) , '.'.

    s nextPutLine:'  PullDownMenu defaultFont: ' , (PullDownMenu defaultFont storeString) , '.'.

    s nextPutLine:'  TextView defaultFont: ' , (TextView defaultFont storeString) , '.'.

    s nextPutLine:'  EditTextView defaultFont: ' , (EditTextView defaultFont storeString) , '.'.

    s nextPutLine:'  CodeView defaultFont: ' , (CodeView defaultFont storeString) , '.'.

    s nextPutLine:' ].'.

    s nextPutLine:'].'.

    s cr.

    s nextPutLine:'"/'.

    s nextPutLine:'"/ Language setting:'.

    s nextPutLine:'"/'.

    s nextPutLine:'"/ Notice:'.

    s nextPutLine:'"/   Language should be taken from the Environment Variable LANG'.

    s nextPutLine:'"/   To use the previous seting, uncomment the following:'.

    s nextPutLine:'"/ Smalltalk language: ' , (Smalltalk language storeString) , '.'.

    s nextPutLine:'"/ Smalltalk languageTerritory: ' , (Smalltalk languageTerritory storeString) , '.'.

    s cr.

    s nextPutLine:'"/'.

    s nextPutLine:'"/ SourceCodeManager settings:'.

    s nextPutLine:'"/ (only restored, if image is restarted on the same host)'.

    s nextPutLine:'"/'.

    s nextPutLine:'OperatingSystem getHostName = ' , (OperatingSystem getHostName storeString) , ' ifTrue:['.

    s nextPutLine:'  Class tryLocalSourceFirst:' , Class tryLocalSourceFirst storeString , '.'.

    (Smalltalk at:#SourceCodeManager) == CVSSourceCodeManager ifTrue:[

    s nextPutLine:'  Smalltalk at:#SourceCodeManager put: CVSSourceCodeManager.'.

    s nextPutLine:'  AbstractSourceCodeManager cacheDirectoryName:' , AbstractSourceCodeManager cacheDirectoryName storeString , '.'.

    s nextPutLine:'  CVSSourceCodeManager cvsBinDirectory:' , CVSSourceCodeManager cvsBinDirectory storeString , '.'.

    s nextPutLine:'  CVSSourceCodeManager repositoryNamesPerModule:' , CVSSourceCodeManager repositoryNamesPerModule storeString , '.'.

    s nextPutLine:'  CVSSourceCodeManager initializeForRepository:' , CVSSourceCodeManager repositoryName storeString , '.'.

    ].

    s nextPutLine:'].'.

    s close.