The Trunk: Collections.spur-ul.634.mcz
Locked
 
|
Chris Muller uploaded a new version of Collections to project The Trunk:
http://source.squeak.org/trunk/Collections.spur-ul.634.mcz ==================== Summary ==================== Name: Collections.spur-ul.634 Author: eem Time: 13 May 2015, 6:13:28.985 pm UUID: c9b09516-9167-494a-8dd7-3e0268f68686 Ancestors: Collections-ul.634, Collections.spur-ul.633 Collections-ul.634 patched for Spur by SpurBootstrapMonticelloPackagePatcher Cog-eem.267 Revert the workaround from Collections-ul.633. =============== Diff against Collections-mt.621 =============== Item was changed: ----- Method: Array>>elementsExchangeIdentityWith: (in category 'converting') ----- elementsExchangeIdentityWith: otherArray + "This primitive performs a bulk mutation, causing all pointers to the elements of the + receiver to be replaced by pointers to the corresponding elements of otherArray. + At the same time, all pointers to the elements of otherArray are replaced by + pointers to the corresponding elements of this array. The identityHashes remain + with the pointers rather than with the objects so that objects in hashed structures + should still be properly indexed after the mutation." - "This primitive performs a bulk mutation, causing all pointers to the elements of this array to be replaced by pointers to the corresponding elements of otherArray. At the same time, all pointers to the elements of otherArray are replaced by pointers to the corresponding elements of this array. The identityHashes remain with the pointers rather than with the objects so that objects in hashed structures should still be properly indexed after the mutation." + <primitive: 128 error: ec> + ec == #'bad receiver' ifTrue: + [^self error: 'receiver must be of class Array']. + ec == #'bad argument' ifTrue: + [^self error: (otherArray class == Array + ifTrue: ['arg must be of class Array'] + ifFalse: ['receiver and argument must have the same size'])]. + ec == #'inappropriate operation' ifTrue: + [^self error: 'can''t become immediates such as SmallIntegers or Characters']. + ec == #'no modification' ifTrue: + [^self error: 'can''t become immutable objects']. + ec == #'object is pinned' ifTrue: + [^self error: 'can''t become pinned objects']. + ec == #'insufficient object memory' ifTrue: + [Smalltalk garbageCollect < 1048576 ifTrue: + [Smalltalk growMemoryByAtLeast: 1048576]. + ^self elementsExchangeIdentityWith: otherArray]. + self primitiveFailed! - <primitive: 128> - otherArray class == Array ifFalse: [^ self error: 'arg must be array']. - self size = otherArray size ifFalse: [^ self error: 'arrays must be same size']. - (self anySatisfy: [:obj | obj class == SmallInteger]) ifTrue: [^ self error: 'can''t become SmallIntegers']. - (otherArray anySatisfy: [:obj | obj class == SmallInteger]) ifTrue: [^ self error: 'can''t become SmallIntegers']. - self with: otherArray do:[:a :b| a == b ifTrue:[^self error:'can''t become yourself']]. - - "Must have failed because not enough space in forwarding table (see ObjectMemory-prepareForwardingTableForBecoming:with:twoWay:). Do GC and try again only once" - (Smalltalk bytesLeft: true) = Smalltalk primitiveGarbageCollect - ifTrue: [^ self primitiveFailed]. - ^ self elementsExchangeIdentityWith: otherArray! Item was changed: ----- Method: Array>>elementsForwardIdentityTo: (in category 'converting') ----- elementsForwardIdentityTo: otherArray + "This primitive performs a bulk mutation, causing all pointers to the elements of the + receiver to be replaced by pointers to the corresponding elements of otherArray. + The identityHashes remain with the pointers rather than with the objects so that + the objects in this array should still be properly indexed in any existing hashed + structures after the mutation." + <primitive: 72 error: ec> - "This primitive performs a bulk mutation, causing all pointers to the elements of this array to be replaced by pointers to the corresponding elements of otherArray. The identityHashes remain with the pointers rather than with the objects so that the objects in this array should still be properly indexed in any existing hashed structures after the mutation." - <primitive: 72> self primitiveFailed! Item was changed: ----- Method: Array>>elementsForwardIdentityTo:copyHash: (in category 'converting') ----- elementsForwardIdentityTo: otherArray copyHash: copyHash + "This primitive performs a bulk mutation, causing all pointers to the elements of the + receiver to be replaced by pointers to the corresponding elements of otherArray. + If copyHash is true, the identityHashes remain with the pointers rather than with the + objects so that the objects in the receiver should still be properly indexed in any + existing hashed structures after the mutation. If copyHash is false, then the hashes + of the objects in otherArray remain unchanged. If you know what you're doing this + may indeed be what you want." + <primitive: 249 error: ec> - "This primitive performs a bulk mutation, causing all pointers to the elements of this array to be replaced by pointers to the corresponding elements of otherArray. The identityHashes remain with the pointers rather than with the objects so that the objects in this array should still be properly indexed in any existing hashed structures after the mutation." - <primitive: 249> self primitiveFailed! Item was removed: - ----- Method: ByteString>>beginsWith: (in category 'testing') ----- - beginsWith: sequence - "Answer whether the receiver begins with the given sequence. The comparison is case-sensitive. Overridden for better performance." - - | sequenceSize | - sequence class isBytes ifFalse: [ ^super beginsWith: sequence ]. - ((sequenceSize := sequence size) = 0 or: [ self size < sequenceSize ]) ifTrue: [ ^false ]. - "The following method uses a suboptimal algorithm (brute force pattern matching with O(n^2) worst case runtime), but the primitive in C is so fast (assuming large alphabets), that it's still worth using it instead of linear time pure smalltalk implementation. There are some obvious cases when the brute force algorithm is suboptimal, e.g. when the first elements don't match, so let's compare them here before using the primitive." - (self basicAt: 1) = (sequence basicAt: 1) ifFalse: [ ^false ]. - ^(self findSubstring: sequence in: self startingAt: 1 matchTable: CaseSensitiveOrder) = 1! Item was changed: ----- Method: ByteString>>findSubstring:in:startingAt:matchTable: (in category 'comparing') ----- findSubstring: key in: body startingAt: start matchTable: matchTable "Answer the index in the string body at which the substring key first occurs, at or beyond start. The match is determined using matchTable, which can be used to effect, eg, case-insensitive matches. If no match is found, zero will be returned. The algorithm below is not optimum -- it is intended to be translated to C which will go so fast that it wont matter." | index | <primitive: 'primitiveFindSubstring' module: 'MiscPrimitivePlugin'> <var: #key declareC: 'unsigned char *key'> <var: #body declareC: 'unsigned char *body'> <var: #matchTable declareC: 'unsigned char *matchTable'> key size = 0 ifTrue: [^ 0]. + (start max: 1) to: body size - key size + 1 do: - start to: body size - key size + 1 do: [:startIndex | index := 1. [(matchTable at: (body at: startIndex+index-1) asciiValue + 1) = (matchTable at: (key at: index) asciiValue + 1)] whileTrue: [index = key size ifTrue: [^ startIndex]. index := index+1]]. ^ 0 " ' ' findSubstring: 'abc' in: 'abcdefabcd' startingAt: 1 matchTable: CaseSensitiveOrder 1 ' ' findSubstring: 'abc' in: 'abcdefabcd' startingAt: 2 matchTable: CaseSensitiveOrder 7 ' ' findSubstring: 'abc' in: 'abcdefabcd' startingAt: 8 matchTable: CaseSensitiveOrder 0 ' ' findSubstring: 'abc' in: 'abcdefABcd' startingAt: 2 matchTable: CaseSensitiveOrder 0 ' ' findSubstring: 'abc' in: 'abcdefABcd' startingAt: 2 matchTable: CaseInsensitiveOrder 7 "! Item was removed: - ----- Method: ByteSymbol>>beginsWith: (in category 'testing') ----- - beginsWith: sequence - "Answer whether the receiver begins with the given sequence. The comparison is case-sensitive. Overridden for better performance." - - | sequenceSize | - sequence class isBytes ifFalse: [ ^super beginsWith: sequence ]. - ((sequenceSize := sequence size) = 0 or: [ self size < sequenceSize ]) ifTrue: [ ^false ]. - "The following method uses a suboptimal algorithm (brute force pattern matching with O(n^2) worst case runtime), but the primitive in C is so fast (assuming large alphabets), that it's still worth using it instead of linear time pure smalltalk implementation. There are some obvious cases when the brute force algorithm is suboptimal, e.g. when the first elements don't match, so let's compare them here before using the primitive." - (self basicAt: 1) = (sequence basicAt: 1) ifFalse: [ ^false ]. - ^(self findSubstring: sequence in: self startingAt: 1 matchTable: CaseSensitiveOrder) = 1! Item was changed: + Magnitude immediateSubclass: #Character + instanceVariableNames: '' + classVariableNames: 'AlphaNumericMask CharacterTable ClassificationTable DigitBit DigitValues LetterMask LowercaseBit UppercaseBit' - Magnitude subclass: #Character - instanceVariableNames: 'value' - classVariableNames: 'CharacterTable ClassificationTable DigitValues LetterBits LowercaseBit UppercaseBit' poolDictionaries: '' category: 'Collections-Strings'! + !Character commentStamp: 'eem 8/12/2014 14:53' prior: 0! + I represent a character by storing its associated Unicode as an unsigned 30-bit value. Characters are created uniquely, so that all instances of a particular Unicode are identical. My instances are encoded in tagged pointers in the VM, so called immediates, and therefore are pure immutable values. - !Character commentStamp: 'ar 4/9/2005 22:35' prior: 0! - I represent a character by storing its associated Unicode. The first 256 characters are created uniquely, so that all instances of latin1 characters ($R, for example) are identical. The code point is based on Unicode. Since Unicode is 21-bit wide character set, we have several bits available for other information. As the Unicode Standard states, a Unicode code point doesn't carry the language information. This is going to be a problem with the languages so called CJK (Chinese, Japanese, Korean. Or often CJKV including Vietnamese). Since the characters of those languages are unified and given the same code point, it is impossible to display a bare Unicode code point in an inspector or such tools. To utilize the extra available bits, we use them for identifying the languages. Since the old implementation uses the bits to identify the character encoding, the bits are sometimes called "encoding tag" or neutrally "leading char", but the bits rigidly denotes the concept of languages. + The other languages can have the language tag if you like. This will help to break the large default font (font set) into separately loadable chunk of fonts. However, it is open to the each native speakers and writers to decide how to define the character equality, since the same Unicode code point may have different language tag thus simple #= comparison may return false.! - The other languages can have the language tag if you like. This will help to break the large default font (font set) into separately loadable chunk of fonts. However, it is open to the each native speakers and writers to decide how to define the character equality, since the same Unicode code point may have different language tag thus simple #= comparison may return false. - - I represent a character by storing its associated ASCII code (extended to 256 codes). My instances are created uniquely, so that all instances of a character ($R, for example) are identical.! Item was changed: ----- Method: Character class>>digitValue: (in category 'instance creation') ----- digitValue: x + "Answer the Character whose digit value is x. For example, + answer $9 for x=9, $0 for x=0, $A for x=10, $Z for x=35." - "Answer the Character whose digit value is x. For example, answer $9 for - x=9, $0 for x=0, $A for x=10, $Z for x=35." + | n | + n := x asInteger. + ^self value: (n < 10 ifTrue: [n + 48] ifFalse: [n + 55])! - | index | - index := x asInteger. - ^CharacterTable at: - (index < 10 - ifTrue: [48 + index] - ifFalse: [55 + index]) - + 1! Item was changed: ----- Method: Character class>>initialize (in category 'class initialization') ----- initialize + "Create the DigitsValues table." + "Character initialize" - "Create the table of unique Characters, and DigitsValues." - "Character initializeClassificationTable" - - CharacterTable ifNil: [ - "Initialize only once to ensure that byte characters are unique" - CharacterTable := Array new: 256. - 1 to: 256 do: [:i | CharacterTable at: i put: (self basicNew setValue: i - 1)]]. self initializeDigitValues! Item was changed: ----- Method: Character class>>initializeClassificationTable (in category 'class initialization') ----- initializeClassificationTable + "Initialize the classification table. + The classification table is a compact encoding of upper and lower cases and digits of characters with + - bits 0-7: The lower case value of this character or 0, if its greater than 255. + - bits 8-15: The upper case value of this character or 0, if its greater than 255. + - bit 16: lowercase bit (isLowercase == true) + - bit 17: uppercase bit (isUppercase == true) + - bit 18: digit bit (isDigit == true)" + " self initializeClassificationTable " - " - Initialize the classification table. The classification table is a - compact encoding of upper and lower cases of characters with + | encodedCharSet newClassificationTable | + "Base the table on the EncodedCharset of these characters' leadingChar - 0." + encodedCharSet := EncodedCharSet charsetAt: 0. - - bits 0-7: The lower case value of this character. - - bits 8-15: The upper case value of this character. - - bit 16: lowercase bit (e.g., isLowercase == true) - - bit 17: uppercase bit (e.g., isUppercase == true) - " - | ch1 | - LowercaseBit := 1 bitShift: 16. UppercaseBit := 1 bitShift: 17. + DigitBit := 1 bitShift: 18. + "Initialize the letter mask (e.g., isLetter == true)" + LetterMask := LowercaseBit bitOr: UppercaseBit. - "Initialize the letter bits (e.g., isLetter == true)" - LetterBits := LowercaseBit bitOr: UppercaseBit. + "Initialize the alphanumeric mask (e.g. isAlphaNumeric == true)" + AlphaNumericMask := LetterMask bitOr: DigitBit. - ClassificationTable := Array new: 256. - "Initialize the defaults (neither lower nor upper case)" - 0 to: 255 do:[:i| - ClassificationTable at: i+1 put: (i bitShift: 8) + i. - ]. + "Initialize the table based on encodedCharSet." + newClassificationTable := Array new: 256. + 0 to: 255 do: [ :code | + | isLowercase isUppercase isDigit lowercaseCode uppercaseCode value | + isLowercase := encodedCharSet isLowercaseCode: code. + isUppercase := encodedCharSet isUppercaseCode: code. + isDigit := encodedCharSet isDigitCode: code. + lowercaseCode := encodedCharSet toLowercaseCode: code. + lowercaseCode > 255 ifTrue: [ lowercaseCode := 0 ]. + uppercaseCode := encodedCharSet toUppercaseCode: code. + uppercaseCode > 255 ifTrue: [ uppercaseCode := 0 ]. + value := (uppercaseCode bitShift: 8) + lowercaseCode. + isLowercase ifTrue: [ value := value bitOr: LowercaseBit ]. + isUppercase ifTrue: [ value := value bitOr: UppercaseBit ]. + isDigit ifTrue: [ value := value bitOr: DigitBit ]. + newClassificationTable at: code + 1 put: value ]. + ClassificationTable := newClassificationTable! - "Initialize character pairs (upper-lower case)" - #( - "Basic roman" - ($A $a) ($B $b) ($C $c) ($D $d) - ($E $e) ($F $f) ($G $g) ($H $h) - ($I $i) ($J $j) ($K $k) ($L $l) - ($M $m) ($N $n) ($O $o) ($P $p) - ($Q $q) ($R $r) ($S $s) ($T $t) - ($U $u) ($V $v) ($W $w) ($X $x) - ($Y $y) ($Z $z) - "International" - ($Ä $ä) ($Å $å) ($Ç $ç) ($É $é) - ($Ñ $ñ) ($Ö $ö) ($Ü $ü) ($À $à) - ($à $ã) ($Õ $õ) ($ $) ($Æ $æ) - "International - Spanish" - ($Á $á) ($Í $í) ($Ó $ó) ($Ú $ú) - "International - PLEASE CHECK" - ($È $è) ($Ì $ì) ($Ò $ò) ($Ù $ù) - ($Ë $ë) ($Ï $ï) - ($ $â) ($Ê $ê) ($Î $î) ($Ô $ô) ($Û $û) - ) do:[:pair| | ch2 | - ch1 := pair first asciiValue. - ch2 := pair last asciiValue. - ClassificationTable at: ch1+1 put: (ch1 bitShift: 8) + ch2 + UppercaseBit. - ClassificationTable at: ch2+1 put: (ch1 bitShift: 8) + ch2 + LowercaseBit. - ]. - - "Initialize a few others for which we only have lower case versions." - #($ß $Ø $ø $ÿ) do:[:char| - ch1 := char asciiValue. - ClassificationTable at: ch1+1 put: (ch1 bitShift: 8) + ch1 + LowercaseBit. - ]. - ! Item was changed: ----- Method: Character class>>value: (in category 'instance creation') ----- + value: anInteger - value: anInteger "Answer the Character whose value is anInteger." + <primitive: 170> + ^self primitiveFailed! - - anInteger > 255 ifTrue: [^self basicNew setValue: anInteger]. - ^ CharacterTable at: anInteger + 1. - ! Item was changed: ----- Method: Character>>< (in category 'comparing') ----- < aCharacter "Answer true if the receiver's value < aCharacter's value." + ^self asInteger < aCharacter asciiValue! - ^value < aCharacter asciiValue! Item was changed: ----- Method: Character>><= (in category 'comparing') ----- <= aCharacter "Answer true if the receiver's value <= aCharacter's value." + ^self asInteger <= aCharacter asciiValue! - ^value <= aCharacter asciiValue! Item was changed: ----- Method: Character>>= (in category 'comparing') ----- = aCharacter + "Primitive. Answer if the receiver and the argument are the + same object (have the same object pointer). Optional. See + Object documentation whatIsAPrimitive." + <primitive: 110> + ^self == aCharacter! - - ^self == aCharacter or: [ - aCharacter isCharacter and: [ aCharacter asciiValue = value ] ]! Item was changed: ----- Method: Character>>> (in category 'comparing') ----- > aCharacter "Answer true if the receiver's value > aCharacter's value." + ^self asInteger > aCharacter asciiValue! - ^value > aCharacter asciiValue! Item was changed: ----- Method: Character>>>= (in category 'comparing') ----- >= aCharacter "Answer true if the receiver's value >= aCharacter's value." + ^self asInteger >= aCharacter asciiValue! - ^value >= aCharacter asciiValue! Item was changed: ----- Method: Character>>asInteger (in category 'converting') ----- asInteger + "Answer the receiver's character code." + <primitive: 171> + ^self primitiveFailed! - "Answer the value of the receiver." - - ^value! Item was changed: ----- Method: Character>>asLowercase (in category 'converting') ----- asLowercase + "Answer the receiver's matching lowercase Character." + + self asInteger > 255 ifFalse: [ + | result | + (result := (ClassificationTable at: self asInteger + 1) bitAnd: 16rFF) > 0 + ifTrue: [ ^self class value: result ] ]. + ^self class value: (self encodedCharSet toLowercaseCode: self asInteger)! - "If the receiver is uppercase, answer its matching lowercase Character." - "A tentative implementation. Eventually this should consult the Unicode table." - - | v | - v := self charCode. - (((8r101 <= v and: [v <= 8r132]) or: [16rC0 <= v and: [v <= 16rD6]]) or: [16rD8 <= v and: [v <= 16rDE]]) - ifTrue: [^ Character value: v + 8r40]. - v < 256 ifTrue: [^self]. - ^self class value: ((value < 16r400000 - ifTrue: [Unicode] - ifFalse: [self encodedCharSet charsetClass]) - toLowercaseCode: v)! Item was changed: ----- Method: Character>>asUnicode (in category 'converting') ----- asUnicode "Answer the unicode encoding of the receiver" + self leadingChar = 0 ifTrue: [^ self asInteger]. - self leadingChar = 0 ifTrue: [^ value]. ^self encodedCharSet charsetClass convertToUnicode: self charCode ! Item was changed: ----- Method: Character>>asUppercase (in category 'converting') ----- asUppercase + "Answer the receiver's matching uppercase Character." + + self asInteger > 255 ifFalse: [ + | result | + (result := ((ClassificationTable at: self asInteger + 1) bitShift: -8) bitAnd: 16rFF) > 0 + ifTrue: [ ^self class value: result ] ]. + ^self class value: (self encodedCharSet toUppercaseCode: self asInteger)! - "If the receiver is lowercase, answer its matching uppercase Character." - "A tentative implementation. Eventually this should consult the Unicode table." - - | v | - v := self charCode. - (((8r141 <= v and: [v <= 8r172]) or: [16rE0 <= v and: [v <= 16rF6]]) or: [16rF8 <= v and: [v <= 16rFE]]) - ifTrue: [^ Character value: v - 8r40]. - v < 256 ifTrue: [^self]. - ^self class value: ((value < 16r400000 - ifTrue: [Unicode] - ifFalse: [self encodedCharSet charsetClass]) - toUppercaseCode: v)! Item was changed: ----- Method: Character>>asciiValue (in category 'accessing') ----- asciiValue + "Answer the receiver's character code. + This will be ascii for characters with value <= 127, + and Unicode for those with higher values." + <primitive: 171> + ^self primitiveFailed! - "Answer the value of the receiver that represents its ascii encoding." - - ^value! Item was changed: ----- Method: Character>>charCode (in category 'accessing') ----- charCode + ^ (self asInteger bitAnd: 16r3FFFFF). - ^ (value bitAnd: 16r3FFFFF). ! Item was changed: ----- Method: Character>>clone (in category 'copying') ----- clone + "Answer the receiver, because Characters are unique." + ^self! - "Characters from 0 to 255 are unique, copy only the rest." - - value < 256 ifTrue: [ ^self ]. - ^super clone! Item was changed: ----- Method: Character>>codePoint (in category 'accessing') ----- codePoint "Return the encoding value of the receiver." #Fundmntl. + ^self asInteger! - ^value! Item was removed: - ----- Method: Character>>comeFullyUpOnReload: (in category 'object fileIn') ----- - comeFullyUpOnReload: smartRefStream - "Use existing an Character. Don't use the new copy." - - ^ self class value: value! Item was changed: ----- Method: Character>>copy (in category 'copying') ----- copy + "Answer the receiver, because Characters are unique." + ^self! - "Characters from 0 to 255 are unique, copy only the rest." - - value < 256 ifTrue: [ ^self ]. - ^super copy! Item was changed: ----- Method: Character>>deepCopy (in category 'copying') ----- deepCopy + "Answer the receiver, because Characters are unique." + ^self! - "Characters from 0 to 255 are unique, copy only the rest." - - value < 256 ifTrue: [ ^self ]. - ^super deepCopy! Item was changed: ----- Method: Character>>digitValue (in category 'accessing') ----- digitValue "Answer 0-9 if the receiver is $0-$9, 10-35 if it is $A-$Z, and < 0 otherwise. This is used to parse literal numbers of radix 2-36." + self asInteger > 16rFF ifTrue: [^self encodedCharSet digitValueOf: self]. + ^DigitValues at: 1 + self asInteger! - value > 16rFF ifTrue: [^self encodedCharSet digitValueOf: self]. - ^DigitValues at: 1 + value! Item was changed: ----- Method: Character>>encodedCharSet (in category 'accessing') ----- encodedCharSet + + self asInteger < 16r400000 ifTrue: [ ^Unicode ]. "Shortcut" - ^EncodedCharSet charsetAt: self leadingChar ! Item was changed: ----- Method: Character>>hash (in category 'comparing') ----- hash + "Hash is reimplemented because = is implemented. + Answer the receiver's character code." + <primitive: 171> + ^self primitiveFailed! - "Hash is reimplemented because = is implemented." - - ^value! Item was changed: ----- Method: Character>>hex (in category 'printing') ----- hex + ^self asInteger printStringBase: 16! - ^value printStringBase: 16! Item was added: + ----- Method: Character>>identityHash (in category 'comparing') ----- + identityHash + "Answer the receiver's character code." + <primitive: 171> + ^self primitiveFailed! Item was changed: ----- Method: Character>>isAlphaNumeric (in category 'testing') ----- isAlphaNumeric "Answer whether the receiver is a letter or a digit." + self asInteger > 255 ifFalse: [ ^((ClassificationTable at: self asInteger + 1) bitAnd: AlphaNumericMask) > 0 ]. ^self encodedCharSet isAlphaNumeric: self! Item was changed: ----- Method: Character>>isAscii (in category 'testing') ----- isAscii + ^ self asInteger between: 0 and: 127! - ^ value between: 0 and: 127! Item was changed: ----- Method: Character>>isDigit (in category 'testing') ----- isDigit + self asInteger > 255 ifFalse: [ ^((ClassificationTable at: self asInteger + 1) bitAnd: DigitBit) > 0 ]. ^self encodedCharSet isDigit: self. ! Item was changed: ----- Method: Character>>isLetter (in category 'testing') ----- isLetter + self asInteger > 255 ifFalse: [ ^((ClassificationTable at: self asInteger + 1) bitAnd: LetterMask) > 0 ]. + ^self encodedCharSet isLetter: self! - ^self encodedCharSet isLetter: self. - ! Item was changed: ----- Method: Character>>isLowercase (in category 'testing') ----- isLowercase + self asInteger > 255 ifFalse: [ ^((ClassificationTable at: self asInteger + 1) bitAnd: LowercaseBit) > 0 ]. ^self encodedCharSet isLowercase: self. ! Item was changed: ----- Method: Character>>isOctetCharacter (in category 'testing') ----- isOctetCharacter + ^ self asInteger < 256. - ^ value < 256. ! Item was changed: ----- Method: Character>>isSeparator (in category 'testing') ----- isSeparator "Answer whether the receiver is one of the separator characters--space, cr, tab, line feed, or form feed." + self asInteger = 32 ifTrue: [^true]. "space" + self asInteger = 13 ifTrue: [^true]. "cr" + self asInteger = 9 ifTrue: [^true]. "tab" + self asInteger = 10 ifTrue: [^true]. "line feed" + self asInteger = 12 ifTrue: [^true]. "form feed" - value = 32 ifTrue: [^true]. "space" - value = 13 ifTrue: [^true]. "cr" - value = 9 ifTrue: [^true]. "tab" - value = 10 ifTrue: [^true]. "line feed" - value = 12 ifTrue: [^true]. "form feed" ^false! Item was changed: ----- Method: Character>>isUppercase (in category 'testing') ----- isUppercase + self asInteger > 255 ifFalse: [ ^((ClassificationTable at: self asInteger + 1) bitAnd: UppercaseBit) > 0 ]. ^self encodedCharSet isUppercase: self. ! Item was changed: ----- Method: Character>>leadingChar (in category 'accessing') ----- leadingChar "Answer the value of the 8 highest bits which is used to identify the language. This is mostly used for east asian languages CJKV as a workaround against unicode han-unification." + ^ self asInteger bitShift: -22! - ^ value bitShift: -22! Item was changed: ----- Method: Character>>macToSqueak (in category 'converting') ----- macToSqueak "Convert the receiver from MacRoman to Squeak encoding" | asciiValue | + self asInteger < 128 ifTrue: [^ self]. + self asInteger > 255 ifTrue: [^ self]. - value < 128 ifTrue: [^ self]. - value > 255 ifTrue: [^ self]. asciiValue := #[ 196 197 199 201 209 214 220 225 224 226 228 227 229 231 233 232 "80-8F" 234 235 237 236 238 239 241 243 242 244 246 245 250 249 251 252 "90-9F" 134 176 162 163 167 149 182 223 174 169 153 180 168 128 198 216 "A0-AF" 129 177 138 141 165 181 142 143 144 154 157 170 186 158 230 248 "B0-BF" 191 161 172 166 131 173 178 171 187 133 160 192 195 213 140 156 "C0-CF" 150 151 147 148 145 146 247 179 255 159 185 164 139 155 188 189 "D0-DF" 135 183 130 132 137 194 202 193 203 200 205 206 207 204 211 212 "E0-EF" 190 210 218 219 217 208 136 152 175 215 221 222 184 240 253 254 ] "F0-FF" + at: self asInteger - 127. - at: value - 127. ^ Character value: asciiValue.! Item was changed: ----- Method: Character>>printOn: (in category 'printing') ----- printOn: aStream | name | + (self asInteger > 32 and: [self asInteger ~= 127]) - (value > 32 and: [value ~= 127]) ifTrue: [ aStream nextPut: $$; nextPut: self ] ifFalse: [ name := self class constantNameFor: self. name notNil ifTrue: [ aStream nextPutAll: self class name; space; nextPutAll: name ] + ifFalse: [ aStream nextPutAll: self class name; nextPutAll: ' value: '; print: self asInteger ] ].! - ifFalse: [ aStream nextPutAll: self class name; nextPutAll: ' value: '; print: value ] ].! Item was removed: - ----- Method: Character>>setValue: (in category 'private') ----- - setValue: newValue - value ifNotNil:[^self error:'Characters are immutable']. - value := newValue.! Item was changed: ----- Method: Character>>shallowCopy (in category 'copying') ----- shallowCopy + "Answer the receiver, because Characters are unique." + ^self! - "Characters from 0 to 255 are unique, copy only the rest." - - value < 256 ifTrue: [ ^self ]. - ^super shallowCopy! Item was changed: ----- Method: Character>>shouldBePrintedAsLiteral (in category 'testing') ----- shouldBePrintedAsLiteral + ^(self asInteger between: 33 and: 255) and: [self asInteger ~= 127]! - ^(value between: 33 and: 255) and: [value ~= 127]! Item was changed: ----- Method: Character>>squeakToMac (in category 'converting') ----- squeakToMac "Convert the receiver from Squeak to MacRoman encoding." + self asInteger < 128 ifTrue: [^ self]. + self asInteger > 255 ifTrue: [^ self]. - value < 128 ifTrue: [^ self]. - value > 255 ifTrue: [^ self]. ^ Character value: (#[ 173 176 226 196 227 201 160 224 246 228 178 220 206 179 182 183 "80-8F" 184 212 213 210 211 165 208 209 247 170 185 221 207 186 189 217 "90-9F" 202 193 162 163 219 180 195 164 172 169 187 199 194 197 168 248 "A0-AF" 161 177 198 215 171 181 166 225 252 218 188 200 222 223 240 192 "B0-BF" 203 231 229 204 128 129 174 130 233 131 230 232 237 234 235 236 "C0-CF" 245 132 241 238 239 205 133 249 175 244 242 243 134 250 251 167 "D0-DF" 136 135 137 139 138 140 190 141 143 142 144 145 147 146 148 149 "E0-EF" 253 150 152 151 153 155 154 214 191 157 156 158 159 254 255 216 "F0-FF" + ] at: self asInteger - 127) - ] at: value - 127) ! Item was changed: ----- Method: Character>>storeBinaryOn: (in category 'printing') ----- storeBinaryOn: aStream "Store the receiver on a binary (file) stream" + self asInteger < 256 - value < 256 ifTrue: [ aStream basicNextPut: self ] + ifFalse: [ aStream nextInt32Put: self asInteger ]! - ifFalse: [ aStream nextInt32Put: value ]! Item was changed: ----- Method: Character>>storeOn: (in category 'printing') ----- storeOn: aStream "Common character literals are preceded by '$', however special need to be encoded differently: for some this might be done by using one of the shortcut constructor methods for the rest we have to create them by ascii-value." | name | self shouldBePrintedAsLiteral ifTrue: [ aStream nextPut: $$; nextPut: self ] ifFalse: [ name := self class constantNameFor: self. name notNil ifTrue: [ aStream nextPutAll: self class name; space; nextPutAll: name ] ifFalse: [ aStream nextPut: $(; nextPutAll: self class name; + nextPutAll: ' value: '; print: self asInteger; nextPut: $) ] ].! - nextPutAll: ' value: '; print: value; nextPut: $) ] ].! Item was changed: ----- Method: Character>>to: (in category 'converting') ----- to: other "Answer with a collection in ascii order -- $a to: $z" + ^ (self asInteger to: other asciiValue) - ^ (value to: other asciiValue) collect: [:ascii | Character value: ascii] as: String! Item was changed: ----- Method: Character>>tokenish (in category 'testing') ----- tokenish + "Answer whether the receiver is a valid token-character--letter, digit, or colon." - "Answer whether the receiver is a valid token-character--letter, digit, or - colon." + self == $_ ifTrue: [ ^Scanner prefAllowUnderscoreSelectors ]. + ^self == $: or: [ self isAlphaNumeric ]! - ^ self == $_ - ifTrue: [ Scanner prefAllowUnderscoreSelectors ] - ifFalse: [ self == $: or: [ self isLetter or: [ self isDigit ] ] ]! Item was changed: ----- Method: Character>>veryDeepCopyWith: (in category 'copying') ----- veryDeepCopyWith: deepCopier + "Answer the receiver, because Characters are unique." + ^self! - "Characters from 0 to 255 are unique, copy only the rest." - - value < 256 ifTrue: [ ^self ]. - ^super veryDeepCopyWith: deepCopier! Item was changed: Object subclass: #Collection instanceVariableNames: '' + classVariableNames: '' - classVariableNames: 'MutexForPicking RandomForPicking' poolDictionaries: '' category: 'Collections-Abstract'! !Collection commentStamp: '<historical>' prior: 0! I am the abstract superclass of all classes that represent a group of elements.! Item was changed: ----- Method: Collection class>>initialize (in category 'class initialization') ----- initialize "Set up a Random number generator to be used by atRandom when the user does not feel like creating his own Random generator." - RandomForPicking := Random new. - MutexForPicking := Semaphore forMutualExclusion. Smalltalk addToStartUpList: self! Item was removed: - ----- Method: Collection class>>mutexForPicking (in category 'private') ----- - mutexForPicking - ^ MutexForPicking! Item was removed: - ----- Method: Collection class>>randomForPicking (in category 'private') ----- - randomForPicking - - self deprecated: 'Use ThreadSafeRandom value instead. It''s not thread-safe to use this instance without the unaccessible MutexForPicking semaphore.'. - ^ RandomForPicking! Item was removed: - ----- Method: Collection class>>startUp (in category 'system startup') ----- - startUp - "Reseed the random generator at startup time such that a reloaded - project will not repeat a previous pseudo-random sequence when - selecting at random from a collection." - - MutexForPicking - critical: [RandomForPicking initialize]! Item was added: + ----- Method: Collection>>groupBy: (in category 'enumerating') ----- + groupBy: keyBlock + "Like in SQL operation - Split the recievers contents into collections of elements for which keyBlock returns the same results, and return them." + + | result | + result := Dictionary new. + self do: [ :each | + | key | + key := keyBlock value: each. + (result at: key ifAbsentPut: [ OrderedCollection new ]) + add: each ]. + ^result! Item was changed: ----- Method: Collection>>groupBy:having: (in category 'enumerating') ----- groupBy: keyBlock having: selectBlock "Like in SQL operation - Split the recievers contents into collections of elements for which keyBlock returns the same results, and return those collections allowed by selectBlock." + + ^(self groupBy: keyBlock) select: selectBlock! - | result | - result := Dictionary new. - self do: - [ : each | | key | - key := keyBlock value: each. - (result - at: key - ifAbsentPut: [ OrderedCollection new ]) add: each ]. - ^ result select: selectBlock! Item was removed: - ----- Method: Collection>>toBraceStack: (in category 'private') ----- - toBraceStack: itsSize - "Push receiver's elements onto the stack of thisContext sender. Error if receiver does - not have itsSize elements or if receiver is unordered. - Do not call directly: this is called by {a. b} := ... constructs." - - self size ~= itsSize ifTrue: - [self error: 'Trying to store ', self size printString, - ' values into ', itsSize printString, ' variables.']. - thisContext sender push: itsSize fromIndexable: self! Item was added: + TextReadWriter subclass: #HtmlReadWriter + instanceVariableNames: 'count offset runStack runArray string' + classVariableNames: '' + poolDictionaries: '' + category: 'Collections-Text'! Item was added: + ----- Method: HtmlReadWriter>>ignoredTags (in category 'accessing') ----- + ignoredTags + "Because we cannot process all of them." + + ^ #(body script table tr td ul ol li form select option input)! Item was added: + ----- Method: HtmlReadWriter>>isTagIgnored: (in category 'testing') ----- + isTagIgnored: aTag + + | space t | + space := aTag indexOf: Character space. + t := space > 0 + ifTrue: [aTag copyFrom: 2 to: space - 1] + ifFalse: [aTag copyFrom: 2 to: aTag size - 1]. + ^ self ignoredTags includes: t! Item was added: + ----- Method: HtmlReadWriter>>mapATag: (in category 'mapping') ----- + mapATag: aTag + + | result startIndex stopIndex attribute | + result := OrderedCollection new. + + Transcript showln: aTag. + + "<a href=""http://google.de"">" + attribute := 'href'. + startIndex := aTag findString: attribute. + startIndex > 0 ifTrue: [ + startIndex := aTag findString: '=' startingAt: startIndex+attribute size. + stopIndex := aTag findString: ' ' startingAt: startIndex+1. + stopIndex = 0 ifTrue: [ + stopIndex := aTag findString: '>' startingAt: startIndex+1]. + + (aTag at: startIndex + 1) = $" + ifTrue: [startIndex := startIndex + 1]. + (aTag at: stopIndex - 1) = $" + ifTrue: [stopIndex := stopIndex - 1]. + result add: (TextURL new url: (aTag copyFrom: startIndex+1 to: stopIndex-1))]. + + ^ result! Item was added: + ----- Method: HtmlReadWriter>>mapFontTag: (in category 'mapping') ----- + mapFontTag: aTag + + | result colorStartIndex colorStopIndex attribute | + result := OrderedCollection new. + + "<font color=""#00FFCC"">" + attribute := 'color'. + colorStartIndex := aTag findString: attribute. + colorStartIndex > 0 ifTrue: [ + colorStartIndex := aTag findString: '#' startingAt: colorStartIndex+attribute size. + colorStopIndex := aTag findString: '"' startingAt: colorStartIndex+1. + result add: (TextColor color: + (Color fromString: (aTag copyFrom: colorStartIndex to: colorStopIndex-1)))]. + + ^ result! Item was added: + ----- Method: HtmlReadWriter>>mapTagToAttribute: (in category 'mapping') ----- + mapTagToAttribute: aTag + + aTag = '<b>' ifTrue: [^ {TextEmphasis bold}]. + aTag = '<i>' ifTrue: [^ {TextEmphasis italic}]. + aTag = '<u>' ifTrue: [^ {TextEmphasis underlined}]. + "aTag = '<code>' ifTrue: [^ {TextFontReference toFont: Preferences standardCodeFont}]." + (aTag beginsWith: '<font') ifTrue: [^ self mapFontTag: aTag]. + (aTag beginsWith: '<a') ifTrue: [^ self mapATag: aTag]. + + "h1, h2, h3, ..." + (aTag second = $h and: [aTag third isDigit]) + ifTrue: [^ {TextEmphasis bold}]. + + ^ {}! Item was added: + ----- Method: HtmlReadWriter>>nextPutText: (in category 'accessing') ----- + nextPutText: aText + + aText runs + withStartStopAndValueDo: [:start :stop :attributes | + | att str | + att := aText attributesAt: start. + str := aText string copyFrom: start to: stop. + + att do: [:each | self writeStartTagFor: each]. + self writeContent: str. + att reverse do: [:each | self writeEndTagFor: each]]! Item was added: + ----- Method: HtmlReadWriter>>nextText (in category 'accessing') ----- + nextText + + count := 0. + offset := 0. "To ignore characters in the input string that are used by tags." + + runStack := Stack new. + + runArray := RunArray new. + string := OrderedCollection new. + + "{text attributes. start index. end index. number of open tags}" + runStack push: {OrderedCollection new. 1. nil. 0}. + + [stream atEnd] whileFalse: [self processNextTag]. + self processRunStackTop. "Add last run." + + string := String withAll: string. + runArray coalesce. + + ^ Text + string: string + runs: runArray! Item was added: + ----- Method: HtmlReadWriter>>processComment: (in category 'reading') ----- + processComment: aComment + ! Item was added: + ----- Method: HtmlReadWriter>>processEmptyTag: (in category 'reading') ----- + processEmptyTag: aTag + + (aTag beginsWith: '<br') ifTrue: [ + string add: Character cr. + count := count + 1. + ^ self]. + + (self ignoredTags includes: (aTag copyFrom: 2 to: aTag size - 3)) + ifTrue: [^ self]. + + "TODO..."! Item was added: + ----- Method: HtmlReadWriter>>processEndTag: (in category 'reading') ----- + processEndTag: aTag + + | index | + index := count - offset. + + (self ignoredTags includes: (aTag copyFrom: 3 to: aTag size -1)) + ifTrue: [^ self]. + + "De-Accumulate adjacent tags." + runStack top at: 4 put: runStack top fourth - 1. + runStack top fourth > 0 + ifTrue: [^ self "not yet"]. + + self processRunStackTop. + + runStack pop. + runStack top at: 2 put: index + 1.! Item was added: + ----- Method: HtmlReadWriter>>processHtmlEscape: (in category 'reading') ----- + processHtmlEscape: aString + + (String htmlEntities at: (aString copyFrom: 2 to: aString size - 1) ifAbsent: []) + ifNotNil: [:char | + string add: char. + count := count + 1].! Item was added: + ----- Method: HtmlReadWriter>>processNextTag (in category 'reading') ----- + processNextTag + + | tag htmlEscape lookForNewTag lookForHtmlEscape tagFound valid inComment | + lookForNewTag := true. + lookForHtmlEscape := false. + tagFound := false. + tag := OrderedCollection new. + htmlEscape := OrderedCollection new. + inComment := false. + + [stream atEnd not and: [tagFound not]] whileTrue: [ + | character | + character := stream next. + valid := (#(10 13) includes: character asciiValue) not. + count := count + 1. + + character = $< ifTrue: [lookForNewTag := false]. + character = $& ifTrue: [ + inComment ifFalse: [lookForHtmlEscape := true]]. + + lookForNewTag + ifTrue: [ + lookForHtmlEscape + ifFalse: [valid ifTrue: [string add: character] ifFalse: [offset := offset + 1]] + ifTrue: [valid ifTrue: [htmlEscape add: character]. offset := offset + 1]] + ifFalse: [valid ifTrue: [tag add: character]. offset := offset + 1]. + + inComment := ((lookForNewTag not and: [tag size >= 4]) + and: [tag beginsWith: '<!!--']) + and: [(tag endsWith: '-->') not]. + + ((character = $> and: [inComment not]) and: [lookForNewTag not]) ifTrue: [ + lookForNewTag := true. + (tag beginsWith: '<!!--') + ifTrue: [self processComment: (String withAll: tag)] + ifFalse: [tag second ~= $/ + ifTrue: [ + (tag atLast: 2) == $/ + ifTrue: [self processEmptyTag: (String withAll: tag)] + ifFalse: [self processStartTag: (String withAll: tag)]] + ifFalse: [self processEndTag: (String withAll: tag)]]. + tagFound := true]. + + (((character = $; and: [lookForNewTag]) + and: [htmlEscape notEmpty]) and: [htmlEscape first = $&]) ifTrue: [ + lookForHtmlEscape := false. + self processHtmlEscape: (String withAll: htmlEscape). + htmlEscape := OrderedCollection new]]. + ! Item was added: + ----- Method: HtmlReadWriter>>processRunStackTop (in category 'reading') ----- + processRunStackTop + "Write accumulated attributes to run array." + + | index start end attrs | + index := count - offset. + + "Set end index." + runStack top at: 3 put: index. + "Write to run array." + start := runStack top second. + end := runStack top third. + attrs := runStack top first. + runArray + addLast: attrs asArray + times: end - start + 1.! Item was added: + ----- Method: HtmlReadWriter>>processStartTag: (in category 'reading') ----- + processStartTag: aTag + + | index | + (self isTagIgnored: aTag) ifTrue: [^ self]. + + index := count - offset. + + aTag = '<br>' ifTrue: [ + string add: Character cr. + count := count + 1. + ^ self]. + (aTag beginsWith: '<img') ifTrue: [ + string addAll: '[image]'. + count := count + 7. + ^ self]. + + "Accumulate adjacent tags." + (runStack size > 1 and: [runStack top second = (index + 1) "= adjacent start tags"]) + ifTrue: [ + runStack top at: 1 put: (runStack top first copy addAll: (self mapTagToAttribute: aTag); yourself). + runStack top at: 4 put: (runStack top fourth + 1). "increase number of open tags" + ^self]. + + self processRunStackTop. + + "Remove start/end info to reuse attributes later." + runStack top at: 2 put: nil. + runStack top at: 3 put: nil. + "Copy attr list and add new attr." + runStack push: ({runStack top first copy addAll: (self mapTagToAttribute: aTag); yourself. index + 1. nil. 1}).! Item was added: + ----- Method: HtmlReadWriter>>writeContent: (in category 'writing') ----- + writeContent: aString + + aString do: [:char | + (#(10 13) includes: char asciiValue) + ifTrue: [stream nextPutAll: '<br>'; cr] + ifFalse: [char = Character tab + ifTrue: [stream nextPutAll: ' '] + ifFalse: [(String htmlEntities keyAtValue: char ifAbsent: []) + ifNil: [stream nextPut: char] + ifNotNil: [:escapeSequence | + stream + nextPut: $&; + nextPutAll: escapeSequence; + nextPut: $;]]]].! Item was added: + ----- Method: HtmlReadWriter>>writeEndTagFor: (in category 'writing') ----- + writeEndTagFor: aTextAttribute + + [aTextAttribute closeHtmlOn: stream] + on: MessageNotUnderstood do: []! Item was added: + ----- Method: HtmlReadWriter>>writeStartTagFor: (in category 'writing') ----- + writeStartTagFor: aTextAttribute + + [aTextAttribute openHtmlOn: stream] + on: MessageNotUnderstood do: [].! Item was added: + ----- Method: String class>>htmlEntities (in category 'accessing') ----- + htmlEntities + + ^ HtmlEntities! Item was added: + ----- Method: String>>asTextFromHtml (in category 'converting') ----- + asTextFromHtml + "Answer a Text by interpreting the receiver as HTML." + + ^ (HtmlReadWriter on: self readStream) nextText! Item was changed: ----- Method: String>>endsWith: (in category 'testing') ----- + endsWith: sequence + "Answer true if the receiver ends with the argument collection. The comparison is case-sensitive." - endsWith: suffix - "Answer true if the receiver ends with the argument collection. The comparison is case-sensitive. Overridden for better performance." + | sequenceSize offset | + sequence isString ifFalse: [ ^ super endsWith: sequence ]. + ((sequenceSize := sequence size) = 0 or: [ (offset := self size - sequence size) < 0 ]) ifTrue: [ ^false ]. + 1 to: sequenceSize do: [ :index | + (sequence basicAt: index) = (self basicAt: index + offset) ifFalse: [ ^false ] ]. + ^true! - | offset | - (offset := self size - suffix size) < 0 ifTrue: [ ^false ]. - ^(self findString: suffix startingAt: offset + 1) ~= 0! Item was changed: ----- Method: String>>withoutLineEndings (in category 'converting') ----- withoutLineEndings + ^self withLineEndings: ' '! - ^ self withSqueakLineEndings - copyReplaceAll: String cr - with: ' ' - asTokens: false! Item was changed: ----- Method: Symbol>>numArgs: (in category 'system primitives') ----- numArgs: n "Answer a string that can be used as a selector with n arguments. TODO: need to be extended to support shrinking and for selectors like #+ " + | numArgs offset |. + (numArgs := self numArgs) >= n ifTrue: [ ^self ]. + numArgs = 0 + ifTrue: [ offset := 1 ] + ifFalse: [ offset := 0 ]. + ^(String new: n - numArgs + offset * 5 + offset + self size streamContents: [ :stream | + stream nextPutAll: self. + numArgs = 0 ifTrue: [ stream nextPut: $:. ]. + numArgs + offset + 1 to: n do: [ :i | stream nextPutAll: 'with:' ] ]) asSymbol! - | selector numArgs aStream offs | - - selector := self. - (numArgs := selector numArgs) >= n ifTrue: [^self]. - aStream := WriteStream on: (String new: 16). - aStream nextPutAll: self. - - (numArgs = 0) ifTrue: [aStream nextPutAll: ':'. offs := 0] ifFalse: [offs := 1]. - 2 to: n - numArgs + offs do: [:i | aStream nextPutAll: 'with:']. - ^aStream contents asSymbol - - ! Item was added: + ----- Method: Text>>asStringToHtml (in category 'converting') ----- + asStringToHtml + "Inverse to String >> #asTextFromHtml" + + ^ self printHtmlString! Item was removed: - ----- Method: Text>>closeHtmlAttributes:on: (in category 'html') ----- - closeHtmlAttributes: anArray on: aStream - anArray - do: [:each | each closeHtmlOn: aStream].! Item was removed: - ----- Method: Text>>openHtmlAttributes:on: (in category 'html') ----- - openHtmlAttributes: anArray on: aStream - anArray - do: [:each | each openHtmlOn: aStream ]! Item was changed: ----- Method: Text>>printHtmlOn: (in category 'html') ----- printHtmlOn: aStream + + (HtmlReadWriter on: aStream) + nextPutText: self.! - self runs - withStartStopAndValueDo: [:start :stop :attributes | - | att str | - att := self attributesAt: start. - str := self string copyFrom: start to: stop. - "" - self openHtmlAttributes: att on: aStream. - self printStringHtml: str on: aStream. - - self closeHtmlAttributes: att on: aStream]! Item was changed: ----- Method: Text>>printHtmlString (in category 'html') ----- printHtmlString "answer a string whose characters are the html representation of the receiver" + + ^ String streamContents: [:stream | + self printHtmlOn: stream]! - | html | - html := String new writeStream. - self printHtmlOn: html. - ^ html contents! Item was removed: - ----- Method: Text>>printStringHtml:on: (in category 'html') ----- - printStringHtml: aString on: aStream - | html | - html := aString. - "" - html := html copyReplaceAll: '&' with: '&'. - html := html copyReplaceAll: '>' with: '>'. - html := html copyReplaceAll: '<' with: '<'. - "" - html := html copyReplaceAll: '¬¨¬®¬¨¬é¬¨¬®¬¨¦Ö' with: 'á'. - html := html copyReplaceAll: '¬¨¬®¬¨¬é¬¨¬®¬¨¬©' with: 'é'. - html := html copyReplaceAll: '¬¨¬®¬¨¬é¬¨¬®¬¶¦ë' with: 'í'. - html := html copyReplaceAll: '¬¨¬®¬¨¬é¬¨¬®¬¶¦ü' with: 'ó'. - html := html copyReplaceAll: '¬¨¬®¬¨¬é¬¨¬®¬¶¬ö' with: 'ú'. - html := html copyReplaceAll: '¬¨¬®¬¨¬é¬¨¬®¬¨¬±' with: 'ñ'. - "" - html := html copyReplaceAll: '¬¨¬®¬¨¬é¬¨¬¬¶¦±' with: 'Á'. - html := html copyReplaceAll: '¬¨¬®¬¨¬é¬¨¬¬¨¬¢' with: 'É'. - html := html copyReplaceAll: '¬¨¬®¬¨¬é¬¨¬¬¶¦º' with: 'Í'. - html := html copyReplaceAll: '¬¨¬®¬¨¬é¬¨¬¬¨¬Æ' with: 'Ó'. - html := html copyReplaceAll: '¬¨¬®¬¨¬é¬¨¬¬¨¦©' with: 'Ú'. - html := html copyReplaceAll: '¬¨¬®¬¨¬é¬¨¬¬¨¬·' with: 'Ñ'. - "" - html := html copyReplaceAll: ' - ' with: '<br> - '. - html := html copyReplaceAll: ' ' with: ' '. - "" - aStream nextPutAll: html! Item was added: + Object subclass: #TextReadWriter + instanceVariableNames: 'stream' + classVariableNames: '' + poolDictionaries: '' + category: 'Collections-Text'! Item was added: + ----- Method: TextReadWriter class>>on: (in category 'instance creation') ----- + on: stream + + ^ self new on: stream! Item was added: + ----- Method: TextReadWriter>>nextPutText: (in category 'accessing') ----- + nextPutText: aText + "Encoding aText on stream." + + self subclassResponsibility.! Item was added: + ----- Method: TextReadWriter>>nextText (in category 'accessing') ----- + nextText + "Decoding a text object on stream and answer that text object." + + ^ self subclassResponsibility.! Item was added: + ----- Method: TextReadWriter>>on: (in category 'initialize-release') ----- + on: aStream + + stream := aStream.! Item was changed: WriteStream subclass: #TranscriptStream instanceVariableNames: 'lastChar' + classVariableNames: 'AccessSema ForceUpdate RedirectToStdOut' - classVariableNames: 'AccessSema' poolDictionaries: '' category: 'Collections-Streams'! !TranscriptStream commentStamp: 'fbs 12/30/2013 09:53' prior: 0! This class is a much simpler implementation of Transcript protocol that supports multiple views and very simple conversion to morphic. Because it inherits from Stream, it is automatically compatible with code that is designed to write to streams.! Item was added: + ----- Method: TranscriptStream class>>forceUpdate (in category 'preferences') ----- + forceUpdate + + <preference: 'Force transcript updates to screen' + categoryList: #(printing morphic debug) + description: 'When enabled, transcript updates will immediately shown in the screen no matter how busy the UI process is.' + type: #Boolean> + ^ ForceUpdate ifNil: [true]! Item was added: + ----- Method: TranscriptStream class>>forceUpdate: (in category 'preferences') ----- + forceUpdate: aBoolean + + ForceUpdate := aBoolean.! Item was changed: + ----- Method: TranscriptStream class>>new (in category 'instance creation') ----- - ----- Method: TranscriptStream class>>new (in category 'as yet unclassified') ----- new ^ self on: (String new: 1000) " INSTALLING: TextCollector allInstances do: [:t | t breakDependents. t become: TranscriptStream new]. TESTING: (Execute this text in a workspace) Do this first... tt := TranscriptStream new. tt openLabel: 'Transcript test 1'. Then this will open a second view -- ooooh... tt openLabel: 'Transcript test 2'. And finally make them do something... tt clear. [Sensor anyButtonPressed] whileFalse: [1 to: 20 do: [:i | tt print: (2 raisedTo: i-1); cr; endEntry]]. "! Item was changed: + ----- Method: TranscriptStream class>>newTranscript: (in category 'instance creation') ----- - ----- Method: TranscriptStream class>>newTranscript: (in category 'as yet unclassified') ----- newTranscript: aTextCollector "Store aTextCollector as the value of the system global Transcript." Smalltalk at: #Transcript put: aTextCollector! Item was added: + ----- Method: TranscriptStream class>>redirectToStdOut (in category 'preferences') ----- + redirectToStdOut + <preference: 'Redirect transcript to stdout' + categoryList: #(printing morphic debug) + description: 'When enabled, no Morphic is needed when using the transcript interface to debug.' + type: #Boolean> + ^ RedirectToStdOut ifNil: [false]! Item was added: + ----- Method: TranscriptStream class>>redirectToStdOut: (in category 'preferences') ----- + redirectToStdOut: aBoolean + + RedirectToStdOut := aBoolean.! Item was changed: ----- Method: TranscriptStream>>endEntry (in category 'stream extensions') ----- endEntry "Display all the characters since the last endEntry, and reset the stream" self semaphore critical:[ + self class forceUpdate + ifTrue: [self changed: #appendEntry] + ifFalse: [self changed: #appendEntryLater]. - self changed: #appendEntry. self reset. ].! Item was changed: ----- Method: TranscriptStream>>show: (in category 'stream extensions') ----- + show: anObject + "TextCollector compatibility" + + [ + self target nextPutAll: anObject asString. + self endEntry + ] on: FileWriteError do: [self class redirectToStdOut: false].! - show: anObject "TextCollector compatibility" - self nextPutAll: anObject asString; endEntry! Item was changed: ----- Method: TranscriptStream>>showln: (in category 'stream extensions') ----- + showln: anObject + "TextCollector compatibility. Ensure a new line before inserting a message." + + [ + self target + cr; + nextPutAll: anObject asString. + self endEntry. + ] on: FileWriteError do: [self class redirectToStdOut: false].! - showln: anObject "TextCollector compatibility" - self nextPutAll: anObject asString; cr ; endEntry! Item was added: + ----- Method: TranscriptStream>>target (in category 'stream extensions') ----- + target + + ^ self class redirectToStdOut + ifTrue: [FileStream stdout] + ifFalse: [self]! Item was changed: ----- Method: WideString>>at: (in category 'accessing') ----- + at: index + "Answer the Character stored in the field of the receiver indexed by the + argument. Primitive. Fail if the index argument is not an Integer or is out + of bounds. Essential. See Object documentation whatIsAPrimitive." + + <primitive: 63> + ^index isInteger + ifTrue: + [self errorSubscriptBounds: index] + ifFalse: + [index isNumber + ifTrue: [self at: index asInteger] + ifFalse: [self errorNonIntegerIndex]]! - at: index - "Answer the Character stored in the field of the receiver indexed by the argument." - ^ Character value: (self wordAt: index). - ! Item was changed: ----- Method: WideString>>at:put: (in category 'accessing') ----- + at: index put: aCharacter + "Store the Character into the field of the receiver indicated by the index. + Primitive. Fail if the index is not an Integer or is out of bounds, or if the + argument is not a Character. Essential. See Object documentation whatIsAPrimitive." + + <primitive: 64> + ^aCharacter isCharacter + ifTrue: + [index isInteger + ifTrue: [self errorSubscriptBounds: index] + ifFalse: [self errorNonIntegerIndex]] + ifFalse: + [self errorImproperStore]! - at: index put: aCharacter - "Store the Character in the field of the receiver indicated by the index." - aCharacter isCharacter ifFalse:[self errorImproperStore]. - self wordAt: index put: aCharacter asInteger. - ^aCharacter! Item was changed: + (PackageInfo named: 'Collections') postscript: 'Character initializeClassificationTable. + String initialize'! - (PackageInfo named: 'Collections') postscript: 'LRUCache allInstances do: [ :each | each reset ]'! |
«
Return to Squeak - Dev
|
1 view|%1 views
| Free forum by Nabble | Edit this page |