[squeak-dev] The Trunk: Multilingual-nice.195.mcz

commits at source.squeak.org commits at source.squeak.org
Thu May 29 05:23:01 UTC 2014


Nicolas Cellier uploaded a new version of Multilingual to project The Trunk:
http://source.squeak.org/trunk/Multilingual-nice.195.mcz

==================== Summary ====================

Name: Multilingual-nice.195
Author: nice
Time: 29 May 2014, 7:22:08.663 am
UUID: 49e73ca2-cd51-45e8-b2c9-7836d3ebb0bc
Ancestors: Multilingual-fbs.194

Micro-simplify scanKernableMultibyteCharactersFrom:to:in:rightX: (one less temp var floatDestX, the flow was a bit too nested)
Protect charsetAt: against out of bounds encoding
Add an API to Unicode for handling codes (it's most of its job to handle codes as the name tells).

=============== Diff against Multilingual-fbs.194 ===============

Item was changed:
  ----- Method: CharacterScanner>>scanKernableMultibyteCharactersFrom:to:in:rightX: (in category '*Multilingual-Display') -----
  scanKernableMultibyteCharactersFrom: startIndex to: stopIndex in: sourceString rightX: rightX 
  "this is a scanning method for
  multibyte characters in a WideString
  a font that does do character-pair kerning via widthAndKernedWidthOfLeft:right:into:"
  
+ 	| ascii encoding nextDestX startEncoding widthAndKernedWidth nextChar atEndOfRun char |
- 	| ascii encoding nextDestX startEncoding floatDestX widthAndKernedWidth nextChar atEndOfRun char |
  	lastIndex := startIndex.
  	lastIndex > stopIndex ifTrue: [^self handleEndOfRunAt: stopIndex].
  	startEncoding := (sourceString at: startIndex) leadingChar.
- 	floatDestX := destX.
  	widthAndKernedWidth := Array new: 2.
  	atEndOfRun := false.
  	[lastIndex <= stopIndex] whileTrue: [
  		char := sourceString at: lastIndex.
  		encoding := char leadingChar.
  		encoding ~= startEncoding
  			ifTrue: [lastIndex := lastIndex - 1. ^#endOfRun].
  		ascii := char charCode.
  		(ascii < 256 and: [(stopConditions at: ascii + 1) ~~ nil])
  			ifTrue: [^ stopConditions at: ascii + 1].
  		nextChar := (lastIndex + 1 <= stopIndex) 
  			ifTrue:[sourceString at: lastIndex + 1]
  			ifFalse:[
  				atEndOfRun := true.
  				"if there is a next char in sourceString, then get the kern 
  				and store it in pendingKernX"
  				lastIndex + 1 <= sourceString size
  					ifTrue:[sourceString at: lastIndex + 1]
  					ifFalse:[	nil]].
  		font 
  			widthAndKernedWidthOfLeft: char 
  			right: nextChar
  			into: widthAndKernedWidth.
+ 		nextDestX := destX + (widthAndKernedWidth at: 1).
- 		nextDestX := floatDestX + (widthAndKernedWidth at: 1).
  		nextDestX > rightX ifTrue: [^#crossedX].
+ 		destX := atEndOfRun
+ 			ifTrue: [pendingKernX := (widthAndKernedWidth at: 2)
+ 							- (widthAndKernedWidth at: 1).
+ 				nextDestX + kern]
+ 			ifFalse: [destX + kern + (widthAndKernedWidth at: 2)].
- 		floatDestX := floatDestX + kern + (widthAndKernedWidth at: 2).
- 		atEndOfRun 
- 			ifTrue:[
- 				pendingKernX := (widthAndKernedWidth at: 2) - (widthAndKernedWidth at: 1).
- 				floatDestX := floatDestX - pendingKernX].
- 		destX := floatDestX .
  		lastIndex := lastIndex + 1.
  	].
  	^self handleEndOfRunAt: stopIndex!

Item was changed:
  ----- Method: EncodedCharSet class>>charsetAt: (in category 'class methods') -----
  charsetAt: encoding
  "Find  the char set encoding that matches 'encoding'; return a decent default rather than nil"
+ 	^ (EncodedCharSets at: encoding + 1 ifAbsent: [nil]) ifNil: [Unicode].!
- 	^ (EncodedCharSets at: encoding + 1) ifNil: [EncodedCharSets at: 1].
- !

Item was changed:
  ----- Method: Unicode class>>isDigit: (in category 'character classification') -----
  isDigit: char 
+ 	^self isDigitCode: char charCode!
- 	| value |
- 	value := char charCode.
- 	value > (GeneralCategory size - 1)
- 		ifTrue: [^ false].
- 	^ (GeneralCategory at: value + 1)
- 		= Nd!

Item was added:
+ ----- Method: Unicode class>>isDigitCode: (in category 'character classification') -----
+ isDigitCode: charCode 
+ 	charCode > (GeneralCategory size - 1)
+ 		ifTrue: [^ false].
+ 	^ (GeneralCategory at: charCode + 1)
+ 		= Nd!

Item was changed:
  ----- Method: Unicode class>>isLetter: (in category 'character classification') -----
  isLetter: char 
+ 	^self isLetterCode: char charCode!
- 	| value codeCat |
- 	value := char charCode.
- 	value > (GeneralCategory size - 1)
- 		ifTrue: [^ false].
- 	^ (codeCat := GeneralCategory at: value + 1) >= Ll
- 		and: [codeCat <= Lu]!

Item was added:
+ ----- Method: Unicode class>>isLetterCode: (in category 'character classification') -----
+ isLetterCode: charCode 
+ 	| codeCat |
+ 	charCode > (GeneralCategory size - 1)
+ 		ifTrue: [^ false].
+ 	^ (codeCat := GeneralCategory at: charCode + 1) >= Ll
+ 		and: [codeCat <= Lu]!

Item was changed:
  ----- Method: Unicode class>>isLowercase: (in category 'character classification') -----
  isLowercase: char 
+ 	^self isLowercaseCode: char charCode!
- 	| value |
- 	value := char charCode.
- 	value > (GeneralCategory size - 1)
- 		ifTrue: [^ false].
- 	^ (GeneralCategory at: value + 1)
- 		= Ll!

Item was added:
+ ----- Method: Unicode class>>isLowercaseCode: (in category 'character classification') -----
+ isLowercaseCode: charCode 
+ 	charCode > (GeneralCategory size - 1)
+ 		ifTrue: [^ false].
+ 	^ (GeneralCategory at: charCode + 1)
+ 		= Ll!

Item was changed:
  ----- Method: Unicode class>>isUppercase: (in category 'character classification') -----
  isUppercase: char 
+ 	^self isUppercaseCode: char charCode!
- 	| value |
- 	value := char charCode.
- 	value > (GeneralCategory size - 1)
- 		ifTrue: [^ false].
- 	^ (GeneralCategory at: value + 1)
- 		= Lu!

Item was added:
+ ----- Method: Unicode class>>isUppercaseCode: (in category 'character classification') -----
+ isUppercaseCode: charCode 
+ 	charCode > (GeneralCategory size - 1)
+ 		ifTrue: [^ false].
+ 	^ (GeneralCategory at: charCode + 1)
+ 		= Lu!

Item was changed:
  ----- Method: Unicode class>>parseCaseMappingFrom: (in category 'casing') -----
  parseCaseMappingFrom: stream
  	"Parse the Unicode casing mappings from the given stream.
  	Handle only the simple mappings"
  	"
  		Unicode initializeCaseMappings.
  	"
  
  	ToCasefold := IdentityDictionary new: 2048.
  	ToUpper := IdentityDictionary new: 2048.
  	ToLower := IdentityDictionary new: 2048.
  
  	[stream atEnd] whileFalse:[
  		| fields line srcCode dstCode |
  		line := stream nextLine copyUpTo: $#.
  		fields := line withBlanksTrimmed findTokens: $;.
  		(fields size > 2 and: [#('C' 'S') includes: (fields at: 2) withBlanksTrimmed]) ifTrue:[
  			srcCode := Integer readFrom: (fields at: 1) withBlanksTrimmed base: 16.
  			dstCode := Integer readFrom: (fields at: 3) withBlanksTrimmed base: 16.
  			ToCasefold at: srcCode put: dstCode.
  		].
  	].
  
  	ToCasefold keysAndValuesDo:
  		[:k :v |
+ 		(self isUppercaseCode: k)
- 		(self isUppercase: (self value: k))
  			ifTrue:
  				["In most cases, uppercase letter are folded to lower case"
  				ToUpper at: v put: k.
  				ToLower at: k put: v].
+ 		(self isLowercaseCode: k)
- 		(self isLowercase: (self value: k))
  			ifTrue:
+ 				["In a few cases, two upper case letters are folded to the same lower case.
- 				["In a few cases, two lower case letters are folded to the same lower case.
  				We must find an upper case letter folded to the same letter"
  				| up |
+ 				up := ToCasefold keys detect: [:e | (self isUppercaseCode: e) and: [(ToCasefold at: e) = v]] ifNone: [nil].
- 				up := ToCasefold keys detect: [:e | (self isUppercase: (self value: e)) and: [(ToCasefold at: e) = v]] ifNone: [nil].
  				up ifNotNil: [ToUpper at: k put: up]]].!

Item was added:
+ ----- Method: Unicode class>>toLowercaseCode: (in category 'casing') -----
+ toLowercaseCode: anInteger
+ 	"Answer corresponding lower case code for a Character code.
+ 	This does not handle special cases where several codes would be required."
+ 	
+ 	^ToLower at: anInteger ifAbsent: [anInteger]!

Item was added:
+ ----- Method: Unicode class>>toUppercaseCode: (in category 'casing') -----
+ toUppercaseCode: anInteger
+ 	"Answer corresponding upper case code for a Character code.
+ 	This does not handle special cases where several codes would be required."
+ 	
+ 	^ToUpper at: anInteger ifAbsent: [anInteger]!



More information about the Squeak-dev mailing list