"      NAME     Syntax-Color-Editor
       AUTHOR   bert@isg.cs.uni-magdeburg.de
       URL     	http://www.cs.uni-magdeburg.de/~bert/smalltalk.html
       FUNCTION Dialog for creating own colorschemes
       ST-VERSIONS      VisualWorks 2.5
       PREREQUISITES    Syntax-Highlighting.st
       CONFLICTS        (none known)
       DISTRIBUTION     world
       VERSION  1.0
       DATE     15-Nov-96

SUMMARY
A Dialog for interactively creating an own color scheme
of syntax highlighting colors.
                                Bert Schoenwaelder
"!

"Test if SyntaxHighlighting was filed in"
(Text respondsTo: #coloringAttributes) ifFalse: [
	self halt: 'Warning!! This package needs "Syntax-Highlighting.st" to work']!

!HostGraphicsDevice methodsFor: 'private - allocating resources'!

fontNamed: aName fromClass: fontClass encoding: encoding

	"Modified: work around a bug"
	"The keys in openFonts are Strings but are searched by identity.
	So same fonts were not recognized, and allocated over and over again."

	| font |
	font := openFonts at: aName ifAbsent: [ | key |
		"Inserted: look for aName again using ="
		key := openFonts keys detect: [:n | n = aName] ifNone: [].
		key == nil ifFalse: [openFonts at: key]].
	font == nil ifFalse: [^font].
	font := fontClass new.
	font name: aName.
	font initializeFrom: (self allocateFontNamed: aName).
	font setEncoder: encoding.
	openFonts at: aName put: font.
	^font! !

ApplicationModel subclass: #SyntaxColorEditor
	instanceVariableNames: 'current attributes clip update elementList categoryList syntaxView anInstanceVariable holders '
	classVariableNames: 'AClassVariable '
	poolDictionaries: ''
	category: 'Syntax-Highlighting'!
SyntaxColorEditor comment:
'Dialog for specifying the colors in the syntax highlighting package.

Bert Schönwälder, 1995-96
mailto:bert@cs.uni-magdeburg.de
http://www.cs.uni-magdeburg.de/~bert'!

!SyntaxColorEditor methodsFor: 'initialize-release'!

initialize
	current := nil.
	update := false.
	self readAttributes.

	categoryList := SelectionInList with: (Text coloringAttributesOrganization collect: [:cat | cat at: 1]).
	categoryList selectionIndexHolder onChangeSend: #categoryChanged to: self.
	elementList := SelectionInList new.
	elementList selectionIndexHolder onChangeSend: #elementChanged to: self.
	holders := Dictionary new.
	#((highlight bold italic color) (red green blue hue saturation brightness)) with: #(false 0) do: [:items :value | items do: [:item |
		| vh |
		vh := ValueHolder with: value.
		vh onChangeSend: (item, #Changed) asSymbol to: self.
		holders at: item put: vh]].
	syntaxView := ComposedTextView new editText: self coloredExample.
	syntaxView controller: NoController new.
	categoryList selectionIndex: 1! !

!SyntaxColorEditor methodsFor: 'aspects'!

blue
	^holders at: #blue!

bold
	^holders at: #bold!

brightness
	^holders at: #brightness!

categoryList
	^categoryList!

color
	^holders at: #color!

elementList
	^elementList!

elementMenu

	^[Menu menuItems: (Array
		with: ((MenuItem labeled: 'copy') 
			value: [clip := (attributes at: current) copy];
			enabled: current notNil)
		with: ((MenuItem labeled: 'paste') 
			value: [attributes at: current put: clip copy.
				self elementChanged.
				self showSyntaxSmart: false]; 
			enabled: current notNil & clip notNil)
		)]!

green
	^holders at: #green!

highlight
	^holders at: #highlight!

hue
	^holders at: #hue!

italic
	^holders at: #italic!

red
	^holders at: #red!

saturation
	^holders at: #saturation!

syntaxView
	^syntaxView! !

!SyntaxColorEditor methodsFor: 'changing'!

blueChanged

	self setSliderColor: #blue to: (ColorValue red: 0 green: 0 blue: (holders at: #blue) value * 0.3 + 0.7).
	self changeAttribute: #blue!

boldChanged

	self changeAttribute: #bold!

brightnessChanged

	self setSliderColor: #brightness to: (ColorValue brightness: (holders at: #brightness) value * 0.5 + 0.5).
	self changeAttribute: #brightness!

categoryChanged

	| category elements |
	category := categoryList selectionIndex.
	elements := #().
	category > 0 ifTrue: [
		elements := (Text coloringAttributesOrganization at: category) at: 2].
	elementList list: elements.!

