'From Cuis 1.0 of 16 July 2009 [latest update: #228] on 27 July 2009 at 11:19:20 pm'!
!classDefinition: #TextStyle category: #'Graphics-Text'!
Object subclass: #TextStyle
	instanceVariableNames: 'font lineGrid baseline alignment firstIndent restIndent rightIndent tabsArray marginTabsArray leading name '
	classVariableNames: 'AvailableTextStyles DefaultTextStyle '
	poolDictionaries: ''
	category: 'Graphics-Text'!

!TextStyle commentStamp: '<historical>' prior: 0!
A TextStyle comprises the formatting information for composing and displaying a unit (usually a paragraph) of text.  Typically one makes a copy of a master TextStyle (such as TextStyle default), and then that copy may get altered in the process of editing.  Bad things can happen if you do not copy first.

Each of my instances consists of...
	font				The default font to use
	lineGrid			An integer; default line spacing for paragraphs
	baseline			An integer; default baseline (dist from line top to bottom of an 'a')
	alignment			An integer; text alignment, see TextStyle alignment:
	firstIndent			An integer; indent of first line in pixels
	restIndent			An integer; indent of remaining lines in pixels
	rightIndent		An integer; indent of right margin rel to section
	tabsArray			An array of integers giving tab offsets in pixels
	marginTabsArray	An array of margin tabs
	leading				An integer giving default vertical line separation

For a concrete example, look at TextStyle default copy inspect!


!Preferences class methodsFor: 'fonts' stamp: 'jmv 7/27/2009 17:45'!
setSystemFontTo: aFont
	"Establish the default text font and style"

	aFont ifNil: [^ self].
	StrikeFont default: aFont.
	TextStyle default: aFont textStyle! !


!StrikeFont methodsFor: 'derivatives - emphasis' stamp: 'jmv 7/27/2009 22:45'!
bold
	^self emphasized: 1! !

!StrikeFont methodsFor: 'derivatives - emphasis' stamp: 'jmv 7/27/2009 22:45'!
boldItalic
	^self emphasized: 3! !

!StrikeFont methodsFor: 'derivatives - emphasis' stamp: 'jmv 7/27/2009 22:45'!
italic
	^self emphasized: 2! !


