The Trunk: Multilingual-nice.195.mcz

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]!