colorChanged

	self widgets: #(red green blue redLabel greenLabel blueLabel
				hue saturation brightness hueLabel saturationLabel brightnessLabel) 
		enable: (holders at: #color) value & (holders at: #highlight) value.
	self changeAttribute: #color!

elementChanged

	update := false.
	current := elementList selection.
	current isNil 
		ifTrue: [self widgets: #(highlight color  bold italic
			red green blue redLabel greenLabel blueLabel
			hue saturation brightness hueLabel saturationLabel brightnessLabel) perform: #disable]
		ifFalse: [
			self widgets: #(highlight) enable: true.
			#(highlight color bold italic red green blue hue saturation brightness) do: [:item |
				(holders at: item) value: ((attributes at: current) at: item)].
		].
	update := true!

greenChanged

	self setSliderColor: #green to: (ColorValue red: 0 green: (holders at: #green) value * 0.6 + 0.4 blue: 0).
	self changeAttribute: #green!

highlightChanged

	self widgets: #(bold italic color)
		enable: (holders at: #highlight) value.
	(holders at: #color) value notNil ifTrue: [self colorChanged].
	self changeAttribute: #highlight!

hueChanged

	self setSliderColor: #hue to: (ColorValue hue: (holders at: #hue) value saturation: 1 brightness: 1).
	self changeAttribute: #hue.!

italicChanged

	self changeAttribute: #italic!

redChanged

	self setSliderColor: #red to: (ColorValue red: (holders at: #red) value * 0.5 + 0.5 green: 0 blue: 0).
	self changeAttribute: #red!

saturationChanged

	self setSliderColor: #saturation to: (ColorValue brightness: 1 - ((holders at: #saturation) value * 0.5)).
	self changeAttribute: #saturation! !

!SyntaxColorEditor methodsFor: 'example'!

exampleMethod: anArgument
	"This is a method comment"
	<primitive: 1234>
	| aTemporary |
	"Another comment"
	Transcript show: 'a String'.
	anInstanceVariable := AClassVariable + 1.234.
	#(a literal array), #aSymbol includes: $c.
	^true = anUndeclaredVariable.! !

!SyntaxColorEditor methodsFor: 'actions'!

apply

	self flushFonts.
	Text coloringAttributes: self newAttributes.!

cancel

	self flushFonts.
	self readAttributes.
	self elementChanged.
	self showSyntaxSmart: false! !

!SyntaxColorEditor methodsFor: 'widgets'!

setSliderColor: col to: aColorValue

	builder notNil ifTrue: [
		| w |
		w := builder componentAt: col.
		w spec colors setSelectionBackgroundColor: aColorValue.
		w displayOn: w graphicsContext.
	].!

widgets: anIDCollection enable: aBoolean

	self widgets: anIDCollection perform: (aBoolean ifTrue: [#enable] ifFalse: [#disable])!

widgets: anIDCollection perform: action

	self builder notNil ifTrue: [
		anIDCollection do: [:id | (builder componentAt: id) perform: action]]! !

!SyntaxColorEditor methodsFor: 'private'!

changeAttribute: attribute

	update ifTrue: [
		| rgb hsb |
		update := false.
		(attributes at: current) at: attribute put: (holders at: attribute) value.
		(rgb := #(red green blue) includes: attribute) ifTrue: [self fromRGB].
		(hsb := #(hue saturation brightness) includes: attribute) ifTrue: [self toRGB].
		update := true.
		self showSyntaxSmart: rgb | hsb.
	]!

changeRequest

	self flushFonts.
	^super changeRequest!

coloredExample

	| save example |
	save := Text coloringAttributes.
	Text coloringAttributes: self newAttributes.
	example := (self class sourceCodeAt: #exampleMethod:) asText 
		coloredMethodFor: self class.
	Text coloringAttributes: save.
	^example!

flushFonts

	"Discard all temporary fonts"
	Screen default defaultFontPolicy flushFonts.!

newAttributes
	| attrs |
	attrs := Dictionary new.
	attributes keysAndValuesDo: [:elem :attr |
		attrs at: elem put:
			((attr at: #highlight)
				ifTrue: [(#(bold italic) select: [:emph | attr at: emph]), 
						((attr at: #color) 
							ifTrue: [Array with: (#color->(ColorValue red: (attr at: #red) green: (attr at: #green) blue: (attr at: #blue)))] 
							ifFalse: [#()])]
				ifFalse: [nil])].
	^attrs!

readAttributes 

	attributes := Dictionary new. 
	Text coloringAttributes keysAndValuesDo: [:elem :attr | 
		| d hasAttr col |
		hasAttr := attr notNil.
		hasAttr ifTrue: [col := attr 
			detect: [:emph | (emph isKindOf: Association) and: [emph key == #color]] 
			ifNone:[]].
		(d := IdentityDictionary new)
			at: #highlight put: hasAttr;
			at: #bold put: (hasAttr and: [attr includes: #bold]);
			at: #italic put: (hasAttr and: [attr includes: #italic]);
			at: #color put: col notNil;
			at: #red put: (col notNil ifTrue: [col value red] ifFalse: [0]);
			at: #green put: (col notNil ifTrue: [col value green] ifFalse: [0]);
			at: #blue put: (col notNil ifTrue: [col value blue] ifFalse: [0]);
			at: #hue put: (col notNil ifTrue: [col value hue] ifFalse: [0]);
			at: #saturation put: (col notNil ifTrue: [col value saturation] ifFalse: [0]);
			at: #brightness put: (col notNil ifTrue: [col value brightness] ifFalse: [0]).
		attributes at: elem put: d.
	].!

showSyntaxSmart: smart

	syntaxView newText: " nil. "self coloredExample.
	smart
		ifTrue: [syntaxView displayOn: syntaxView graphicsContext]
		ifFalse:[syntaxView invalidate]! !

!SyntaxColorEditor methodsFor: 'converting'!

currentColor

	^ColorValue red: (holders at: #red) value green: (holders at: #green) value blue: (holders at: #blue) value!

fromRGB
	| col |
	col := self currentColor.
	#(hue saturation brightness) do: [ :item |
		| val |
		val := col perform: item.
		(holders at: item) value: val.
		(attributes at: current) at: item put: val.
	]!

toRGB
	| col |
	col := ColorValue 
		hue: (holders at: #hue) value 
		saturation: (holders at: #saturation) value 
		brightness: (holders at: #brightness) value.
	#(red green blue) do: [ :item |
		| val |
		val := col perform: item.
		(holders at: item) value: val.
		(attributes at: current) at: item put: val.
	]! !

!SyntaxColorEditor class methodsFor: 'interface specs'!

windowSpec
	"UIPainter new openOnClass: self andSelector: #windowSpec"

	<resource: #canvas>
	^#(#FullSpec 
		#window: 
		#(#WindowSpec 
			#label: 'Syntax Colors' 
			#min: #(#Point 458 295 ) 
			#max: #(#Point 640 480 ) 
			#bounds: #(#Rectangle 298 373 876 715 ) ) 
		#component: 
		#(#SpecCollection 
			#collection: #(
				#(#ArbitraryComponentSpec 
					#layout: #(#LayoutFrame 0 0 0 0.4 -238 1 0 1 ) 
					#name: #syntaxView 
					#flags: 9 
					#component: #syntaxView ) 
				#(#SequenceViewSpec 
					#layout: #(#LayoutFrame 110 0 0 0 -238 1 0 0.4 ) 
					#name: #elementList 
					#model: #elementList 
					#menu: #elementMenu 
					#useModifierKeys: true 
					#selectionType: #highlight ) 
				#(#CheckBoxSpec 
					#layout: #(#LayoutOrigin -210 1 258 0 ) 
					#name: #bold 
					#flags: 32 
					#model: #bold 
					#label: 'Bold' ) 
				#(#CheckBoxSpec 
					#layout: #(#LayoutOrigin -100 1 258 0 ) 
					#name: #italic 
					#flags: 32 
					#model: #italic 
					#label: 'Italic' ) 
				#(#SliderSpec 
					#layout: #(#LayoutFrame -198 1 64 0 -18 1 80 0 ) 
					#name: #red 
					#flags: 40 
					#colors: 
					#(#LookPreferences 
						#setSelectionBackgroundColor: #(#ColorValue 4292 0 0 ) ) 
					#model: #red 
					#orientation: #horizontal 
					#start: 0 
					#stop: 1 ) 
				#(#SliderSpec 
					#layout: #(#LayoutFrame -198 1 96 0 -18 1 112 0 ) 
					#name: #green 
					#flags: 40 
					#colors: 
					#(#LookPreferences 
						#setSelectionBackgroundColor: #(#ColorValue 0 2883 0 ) ) 
					#model: #green 
					#orientation: #horizontal 
					#start: 0 
					#stop: 1 ) 
				#(#SliderSpec 
					#layout: #(#LayoutFrame -198 1 128 0 -18 1 144 0 ) 
					#name: #blue 
					#flags: 40 
					#colors: 
					#(#LookPreferences 
						#setSelectionBackgroundColor: #(#ColorValue 0 0 5054 ) ) 
					#model: #blue 
					#orientation: #horizontal 
					#start: 0 
					#stop: 1 ) 
				#(#LabelSpec 
					#layout: #(#LayoutOrigin -220 1 60 0 ) 
					#name: #redLabel 
					#flags: 32 
					#label: 'R' ) 
				#(#LabelSpec 
					#layout: #(#LayoutOrigin -220 1 92 0 ) 
					#name: #greenLabel 
					#flags: 32 
					#label: 'G' ) 
				#(#LabelSpec 
					#layout: #(#LayoutOrigin -220 1 124 0 ) 
					#name: #blueLabel 
					#flags: 32 
					#label: 'B' ) 
				#(#GroupBoxSpec 
					#layout: #(#LayoutFrame -230 1 8 0 -8 1 288 0 ) ) 
				#(#CheckBoxSpec 
					#layout: #(#LayoutOrigin -210 1 20 0 ) 
					#name: #highlight 
					#flags: 32 
					#model: #highlight 
					#label: 'Highlight' ) 
				#(#ActionButtonSpec 
					#layout: #(#LayoutFrame -221 1 300 0 -131 1 332 0 ) 
					#name: #apply 
					#model: #apply 
					#label: 'Apply' 
					#isDefault: true 
					#defaultable: true ) 
				#(#CheckBoxSpec 
					#layout: #(#LayoutOrigin -108 1 20 0 ) 
					#name: #color 
					#flags: 32 
					#model: #color 
					#label: 'Use Color' ) 
				#(#SequenceViewSpec 
					#layout: #(#LayoutFrame 0 0 0 0 110 0 0 0.4 ) 
					#name: #categoryList 
					#model: #categoryList 
					#useModifierKeys: true 
					#selectionType: #highlight ) 
				#(#DividerSpec 
					#layout: #(#LayoutFrame -229 1 51 0 -120 1 55 0 ) 
					#flags: 32 ) 
				#(#SliderSpec 
					#layout: #(#LayoutFrame -198 1 160 0 -18 1 176 0 ) 
					#name: #hue 
					#flags: 40 
					#colors: 
					#(#LookPreferences 
						#setSelectionBackgroundColor: #(#ColorValue #red ) ) 
					#model: #hue 
					#orientation: #horizontal 
					#start: 0 
					#stop: 1 ) 
				#(#SliderSpec 
					#layout: #(#LayoutFrame -198 1 192 0 -18 1 208 0 ) 
					#name: #saturation 
					#flags: 40 
					#colors: 
					#(#LookPreferences 
						#setSelectionBackgroundColor: #(#ColorValue #white ) ) 
					#model: #saturation 
					#orientation: #horizontal 
					#start: 0 
					#stop: 1 ) 
				#(#SliderSpec 
					#layout: #(#LayoutFrame -198 1 224 0 -18 1 240 0 ) 
					#name: #brightness 
					#flags: 40 
					#colors: 
					#(#LookPreferences 
						#setSelectionBackgroundColor: #(#ColorValue 4038 4038 4038 ) ) 
					#model: #brightness 
					#orientation: #horizontal 
					#start: 0 
					#stop: 1 ) 
				#(#LabelSpec 
					#layout: #(#LayoutOrigin -220 1 156 0 ) 
					#name: #hueLabel 
					#flags: 32 
					#label: 'H' ) 
				#(#LabelSpec 
					#layout: #(#LayoutOrigin -220 1 188 0 ) 
					#name: #saturationLabel 
					#flags: 32 
					#label: 'S' ) 
				#(#LabelSpec 
					#layout: #(#LayoutOrigin -220 1 220 0 ) 
					#name: #brightnessLabel 
					#flags: 32 
					#label: 'V' ) 
				#(#DividerSpec 
					#layout: #(#LayoutFrame -229 1 252 0 -10 1 256 0 ) 
					#flags: 32 ) 
				#(#DividerSpec 
					#layout: #(#LayoutFrame -120 1 9 0 57 0.916666 51 0 ) 
					#flags: 32 
					#orientation: #vertical ) 
				#(#ActionButtonSpec 
					#layout: #(#LayoutFrame -110 1 300 0 -20 1 332 0 ) 
					#name: #cancel 
					#model: #cancel 
					#label: 'Cancel' 
					#defaultable: true ) ) ) )! !


Transcript cr; show: 'To start the editor, do: "SyntaxColorEditor open"'!