!TextEditor methodsFor: 'attributes' stamp: 'jmv 7/27/2009 23:12'!
changeStyle
	"Let user change styles for the current text pane."
	| names reply style current menuList |

	current _ paragraph textStyle.
	names _ TextStyle availableTextStyleNames.
	menuList _ names collect: [ :styleName |
		styleName = current name
			ifTrue: [ '<on>', styleName ]
			ifFalse: [ '<off>', styleName ]].
	reply _ (SelectionMenu labelList: menuList lines: #() selections: names) startUp.
	reply ifNotNil: [
		(style _ TextStyle named: reply) ifNil: [Beeper beep. ^ true].
		paragraph textStyle: style copy.
		paragraph composeAll.
		self recomputeSelection].
	^ true! !


!SmalltalkEditor methodsFor: 'editing keys' stamp: 'jmv 7/27/2009 23:13'!
changeEmphasis: characterStream 
	"Change the emphasis of the current selection or prepare to accept characters with the change in emphasis. Emphasis change amounts to a font change.  Keeps typeahead."

	"control 0..9 -> 0..9"

	| keyCode attribute oldAttributes index thisSel colors extras |
	keyCode := ('0123456789-=' indexOf: sensor keyboard ifAbsent: [1]) - 1.
	oldAttributes := paragraph text attributesAt: self pointIndex
				forStyle: paragraph textStyle.
	thisSel := self selection.

	"Decipher keyCodes for Command 0-9..."
	"
	(keyCode between: 1 and: 5) 
		ifTrue: [attribute := TextFontChange fontNumber: keyCode].
	"
	keyCode = 6 
		ifTrue: 
			[colors := #(#black #magenta #red #yellow #green #blue #cyan #white).
			extras := #('Link to comment of class' 'Link to definition of class' 'Link to hierarchy of class' 'Link to method').
			index := (PopUpMenu 
						labelArray: colors , #('choose color...' 'Do it' 'Print it') , extras 
								, #('be a web URL link' 'Edit hidden info' 'Copy hidden info')
						lines: (Array with: colors size + 1)) startUp.
			index = 0 ifTrue: [^true].
			index <= colors size 
				ifTrue: [attribute := TextColor color: (Color perform: (colors at: index))]
				ifFalse: 
					[index := index - colors size - 1.	"Re-number!!!!!!"
					index = 0 ifTrue: [attribute := self chooseColor].
					index = 1 
						ifTrue: 
							[attribute := TextDoIt new.
							thisSel := attribute analyze: self selection asString].
					index = 2 
						ifTrue: 
							[attribute := TextPrintIt new.
							thisSel := attribute analyze: self selection asString].
					extras size = 0 & (index > 2) ifTrue: [index := index + 5].	"skip those"
					index = 3 
						ifTrue: 
							[attribute := TextLink new.
							thisSel := attribute analyze: self selection asString with: 'Comment'].
					index = 4 
						ifTrue: 
							[attribute := TextLink new.
							thisSel := attribute analyze: self selection asString with: 'Definition'].
					index = 5 
						ifTrue: 
							[attribute := TextLink new.
							thisSel := attribute analyze: self selection asString with: 'Hierarchy'].
					index = 6 
						ifTrue: 
							[attribute := TextLink new.
							thisSel := attribute analyze: self selection asString].
					index = 7 
						ifTrue: 
							[attribute := TextURL new.
							thisSel := attribute analyze: self selection asString].
					index = 8 
						ifTrue: 
							["Edit hidden info"

							thisSel := self hiddenInfo.	"includes selection"
							attribute := TextEmphasis normal].
					index = 9 
						ifTrue: 
							["Copy hidden info"

							self copyHiddenInfo.
							^true].	"no other action"
					thisSel ifNil: [^true]	"Could not figure out what to link to"]].
	(keyCode between: 7 and: 11) 
		ifTrue: 
			[sensor leftShiftDown 
				ifTrue: 
					[keyCode = 10 ifTrue: [attribute := TextKern kern: -1].
					keyCode = 11 ifTrue: [attribute := TextKern kern: 1]]
				ifFalse: 
					[attribute := TextEmphasis 
								perform: (#(#bold #italic #narrow #underlined #struckOut) at: keyCode - 6).
					oldAttributes 
						do: [:att | (att dominates: attribute) ifTrue: [attribute turnOff]]]].
	keyCode = 0 ifTrue: [attribute := TextEmphasis normal].
	beginTypeInBlock ~~ nil 
		ifTrue: 
			["only change emphasisHere while typing"

			self insertTypeAhead: characterStream.
			emphasisHere := Text addAttribute: attribute toArray: oldAttributes.
			^true].
	attribute ifNotNil: [
		self replaceSelectionWith: (thisSel asText addAttribute: attribute) ].
	^true! !


!TextStyle methodsFor: 'accessing' stamp: 'jmv 7/27/2009 22:53'!
name
	^name! !

!TextStyle methodsFor: 'accessing' stamp: 'jmv 7/27/2009 22:53'!
name: aString
	name _ aString! !

!TextStyle methodsFor: 'accessing' stamp: 'jmv 7/27/2009 22:58'!
printOn: aStream
	super printOn: aStream.
	aStream space; nextPutAll: self name! !


!TextStyle class methodsFor: 'instance creation' stamp: 'jmv 7/27/2009 22:58'!
withFont: aFont
	| textStyle |
	textStyle _ self new.
	textStyle name: aFont name; font: aFont.
	^textStyle! !

!TextStyle class methodsFor: 'instance accessing' stamp: 'jmv 7/27/2009 22:50'!
availableTextStyleNames
	"Answer the names of the known text styles, sorted in alphabetical order"
	"
	TextStyle availableTextStyleNames
	"
	^ AvailableTextStyles keys asArray sort! !

!TextStyle class methodsFor: 'instance accessing' stamp: 'jmv 7/27/2009 22:50'!
availableTextStyles

	"TextStyle availableTextStyles"
	^ AvailableTextStyles! !

!TextStyle class methodsFor: 'instance accessing' stamp: 'jmv 7/27/2009 23:01'!
default: aTextStyle
	"Answer the system default text style."
	
	aTextStyle name: 'Default'.
	DefaultTextStyle _ aTextStyle.
	self makeAvailable: DefaultTextStyle! !

!TextStyle class methodsFor: 'instance accessing' stamp: 'jmv 7/27/2009 22:54'!
makeAvailable: aTextStyle

	AvailableTextStyles at: aTextStyle name put: aTextStyle! !

!TextStyle class methodsFor: 'instance accessing' stamp: 'jmv 7/27/2009 22:54'!
named: aString

	^ AvailableTextStyles at: aString! !

!TextStyle class methodsFor: 'instance accessing' stamp: 'jmv 7/27/2009 22:56'!
removeNamed: aString

	AvailableTextStyles removeKey: aString! !

!TextStyle class methodsFor: 'examples' stamp: 'jmv 7/27/2009 23:02'!
createExamples
	"
	TextStyle createExamples
	"
	| dejaVu16 dejaVu14 dejaVu12 heading1 heading2 heading3 emphasized normal |

	dejaVu16 _ AbstractFont familyName: 'DejaVu' pointSize: 16.
	dejaVu14 _ AbstractFont familyName: 'DejaVu' pointSize: 16.
	dejaVu12 _ AbstractFont familyName: 'DejaVu' pointSize: 12.
	
	heading1 _ TextStyle withFont: dejaVu16.
	heading1 name: 'Heading 1'.
	heading1 centered.
	self makeAvailable: heading1.

	heading2 _ TextStyle withFont: dejaVu14 bold.
	heading2 name: 'Heading 2'.
	self makeAvailable: heading2.

	heading3 _ TextStyle withFont: dejaVu14 italic.
	heading3 name: 'Heading 3'.
	self makeAvailable: heading3.

	emphasized _ TextStyle withFont: dejaVu12 bold.
	emphasized name: 'Emphasized'.
	self makeAvailable: emphasized.
	
	normal _ TextStyle withFont: dejaVu12.
	normal name: 'Normal'.
	normal justified.
	self makeAvailable: normal.! !

TextStyle class removeSelector: #named:put:!

!TextStyle class reorganize!
('class initialization' initialize)
('constants' defaultMarginTabsArray defaultTab defaultTabsArray)
('instance creation' new withFont:)
('user interface' modalStyleSelectorWithTitle:)
('instance accessing' availableTextStyleNames availableTextStyles default default: makeAvailable: named: removeNamed:)
('examples' createExamples)
!

!classDefinition: #TextStyle category: #'Graphics-Text'!
Object subclass: #TextStyle
	instanceVariableNames: 'name font lineGrid baseline alignment firstIndent restIndent rightIndent tabsArray marginTabsArray leading'
	classVariableNames: 'AvailableTextStyles DefaultTextStyle'
	poolDictionaries: ''
	category: 'Graphics-Text'!

!TextStyle reorganize!
('accessing' alignment alignment: baseline baseline: centered firstIndent firstIndent: font font: justified leading leading: leftFlush lineGrid name name: printOn: restIndent restIndent: rightFlush rightIndent rightIndent:)
('tabs and margins' clearIndents leftMarginTabAt: nextTabXFrom:leftMargin:rightMargin: rightMarginTabAt: tabWidth)
('private' marginTabAt:side:)
('Disk I/O' veryDeepCopyWith:)
!


!StrikeFont reorganize!
('accessing' ascent ascentKern baseKern characterToGlyphMap characterToGlyphMap: derivativeFonts descent descentKern familyName fontNameWithPointSize glyphs height lineGrid maxAscii maxWidth minAscii name name: pointSize pointSize: setGlyphs: subscript superscript widthOf: xTable)
('testing' checkCharacter:)
('displaying' characters:in:displayAt:clippedBy:rule:fillColor: displayLine:at: displayString:on:from:to:at:kern: installOn:foregroundColor: widthOfString:from:to:)
('emphasis' bonk:with: derivativeFont:at: emphasis emphasis: emphasized: isSynthetic isSynthetic: makeBoldGlyphs makeCondensedGlyphs makeItalicGlyphs makeStruckOutGlyphs makeUnderlinedGlyphs releaseCachedState reset)
('Mac reader' fixKerning:)
('file in/out' printOn:)
('character shapes' alter:formBlock: characterForm:pixelValueAt:put: characterFormAt: characterFormAt:put: ensureCleanBold extendMaxAsciiTo: fillZeroWidthSlots fixOneWideChars makeCarriageReturnsWhite makeControlCharsVisible makeLfInvisible makeLfVisible makeTabInvisible makeTabVisible useLeftArrow useUnderscore widen:by:)
('copying' veryDeepCopyWith:)
('private' createCharacterToGlyphMap)
('building' buildFromForm:data:name: setGlyphsDepthAtMost: stripHighGlyphs)
('derivatives - emphasis' bold boldItalic italic)
!

