Newsgroups: comp.lang.smalltalk

Thanks for the example code, it works great. I have changed it a
little so that the menu gives more info about the type of font -eg
boldness, italics etc.

However, I have experienced some problems getting #bold, #italic,
#small etc working after I have selected a font. For example, when I
change fonts using the menu, all the text which was previously bold
becomes normal, as does small and italics.

Do you know what is causing this problem?


Below is are my additions to the previously submitted code.

#############################################################################

'From Objectworks\Smalltalk(R), Release 4.1 of 15 April 1992 on 4 September 1992 at 12:57:23 pm'!



!LauncherView class methodsFor: 'private'!

fontMenu

	| fontClass availableFonts fonts fontList index oldCursor |

	fontClass := Screen default preferredFontClass.
	availableFonts := Screen default listFontNames collect: [:fontName| fontClass parse: fontName].
	fonts:= availableFonts select: [:aFont | aFont pixelSize > 0 and: [aFont family notNil]].
	fontList  := fonts collect: [:aFont | self parseFontName: aFont name].
	(index := (PopUpMenu labelList: (Array with: fontList)) startUp) = 0 ifFalse: [
		oldCursor := Cursor currentCursor.
		Cursor currentCursor: (Cursor wait).
		TextAttributes setStyleToFont: (fonts at: index).
		Cursor currentCursor: oldCursor
	].! !


!LauncherView class methodsFor: 'private'!

parseFontName: aName

	"This implementation currently supports only the XLFD standard
	font naming convention, where font names have 14 or more fields,
	separated by the character $-"

	|    family s wname  stream  type width pixelSize |

	aName first = $- ifFalse: [
		^aName
	] ifTrue: [

		stream := aName readStream.
		stream skipThrough: $-.
		stream upTo: $-.		"foundry"
		family := stream upTo: $-.			"family"
		s := stream upTo: $-.				"weight name"
		wname := s asLowercase.
 		(stream peek = $-) ifFalse: [
			type := stream upTo: $- .
			type := type asLowercase.
		] ifTrue: [stream next].

		s := stream upTo: $-.				"setwidth"
		width := s asLowercase.
		stream skipThrough: $-.			"additional"
		pixelSize := (Number readFrom: stream).		"pixel size"
	].

	type isNil ifTrue: [type := ''].

	^ family , '-' , wname , '-' , type , '-'  , pixelSize printString.! !



!LauncherView class methodsFor: 'private'!

specialMenu
	"Answer a submenu of so-called special items"
	| keys subMenu |

	keys := 'change font to...\reset font\refresh windows\collect garbage\global GC\open project\exit project\save as...\publish as...' withCRs asText allBold.
	subMenu := PopUpMenu
			labels: keys
			lines: #(2 5 7)
			values: (Array new: 9).
	subMenu valueAt: 1 put: [self fontMenu].
	subMenu valueAt: 2 put: [TextAttributes setDefaultTo: #large. TextAttributes resetViews].
	subMenu valueAt: 3 put: [ScheduledControllers restore].
	subMenu valueAt: 4 put: [ObjectMemory verboseCompactingGC].
	subMenu valueAt: 5 put: [ObjectMemory verboseGlobalCompactingGC].
	subMenu valueAt: 6 put: [Project openViewOn: Project new].
	subMenu valueAt: 7 put: [Project current exit].
	subMenu valueAt: 8 put: [ObjectMemory saveDialogThenQuit: false].
	subMenu valueAt: 9 put: [ObjectMemory publishPermSpaceDialogThenQuit: false].

	^subMenu! !

!TextAttributes class methodsFor: 'constants'!

setStyleToFont: aFontDescription

	| cStyle tStyle characterSize |
	characterSize := aFontDescription pixelSize.
	cStyle := CharacterAttributes newWithDefaultAttributes.
	cStyle setDefaultQuery: aFontDescription copy.
	CharacterAttributes styleNamed: #selected put: cStyle.
	tStyle := TextAttributes new.
	tStyle setCharacterAttributes: cStyle.
	tStyle lineGrid: characterSize * 5 // 4; baseline: characterSize.
	TextAttributes styleNamed: #selected put: tStyle.
	
	self setDefaultTo: #selected; resetViews! !

LauncherView initialize.!
Comments: Gated by NETNEWS@AUVM.AMERICAN.EDU