diff --git a/src/Morphic-Base/UITheme.class.st b/src/Morphic-Base/UITheme.class.st index 2c04058fb46..25e1f81bd51 100644 --- a/src/Morphic-Base/UITheme.class.st +++ b/src/Morphic-Base/UITheme.class.st @@ -89,11 +89,7 @@ UITheme class >> current: aUITheme [ SystemProgressMorph reset. "reset to use new fill styles" ScrollBarMorph initializeImagesCache. "reset to use new arrows" - self class environment - at: #SHPreferences - ifPresent: [ :shPreferences | - aUITheme shStyleTable - ifNotNil: [ :aName | shPreferences styleTableSelector: aName ] ]. + self class environment at: #SHPreferences ifPresent: [ :shPreferences | shPreferences themeChanged ]. self class environment at: #PolymorphSystemSettings ifPresent: [ :polymorphSystemSettings | polymorphSystemSettings desktopColor: aUITheme desktopColor ]. diff --git a/src/STON-Extensions/SHCustomStyleElement.extension.st b/src/STON-Extensions/SHCustomStyleElement.extension.st new file mode 100644 index 00000000000..f4166869b67 --- /dev/null +++ b/src/STON-Extensions/SHCustomStyleElement.extension.st @@ -0,0 +1,10 @@ +Extension { #name : 'SHCustomStyleElement' } + +{ #category : '*STON-Extensions' } +SHCustomStyleElement >> stonOn: stonWriter [ + + stonWriter writeMap: { + (#group -> group). + (#color -> self color). + (#emphasis -> self emphasis) } asDictionary +] diff --git a/src/Shout/SHCustomStyle.class.st b/src/Shout/SHCustomStyle.class.st new file mode 100644 index 00000000000..067573476cd --- /dev/null +++ b/src/Shout/SHCustomStyle.class.st @@ -0,0 +1,190 @@ +" +I store all the style information associated with 'Custom' style +" +Class { + #name : 'SHCustomStyle', + #superclass : 'Object', + #classInstVars : [ + 'groups' + ], + #category : 'Shout-Styling', + #package : 'Shout', + #tag : 'Styling' +} + +{ #category : 'accessing' } +SHCustomStyle class >> color: aColor forGroup: aGroupName [ + + (groups at: aGroupName) at: #color put: aColor. + SHPreferences customStyleChanged +] + +{ #category : 'accessing' } +SHCustomStyle class >> colorForGroup: groupName [ + + ^ (groups at: groupName) at: #color +] + +{ #category : 'class initialization' } +SHCustomStyle class >> copyFromCurrentStyle [ + + SHRBTextStyler styleTable do: [ :row | + | token | + token := row first. + groups + detect: [ :entry | token = (entry at: #tokens) first ] + ifFound: [ :entry | + | colorDesc emphasis | + colorDesc := row second. + emphasis := #normal. + row size >= 3 ifTrue: [ emphasis := row third ]. + (emphasis isKindOf: Symbol) ifFalse: [ + emphasis := (' ' join: emphasis) asSymbol ]. + entry at: #color put: (Color colorFrom: colorDesc). + entry at: #emphasis put: emphasis ] ]. + SettingBrowser refreshAllSettingBrowsers +] + +{ #category : 'private' } +SHCustomStyle class >> defaultColor [ + + ^ Color r: 0.0 g: 0.75 b: 1.0 +] + +{ #category : 'private' } +SHCustomStyle class >> defaultEmphasis [ + + ^ #normal +] + +{ #category : 'accessing' } +SHCustomStyle class >> emphasis: anEmphasis forGroup: aGroupName [ + + (groups at: aGroupName) at: #emphasis put: anEmphasis. + SHPreferences customStyleChanged +] + +{ #category : 'accessing' } +SHCustomStyle class >> emphasisForGroup: groupName [ + + ^ (groups at: groupName) at: #emphasis +] + +{ #category : 'private' } +SHCustomStyle class >> groupDefaults [ + + ^ Dictionary newFrom: { + (#default -> { + (#name -> #default). + (#tokens -> #( #default )). + (#label -> 'Default'). + (#description -> 'Default style') } asDictionary). + (#reservedWords -> { + (#name -> #reservedWords). + (#tokens -> #( #self #super #true #false #nil #thisContext )). + (#label -> 'Reserved words'). + (#description -> 'Reserved words of the Smalltalk language') } + asDictionary). + (#primitiveTypes -> { + (#name -> #primitiveTypes). + (#description -> 'Literal data'). + (#tokens -> #( #character #number #symbol #string )). + (#label -> 'Primitive types') } asDictionary). + (#selectorPatterns -> { + (#name -> #selectorPatterns). + (#tokens -> #( #patternSelector )). + (#label -> 'Selector Patterns'). + (#description -> 'Selector patterns in method pane') } + asDictionary). + (#messageSends -> { + (#name -> #messageSends). + (#tokens -> #( selector #incompleteSelector )). + (#label -> 'Message sends') } asDictionary). + (#args -> { + (#name -> #args). + (#label -> 'Parameters'). + (#description + -> 'Parameters in patterns, message sends, and blocks'). + (#tokens + -> #( #patternArg #blockPatternArg #blockArg #argument )) } + asDictionary). + (#variable -> { + (#name -> #variable). + (#label -> 'Variable'). + (#description -> 'Temporary variable'). + (#tokens + -> + #( #blockTempVar #blockPatternTempVar #tempVar #patternTempVar + #incompleteIdentifier )) } asDictionary). + (#instanceVar -> { + (#name -> #instanceVar). + (#label -> 'Instance/class variables'). + (#description -> 'References to instance and class variables'). + (#tokens -> #( #instVar #classVar )) } asDictionary). + (#globalVar -> { + (#name -> #globalVar). + (#label -> 'Global variables'). + (#description + -> 'References to global variables, including classes'). + (#tokens -> #( #globalVar #poolConstant )) } asDictionary). + (#comment -> { + (#name -> #comment). + (#label -> 'Comments'). + (#descripiton -> 'Comments in code pane'). + (#tokens -> #( #comment )) } asDictionary). + (#error -> { + (#name -> #error). + (#label -> 'Syntactic error'). + (#description -> 'Invalid and undefined code'). + (#tokens + -> #( #invalid #undefinedSelector #undefinedIdentifier )) } + asDictionary). + (#syntax -> { + (#name -> #syntax). + (#label -> 'Syntax'). + (#description -> 'Any other syntactic element'). + (#tokens + -> + #( #return #blockArgColon #parenthesis #parenthesis1 + #parenthesis2 #parenthesis3 #parenthesis4 #parenthesis5 + #parenthesis6 #parenthesis7 #block #block1 #block2 #block3 + #block4 #block5 #block6 #block7 #byteArrayStart + #byteArrayEnd #byteArrayStart1 #byteArrayEnd1 + #brace #brace1 #brace2 #brace3 #brace4 #brace5 #brace6 + #brace7 #cascadeSeparator #statementSeparator + #methodTempBar #blockTempBar #blockArgsBar )) } + asDictionary) } +] + +{ #category : 'accessing' } +SHCustomStyle class >> groups [ + + ^ groups ifNil: [ + self initialize. + groups ] +] + +{ #category : 'class initialization' } +SHCustomStyle class >> initialize [ + + groups := self groupDefaults. + groups do: [ :entry | + entry at: #color put: self defaultColor. + entry at: #emphasis put: self defaultEmphasis ]. +] + +{ #category : 'accessing' } +SHCustomStyle class >> styleTable [ + + ^ groups flatCollect: [ :entry | + (entry at: #tokens) collect: [ :token | + | emphasis | + emphasis := entry at: #emphasis. + (emphasis includes: Character space) ifTrue: [ + emphasis := (emphasis substrings: ' ') collect: [ :str | + str asSymbol ] ]. + { + token. + (entry at: #color). + emphasis } ] ] +] diff --git a/src/Shout/SHCustomStyleElement.class.st b/src/Shout/SHCustomStyleElement.class.st new file mode 100644 index 00000000000..e9914a7a824 --- /dev/null +++ b/src/Shout/SHCustomStyleElement.class.st @@ -0,0 +1,81 @@ +" +I am a style element of the custom style. + +I am just a proxy object for one of the groups stored in `SHCustomStyleSettings` +" +Class { + #name : 'SHCustomStyleElement', + #superclass : 'Object', + #instVars : [ + 'group' + ], + #category : 'Shout-Styling', + #package : 'Shout', + #tag : 'Styling' +} + +{ #category : 'accessing' } +SHCustomStyleElement class >> group: groupName [ + + ^ self basicNew + group: groupName; + yourself +] + +{ #category : 'instance creation' } +SHCustomStyleElement class >> new [ + "Please use #group: to create an instance" + self shouldNotImplement +] + +{ #category : 'settings' } +SHCustomStyleElement class >> settingInputWidgetForNode: aSettingNode [ + + | theme | + theme := UITheme builder. + ^ theme newRow: { + (theme + newColorChooserFor: aSettingNode realValue + getColor: #color + setColor: #color: + help: 'Choose token color'). + ((theme + newDropListFor: aSettingNode realValue + list: #( #bold #italic #normal #'bold italic' ) + getSelected: #emphasis + setSelected: #emphasis: + getEnabled: nil + useIndex: false + help: 'Choose token emphasis') + hResizing: #rigid; + width: 100) } +] + +{ #category : 'accessing' } +SHCustomStyleElement >> color [ + + ^ SHCustomStyle colorForGroup: group +] + +{ #category : 'accessing' } +SHCustomStyleElement >> color: aColor [ + + ^ SHCustomStyle color: aColor forGroup: group +] + +{ #category : 'accessing' } +SHCustomStyleElement >> emphasis [ + + ^ SHCustomStyle emphasisForGroup: group +] + +{ #category : 'accessing' } +SHCustomStyleElement >> emphasis: anEmphasis [ + + ^ SHCustomStyle emphasis: anEmphasis forGroup: group +] + +{ #category : 'accessing' } +SHCustomStyleElement >> group: aString [ + group := aString +] diff --git a/src/Shout/SHPreferences.class.st b/src/Shout/SHPreferences.class.st index 3ca5af6f727..25d04f5ba82 100644 --- a/src/Shout/SHPreferences.class.st +++ b/src/Shout/SHPreferences.class.st @@ -1,147 +1,55 @@ " -Preferences for Shout +I manage the settings for Shout. + +This includes: + - Turning syntax highlighting on / off + - Choosing a predefined style + - Editing the custom style table " Class { #name : 'SHPreferences', #superclass : 'Object', - #classVars : [ - 'CustomStyleTable', - 'Groups' - ], #classInstVars : [ - 'enabled' + 'enabled', + 'activeStyleTable', + 'syntaxHighlightingEnabled' ], #category : 'Shout-Styling', #package : 'Shout', #tag : 'Styling' } -{ #category : 'private' } -SHPreferences class >> applyStyle [ - | table | - - table := Groups values flatCollect: [:group | group styleForTable ]. - SHRBTextStyler styleTable: table -] - -{ #category : 'accessing - styles' } -SHPreferences class >> argsStyle [ - ^ Groups at: #args -] - -{ #category : 'accessing - styles' } -SHPreferences class >> argsStyle: aGroupStyle [ - ^ Groups at: #args put: aGroupStyle -] - -{ #category : 'accessing - styles' } -SHPreferences class >> commentStyle [ - ^ Groups at: #comment -] - -{ #category : 'accessing - styles' } -SHPreferences class >> commentStyle: aGroupStyle [ - ^ Groups at: #comment put: aGroupStyle -] - -{ #category : 'private' } -SHPreferences class >> customStyleTable [ - ^ CustomStyleTable -] - -{ #category : 'private' } -SHPreferences class >> customStyleTable: anArray [ - CustomStyleTable := anArray. - self initializeGroups -] - -{ #category : 'accessing - style defaults' } -SHPreferences class >> defaultArgsStyle [ - - ^ SHStyleElement - color: (Color r: 0.0 g: 0.0 b: 0.5004887585532747 alpha: 1.0) - tokens: #(#patternArg #blockPatternArg #blockArg #argument) -] - -{ #category : 'accessing - style defaults' } -SHPreferences class >> defaultBaseStyle [ - - ^ SHStyleElement - color: Color black - tokens: #(#default) -] - -{ #category : 'accessing - style defaults' } -SHPreferences class >> defaultCommentStyle [ - - ^ SHStyleElement - color: (Color r: 0.4203323558162268 g: 0.4203323558162268 b: 0.4203323558162268 alpha: 1.0) - tokens: #(#comment) -] - -{ #category : 'accessing - style defaults' } -SHPreferences class >> defaultErrorStyle [ - - ^ SHStyleElement - color: Color red - tokens: #(#invalid #undefinedSelector #undefinedIdentifier) -] - -{ #category : 'accessing - style defaults' } -SHPreferences class >> defaultGlobalVarStyle [ - - ^ SHStyleElement - color: (Color r: 0.0 g: 0.0 b: 0.5004887585532747 alpha: 1.0) - tokens: #(#globalVar #poolConstant) -] - -{ #category : 'accessing - style defaults' } -SHPreferences class >> defaultInstanceVarStyle [ - - ^ SHStyleElement - color: (Color r: 0.0 g: 0.0 b: 0.5004887585532747 alpha: 1.0) - tokens: #(#instVar #classVar) -] - -{ #category : 'accessing - style defaults' } -SHPreferences class >> defaultMessageSendsStyle [ - - ^ SHStyleElement color: Color black tokens: #(selector #incompleteSelector) -] - -{ #category : 'accessing - style defaults' } -SHPreferences class >> defaultPrimitiveTypesStyle [ - - ^ SHStyleElement - color: (Color r: 0.5004887585532747 g: 0.0 b: 0.0 alpha: 1.0) - tokens: #(#character #number #symbol #string) -] - -{ #category : 'accessing - style defaults' } -SHPreferences class >> defaultReservedWordsStyle [ +{ #category : 'accessing' } +SHPreferences class >> activeStyleTable [ - ^ SHStyleElement - color: (Color r: 0.0 g: 0.5004887585532747 b: 0.5004887585532747 alpha: 1.0) - tokens: #(#self #super #true #false #nil #thisContext) + ^ activeStyleTable ifNil: [ + activeStyleTable := 'Default'. + activeStyleTable ] ] -{ #category : 'accessing - style defaults' } -SHPreferences class >> defaultSelectorPatternsStyle [ +{ #category : 'accessing' } +SHPreferences class >> activeStyleTable: aStyleTableName [ - ^ SHStyleElement - emphasis: #bold - tokens: #(#patternSelector) + (self styleTableNames includes: aStyleTableName) ifFalse: [ + self error: 'Trying to activate unknown style table' ]. + (Pragma allNamed: #styleTable: in: SHRBTextStyler class) + detect: [ :pragma | (pragma argumentAt: 1) = aStyleTableName ] + ifFound: [ :pragma | + self styleTable: (SHRBTextStyler styleTableNamed: aStyleTableName) ] + ifNone: [ "ignore" ]. + 'Custom' = aStyleTableName ifTrue: [ + self styleTable: SHCustomStyle styleTable ]. + 'Default' = aStyleTableName ifTrue: [ + self styleTable: + (SHRBTextStyler perform: Smalltalk ui theme shStyleTableName) ]. + activeStyleTable := aStyleTableName ] -{ #category : 'accessing - styles' } -SHPreferences class >> defaultStyle [ - - ^ Groups at: #default -] +{ #category : 'updating' } +SHPreferences class >> customStyleChanged [ -{ #category : 'accessing - styles' } -SHPreferences class >> defaultStyle: aGroupStyle [ - ^ Groups at: #default put: aGroupStyle + activeStyleTable = 'Custom' ifTrue: [ + self styleTable: SHCustomStyle styleTable ] ] { #category : 'accessing - style defaults' } @@ -158,247 +66,108 @@ SHPreferences class >> defaultVariableStyle [ tokens: #(#blockTempVar #blockPatternTempVar #tempVar #patternTempVar #incompleteIdentifier) ] -{ #category : 'accessing' } -SHPreferences class >> enabled [ - ^ enabled - ifNil: [enabled := true] -] - -{ #category : 'accessing' } -SHPreferences class >> enabled: aBoolean [ - enabled := aBoolean -] - -{ #category : 'accessing - styles' } -SHPreferences class >> errorStyle [ - ^ Groups at: #error -] - -{ #category : 'accessing - styles' } -SHPreferences class >> errorStyle: aGroupStyle [ - ^ Groups at: #error put: aGroupStyle -] - -{ #category : 'accessing - styles' } -SHPreferences class >> globalVarStyle [ - ^ Groups at: #globalVar -] - -{ #category : 'accessing - styles' } -SHPreferences class >> globalVarStyle: aGroupStyle [ - ^ Groups at: #globalVar put: aGroupStyle -] - -{ #category : 'class initialization' } -SHPreferences class >> initialize [ - - self customStyleTable: SHRBTextStyler styleTable -] +{ #category : 'reflective operations' } +SHPreferences class >> doesNotUnderstand: aMessage [ + "Handles messages of the form #defaultStyle or #argumentStyle: " -{ #category : 'private - initialization' } -SHPreferences class >> initializeGroups [ - Groups := Dictionary new. - #(#default #(#default ) #reservedWords #(#self #super #true #false #nil #thisContext ) #primitiveTypes #(#character #number #symbol #string ) #selectorPatterns #(#patternSelector) #messageSends #(selector #incompleteSelector ) #args #(#patternArg #blockPatternArg #blockArg #argument ) #variable #(#blockTempVar #blockPatternTempVar #tempVar #patternTempVar #incompleteIdentifier ) #instanceVar #(#instVar #classVar ) #globalVar #(#globalVar #poolConstant ) #comment #(#comment ) #error #(#invalid #undefinedSelector #undefinedIdentifier ) #syntax #(#return #blockArgColon #parenthesis #parenthesis1 #parenthesis2 #parenthesis3 #parenthesis4 #parenthesis5 #parenthesis6 #parenthesis7 #block #block1 #block2 #block3 #block4 #block5 #block6 #block7 #byteArrayStart #byteArrayEnd #byteArrayStart1 #byteArrayEnd1 #brace #brace1 #brace2 #brace3 #brace4 #brace5 #brace6 #brace7 #cascadeSeparator #statementSeparator #methodTempBar #blockTempBar #blockArgsBar ) ) - pairsDo: [:gname :tokens | Groups - at: gname - put: (SHStyleElement withTokens: tokens)] + (aMessage selector endsWith: 'Style') ifTrue: [ + ^ SHCustomStyleElement group: + (aMessage selector withoutSuffix: 'Style') asSymbol ]. + (aMessage selector endsWith: 'Style:') ifTrue: [ + | style | + style := aMessage argument. + (SHCustomStyleElement group: (style at: #group)) + color: (style at: #color) ; + emphasis: (style at: #emphasis). + ^ self ]. + ^ super doesNotUnderstand: aMessage ] -{ #category : 'accessing - styles' } -SHPreferences class >> instanceVarStyle [ - ^ Groups at: #instanceVar -] - -{ #category : 'accessing - styles' } -SHPreferences class >> instanceVarStyle: aGroupStyle [ - ^ Groups at: #instanceVar put: aGroupStyle -] - -{ #category : 'accessing - styles' } -SHPreferences class >> messageSendsStyle [ - ^ Groups at: #messageSends -] - -{ #category : 'accessing - styles' } -SHPreferences class >> messageSendsStyle: aGroupStyle [ - ^ Groups at: #messageSends put: aGroupStyle -] - -{ #category : 'accessing - styles' } -SHPreferences class >> primitiveTypesStyle [ - ^ Groups at: #primitiveTypes -] - -{ #category : 'accessing - styles' } -SHPreferences class >> primitiveTypesStyle: aGroupStyle [ - ^ Groups at: #primitiveTypes put: aGroupStyle -] - -{ #category : 'accessing - styles' } -SHPreferences class >> reservedWordsStyle [ - ^ Groups at: #reservedWords -] - -{ #category : 'accessing - styles' } -SHPreferences class >> reservedWordsStyle: aGroupStyle [ - ^ Groups at: #reservedWords put: aGroupStyle -] - -{ #category : 'accessing - styles' } -SHPreferences class >> selectorPatternsStyle [ - ^ Groups at: #selectorPatterns -] +{ #category : 'accessing' } +SHPreferences class >> enabled [ -{ #category : 'accessing - styles' } -SHPreferences class >> selectorPatternsStyle: aGroupStyle [ - ^ Groups at: #selectorPatterns put: aGroupStyle + ^ syntaxHighlightingEnabled ifNil: [ ^ true ] ] -{ #category : 'settings' } -SHPreferences class >> setStyleTable: anArray [ +{ #category : 'accessing' } +SHPreferences class >> enabled: aBoolean [ - SHRBTextStyler styleTable: anArray + syntaxHighlightingEnabled := aBoolean. + self informUI ] -{ #category : 'settings' } -SHPreferences class >> setStyleTableNamed: aString [ - - self setStyleTable: (SHRBTextStyler styleTableNamed: aString) +{ #category : 'private' } +SHPreferences class >> informUI [ + "Update all editor panes using syntax highlighting" + self currentWorld themeChanged ] { #category : 'settings' } SHPreferences class >> settingsOn: aBuilder [ - - (aBuilder setting: #'Syntax Highlighting') - target: self; - "dialog: [ self styleTableRow ];" + + (aBuilder group: 'Syntax Highlighting') parentName: #codeBrowsing; - description: 'Syntax Highlighting As You Type: Enable syntax highlighting in browsers, debuggers and workspaces and set patterns style.'; - selector: #enabled; - default: true; + target: self; iconName: #smallConfiguration; + noOrdering; with: [ - (aBuilder pickOne: #styleTableSelector) - order: 0; - label: 'Syntax Highlight Table'; - domainValues: self styleTableAvailableStylesMethodsWithNames; - description: 'Syntax Highlight stylb;e table selection'. - (aBuilder setting: #selectorPatternsStyle) - label: 'Selector Patterns'; - default: self defaultSelectorPatternsStyle; - description: 'Selector patterns in method pane'. - (aBuilder setting: #errorStyle) - default: self defaultErrorStyle; - label: 'Syntactic error'; - description: 'Invalid and undefined code' . - (aBuilder setting: #argsStyle) - label: 'Parameters'; - default: self defaultArgsStyle; - description: 'Parameters in patterns, message sends, and blocks' . - (aBuilder setting: #commentStyle) - label: 'Comments'; - default: self defaultCommentStyle; - description: 'Comments in code pane' . - (aBuilder setting: #defaultBaseStyle) - label: 'Default' ; - default: self defaultStyle; - description: 'Default style' . - (aBuilder setting: #globalVarStyle) - label: 'Global variables' ; - default: self defaultGlobalVarStyle; - description: 'References to global variables, including classes' . - (aBuilder setting: #instanceVarStyle) - label: 'Instance/class variables' ; - default: self defaultInstanceVarStyle; - description: 'References to instance and class variables' . - (aBuilder setting: #messageSendsStyle) - default: self defaultMessageSendsStyle; - label: 'Message sends' ; - description: 'Message sends' . - (aBuilder setting: #primitiveTypesStyle) - label: 'Primitive types'; - default: self defaultPrimitiveTypesStyle; - description: 'Literal data' . - (aBuilder setting: #reservedWordsStyle) - label: 'Reserved words'; - default: self defaultReservedWordsStyle; - description: 'Reserved words of the Smalltalk language' . - (aBuilder setting: #syntaxStyle) - label: 'Syntax'; - default: self defaultSyntaxStyle; - description: 'Any other syntactic element' . - (aBuilder setting: #variableStyle) - label: 'Variable'; - default: self defaultVariableStyle; - description: 'Temporary variable'] -] - -{ #category : 'settings' } -SHPreferences class >> styleTableAvailableStyles [ - - ^ Pragma allNamed: #styleTable: in: SHRBTextStyler class -] - -{ #category : 'settings' } -SHPreferences class >> styleTableAvailableStylesMethodsWithNames [ - - ^ self styleTableAvailableStyles - collect: [ :eachPragma | (eachPragma argumentAt: 1) -> eachPragma methodSelector ] + (aBuilder setting: 'Enable Syntax Highlighting') + target: self; + default: true; + selector: #enabled; + description: + 'Syntax Highlighting As You Type: Enable syntax highlighting in browsers, debuggers and workspaces and set patterns style.'. + (aBuilder setting: #formatIncompleteIdentifiers) + target: SHRBTextStyler; + default: false; + label: 'Format Incomplete Identifiers'; + parentName: #'Syntax Highlighting'; + description: + 'If the code highlighter tryies to format incomplete identifiers and selectors or not. This is not recommended for big images, as it traverse all the image to get the information'. + (aBuilder pickOne: #activeStyleTable) + label: 'Predefined styles'; + target: self; + domainValues: self styleTableNames; + description: 'Choose between the different styles. Default changes according to the UI Theme and Custom can be modified by you.' ; + default: 'Default'. + (aBuilder group: #'Edit Custom Style') + description: 'Change the Custom style to your liking. You have to activate it for your changes to take effect.' ; + dialog: [ + Smalltalk ui theme + newButtonIn: self + for: SHCustomStyle + getState: nil + action: #copyFromCurrentStyle + arguments: nil + getEnabled: nil + label: 'Copy from current style' + help: + 'Initialize custom style to colors of the currently selected them' ]; + with: [ + SHCustomStyle groups keysAndValuesDo: [ :group :info | + (aBuilder setting: group , #Style) + target: self; + label: (info at: #label); + description: (info at: #description ifAbsent: [ '' ]) ] ] ] ] -{ #category : 'settings' } -SHPreferences class >> styleTableRow [ - | allStyles | - - allStyles := self styleTableAvailableStyles. - ^Smalltalk ui theme - newRowIn: self - for: ( - { Smalltalk ui theme buttonLabelForText: 'Predefined styles: ' translated }, - (allStyles collect: [ :eachPragma | - (Smalltalk ui theme - newButtonIn: self - for: self - getState: nil - action: #setStyleTableNamed: - arguments: { eachPragma argumentAt: 1 } - getEnabled: nil - getLabel: nil - help: ('Change style table to ', (eachPragma argumentAt: 1)) translated) - label: (eachPragma argumentAt: 1); - yourself ] )) -] - -{ #category : 'settings' } -SHPreferences class >> styleTableSelector [ - - ^ SHRBTextStyler styleTableSelector -] - -{ #category : 'settings' } -SHPreferences class >> styleTableSelector: aName [ +{ #category : 'private' } +SHPreferences class >> styleTable: anArray [ - SHRBTextStyler styleTableSelector: aName - + SHRBTextStyler styleTable: anArray. + self informUI ] -{ #category : 'accessing - styles' } -SHPreferences class >> syntaxStyle [ - ^ Groups at: #syntax -] +{ #category : 'accessing' } +SHPreferences class >> styleTableNames [ -{ #category : 'accessing - styles' } -SHPreferences class >> syntaxStyle: aGroupStyle [ - ^ Groups at: #syntax put: aGroupStyle + ^ { 'Custom'. 'Default' } + , ((Pragma allNamed: #styleTable: in: SHRBTextStyler class) collect: [:pragma | pragma argumentAt: 1]) ] -{ #category : 'accessing - styles' } -SHPreferences class >> variableStyle [ - ^ Groups at: #variable -] +{ #category : 'updating' } +SHPreferences class >> themeChanged [ -{ #category : 'accessing - styles' } -SHPreferences class >> variableStyle: aGroupStyle [ - ^ Groups at: #variable put: aGroupStyle + activeStyleTable = 'Default' ifTrue: [ self activeStyleTable: 'Default' ] ] diff --git a/src/Shout/SHRBTextStyler.class.st b/src/Shout/SHRBTextStyler.class.st index d33d1b531ca..ab814163cb2 100644 --- a/src/Shout/SHRBTextStyler.class.st +++ b/src/Shout/SHRBTextStyler.class.st @@ -45,7 +45,7 @@ SHRBTextStyler class >> attributeArrayForColor: colorOrNil backgroundColor: back stream nextPut: (TextEmphasis perform: emphasisSymbolOrArrayorNil) ] ifFalse: [ emphasisSymbolOrArrayorNil do: [ :each | - stream nextPut: (TextEmphasis perform: emphasisSymbolOrArrayorNil) ] ] ] ] + stream nextPut: (TextEmphasis perform: each) ] ] ] ] ] { #category : 'attributes' } @@ -414,19 +414,6 @@ SHRBTextStyler class >> resetTextAttributesCaches [ textAttributes := nil ] -{ #category : 'styles' } -SHRBTextStyler class >> settingsOn: aBuilder [ - - - (aBuilder setting: #formatIncompleteIdentifiers) - target: self; - default: false; - order: 1; - label: 'Format Incomplete Identifiers'; - parentName: #'Syntax Highlighting'; - description: 'If the code highlighter tryies to format incomplete identifiers and selectors or not. This is not recommended for big images, as it traverse all the image to get the information' -] - { #category : 'styles' } SHRBTextStyler class >> solarizedStyleTable [ "color can be a valid argument to Color class>>colorFrom: , or nil to diff --git a/src/Shout/SHStyleElement.class.st b/src/Shout/SHStyleElement.class.st deleted file mode 100644 index ffbc3369858..00000000000 --- a/src/Shout/SHStyleElement.class.st +++ /dev/null @@ -1,170 +0,0 @@ -" -A Shout style element -" -Class { - #name : 'SHStyleElement', - #superclass : 'Object', - #instVars : [ - 'tokens', - 'color', - 'emphasis' - ], - #category : 'Shout-Styling', - #package : 'Shout', - #tag : 'Styling' -} - -{ #category : 'instance creation api' } -SHStyleElement class >> color: aColor tokens: tokens [ - - ^ self new - basicColor: aColor tokens: tokens emphasis: nil; - yourself -] - -{ #category : 'instanceCreation' } -SHStyleElement class >> emphasis: anEmphasis tokens: someTokens [ - - ^ self new - basicColor: nil tokens: someTokens emphasis: anEmphasis; - yourself -] - -{ #category : 'settings' } -SHStyleElement class >> settingInputWidgetForNode: aSettingNode [ - | theme | - theme := UITheme builder. - ^ theme newRow: {theme - newColorChooserFor: aSettingNode realValue - getColor: #color - setColor: #color: - help: 'Choose token color'. (theme - newDropListFor: aSettingNode realValue - list: #(#bold #italic #normal 'bold italic' ) - getSelected: #emphasis - setSelected: #emphasis: - getEnabled: nil - useIndex: false - help: 'Choose token emphasis') hResizing: #rigid; - width: 100} -] - -{ #category : 'instance creation' } -SHStyleElement class >> tokens: aCollection [ - - ^ self new - basicColor: nil tokens: aCollection emphasis: nil; - yourself -] - -{ #category : 'instance creation' } -SHStyleElement class >> withTokens: aCollection [ - ^ self new tokens: aCollection; - yourself -] - -{ #category : 'comparing' } -SHStyleElement >> = otherObject [ - - ^ self species = otherObject species - and: [ tokens = otherObject tokens - and: - [ self color = otherObject color and: [ self emphasis = otherObject emphasis ] ] ] -] - -{ #category : 'accessing' } -SHStyleElement >> basicColor: aColor tokens: someTokens emphasis: anEmphasis [ - - color := aColor. - tokens := someTokens. - emphasis := anEmphasis -] - -{ #category : 'accessing' } -SHStyleElement >> color [ - ^ color - ifNil: [color := Color colorFrom: (SHPreferences customStyleTable - detect: [:e | self tokens first = e first]) second] -] - -{ #category : 'accessing' } -SHStyleElement >> color: anObject [ - color := anObject. - SHPreferences applyStyle -] - -{ #category : 'accessing' } -SHStyleElement >> emphasis [ - | style | - ^ emphasis - ifNil: [style := SHPreferences customStyleTable - detect: [:e | self tokens first = e first]. - style size > 2 - ifTrue: [emphasis := style third. - emphasis isSymbol - ifFalse: [emphasis := ' ' join: emphasis]. - emphasis] - ifFalse: [#normal]] -] - -{ #category : 'accessing' } -SHStyleElement >> emphasis: anObject [ - emphasis := anObject. - SHPreferences applyStyle -] - -{ #category : 'styling' } -SHStyleElement >> emphasisAsArray [ - ^ self emphasis = 'bold italic' - ifTrue: [#(#bold #italic )] - ifFalse: [self emphasis] -] - -{ #category : 'comparing' } -SHStyleElement >> hash [ - - ^ tokens hash -] - -{ #category : 'printing' } -SHStyleElement >> printOn: aStream [ - - super printOn: aStream. - color - ifNotNil: [ aStream - nextPutAll: ' color: '; - print: color - ]. - emphasis - ifNotNil: [ aStream - nextPutAll: ' emphasis: '; - print: emphasis - ]. - tokens - ifNotNil: [ aStream - nextPutAll: ' tokens: '; - print: tokens - ] -] - -{ #category : 'styling' } -SHStyleElement >> styleForTable [ - ^ self tokens - collect: [:token | - | style | - style := OrderedCollection with: token. - style add: self color. - self emphasis - ifNotNil: [style add: self emphasisAsArray]. - style asArray] -] - -{ #category : 'accessing' } -SHStyleElement >> tokens [ - ^ tokens -] - -{ #category : 'accessing' } -SHStyleElement >> tokens: anObject [ - tokens := anObject -]