Squeak-dev June 2023

squeak-dev@lists.squeakfoundation.org

23 participants
127 discussions

Review Request: UIManagerInformTitle.1.cs
by christoph.thiede＠student.hpi.uni-potsdam.de 01 Jun '23

01 Jun '23

=============== Summary =============== Change Set: UIManagerInformTitle Date: 17 May 2023 Author: Christoph Thiede Adds UIManager>>#inform:title:, analogously to existing #confirm:title. Project uiManager inform: 'Squeak is great!' title: 'Important Note' =============== Diff =============== DummyUIManager>>inform:title: {ui requests} · ct 5/14/2023 21:27 + inform: aString title: titleString + "Nothing to be done here" + self askForProvidedAnswerTo: aString ifSupplied: [:answer | + ^ answer]. MVCUIManager>>inform:title: {ui requests} · ct 5/14/2023 21:27 + inform: aString title: titleString + "Display a message for the user to read and then dismiss" + self askForProvidedAnswerTo: aString ifSupplied: [:answer | + ^ answer]. + + ^ PopUpMenu inform: (self dialogStringFromQuery: aString withTitle: titleString) MorphicUIManager>>inform:title: {ui requests} · ct 5/14/2023 21:26 + inform: aString title: titleString + "Display a message for the user to read and then dismiss" + self askForProvidedAnswerTo: aString ifSupplied: [:answer | + ^ answer]. + + ^ UserDialogBoxMorph inform: aString title: titleString UIManager>>inform:title: {ui requests} · ct 5/14/2023 21:27 + inform: aString title: titleString + "Display a message for the user to read and then dismiss" + ^self subclassResponsibility --- Sent from Squeak Inbox Talk ["UIManagerInformTitle.1.cs"]

4 16

The Trunk: CommandLine-ct.24.mcz
by commits＠source.squeak.org 01 Jun '23

01 Jun '23

Christoph Thiede uploaded a new version of CommandLine to project The Trunk: http://source.squeak.org/trunk/CommandLine-ct.24.mcz ==================== Summary ==================== Name: CommandLine-ct.24 Author: ct Time: 1 June 2023, 9:43:22.098644 pm UUID: f7532021-8ee7-b646-b130-9ddfd662d371 Ancestors: CommandLine-ct.23 Complements ToolBuilder-Kernel-ct.166 (UIManager>>#inform:title:). =============== Diff against CommandLine-ct.23 =============== Item was added: + ----- Method: DummyUIManager>>inform:title: (in category 'ui requests') ----- + inform: aString title: titleString + "Nothing to be done here" + self askForProvidedAnswerTo: aString ifSupplied: [:answer | + ^ answer].!

1 0

Review Request: base32.4.cs
by christoph.thiede＠student.hpi.uni-potsdam.de 01 Jun '23

01 Jun '23

=============== Summary =============== Change Set: base32 Date: 18 May 2023 Author: Christoph Thiede Adds support for base32 encoding and decoding. Adds Base32MimeConverter class and subsumes it with existing Base64MimeConverter class under new abstract RFC4648MimeConverter class. Adds #base32Encoded and #base32Decoded on String and String+ByteArray, resp. Adds convenient MimeConverter class>>#mimeDecode:. Tests new converter in new Base32MimeConverterTest and subsumes it with existing Base64MimeConverterTest under new abstract RFC4648MimeConverterTest. =============== Diff =============== Base32MimeConverter + nil subclass: #Base32MimeConverter + instanceVariableNames: '' + classVariableNames: 'FromCharTable ToCharTable' + poolDictionaries: '' + category: 'Collections-Streams' + + Base32MimeConverter class + instanceVariableNames: '' + + "I encode and decode data in base32 format. I translate a whole stream at once, taking a Stream as input and giving one as output, and answer a whole stream for the sender to use. 0 A 8 I 16 Q 24 Y 1 B 9 J 17 R 25 Z 2 C 10 K 18 S 26 2 3 D 11 L 19 T 27 3 4 E 12 M 20 U 28 4 5 F 13 N 21 V 29 5 6 G 14 O 22 W 30 6 7 H 15 P 23 X 31 7 (pad) = Outbound: bytes are broken into 5 bit chunks, and the 0-31 value is converted to a character. 5 data bytes go into 8 characters. Inbound: Characters are translated in to 0-31 values and shifted into 8 bit bytes." Base32MimeConverter class>>initialize {class initialization} · ct 5/18/2023 16:07 + initialize + + FromCharTable := Array new: 256. "nils" + ToCharTable := ($A to: $Z) , ($2 to: $7) , '='. + ToCharTable keysAndValuesDo: [:ind :char | + FromCharTable at: char asciiValue + 1 put: ind - 1]. Base32MimeConverter>>fromCharTable {private} · ct 5/18/2023 19:47 + fromCharTable + + ^ FromCharTable Base32MimeConverter>>mimeDecode {conversion} · ct 5/18/2023 19:49 + mimeDecode + "Convert the stream in base 32 with only A-Z,2-7 to a full byte stream of characters. Answer a whole stream for the user to read." + + | nibA nibB nibC nibD nibE nibF nibG nibH | + [mimeStream atEnd] whileFalse: [ + (nibA := self nextValue) ifNil: [^ dataStream]. + (nibB := self nextValue) ifNil: [^ dataStream]. + dataStream nextPut: ((nibA bitShift: 3) + (nibB bitShift: -2)) asCharacter. + nibB := nibB bitAnd: 16r3. + (nibC := self nextValue) ifNil: [^ dataStream]. + (nibD := self nextValue) ifNil: [^ dataStream]. + dataStream nextPut: ((nibB bitShift: 6) + (nibC bitShift: 1) + (nibD bitShift: -4)) asCharacter. + nibD := nibD bitAnd: 16rF. + (nibE := self nextValue) ifNil: [^ dataStream]. + dataStream nextPut: ((nibD bitShift: 4) + (nibE bitShift: -1)) asCharacter. + nibE := nibE bitAnd: 16r1. + (nibF := self nextValue) ifNil: [^ dataStream]. + (nibG := self nextValue) ifNil: [^ dataStream]. + dataStream nextPut: ((nibE bitShift: 7) + (nibF bitShift: 2) + (nibG bitShift: -3)) asCharacter. + nibG := nibG bitAnd: 16r7. + (nibH := self nextValue) ifNil: [^ dataStream]. + dataStream nextPut: ((nibG bitShift: 5) + nibH) asCharacter. + ]. + ^ dataStream Base32MimeConverter>>mimeDecodeToByteArray {conversion} · ct 5/18/2023 19:49 + mimeDecodeToByteArray + "Convert the stream in base 32 with only A-Z,2-7 to a full ByteArray of 0-255 values. Answer a whole stream for the user to read." + + | nibA nibB nibC nibD nibE nibF nibG nibH | + [mimeStream atEnd] whileFalse: [ + (nibA := self nextValue) ifNil: [^ dataStream]. + (nibB := self nextValue) ifNil: [^ dataStream]. + dataStream nextPut: ((nibA bitShift: 3) + (nibB bitShift: -2)). + nibB := nibB bitAnd: 16r3. + (nibC := self nextValue) ifNil: [^ dataStream]. + (nibD := self nextValue) ifNil: [^ dataStream]. + dataStream nextPut: ((nibB bitShift: 6) + (nibC bitShift: 1) + (nibD bitShift: -4)). + nibD := nibD bitAnd: 16rF. + (nibE := self nextValue) ifNil: [^ dataStream]. + dataStream nextPut: ((nibD bitShift: 4) + (nibE bitShift: -1)). + nibE := nibE bitAnd: 16r1. + (nibF := self nextValue) ifNil: [^ dataStream]. + (nibG := self nextValue) ifNil: [^ dataStream]. + dataStream nextPut: ((nibE bitShift: 7) + (nibF bitShift: 2) + (nibG bitShift: -3)). + nibG := nibG bitAnd: 16r7. + (nibH := self nextValue) ifNil: [^ dataStream]. + dataStream nextPut: ((nibG bitShift: 5) + nibH). + ]. + ^ dataStream Base32MimeConverter>>mimeEncode {conversion} · ct 5/18/2023 19:12 + mimeEncode + "Convert from data to 5 bit characters." + + | padding raw nib lineLength | + padding := nil. + lineLength := 0. + [dataStream atEnd] whileFalse: [ + (multiLine and:[lineLength >= 70]) ifTrue: [ mimeStream cr. lineLength := 0. ]. + data := raw := dataStream next asInteger. + nib := (data bitAnd: 16rF8) bitShift: -3. "1111 1000" + mimeStream nextPut: (ToCharTable at: nib+1). + (raw := dataStream next) ifNil: [raw := 0. padding := -6]. + data := ((data bitAnd: 7) bitShift: 8) + raw asInteger. "0000 0111" + nib := (data bitAnd: 16r7C0) bitShift: -6. "0000 0111 1100 0000" + mimeStream nextPut: (ToCharTable at: nib+1). + nib := (data bitAnd: 16r3E) bitShift: -1. "0011 1110" + mimeStream nextPut: (ToCharTable at: nib+1). + (raw := dataStream next) ifNil: [raw := 0. padding ifNil: [padding := -4]]. + data := ((data bitAnd: 1) bitShift: 8) + (raw asInteger). "0000 0001" + nib := (data bitAnd: 16r1F0) bitShift: -4. "0000 0001 1111 0000" + mimeStream nextPut: (ToCharTable at: nib+1). + (raw := dataStream next) ifNil: [raw := 0. padding ifNil: [padding := -3]]. + data := ((data bitAnd: 16rF) bitShift: 8) + (raw asInteger). "0000 1111" + nib := (data bitAnd: 16rF80) bitShift: -7. "0000 1111 1000 0000" + mimeStream nextPut: (ToCharTable at: nib+1). + nib := (data bitAnd: 16r7C) bitShift: -2. "0111 1100" + mimeStream nextPut: (ToCharTable at: nib+1). + (raw := dataStream next) ifNil: [raw := 0. padding ifNil: [padding := -1]]. + data := ((data bitAnd: 3) bitShift: 8) + (raw asInteger). "0000 0011" + nib := (data bitAnd: 16r3E0) bitShift: -5. "0000 0011 1110 0000" + mimeStream nextPut: (ToCharTable at: nib+1). + nib := (data bitAnd: 16r1F). "0001 1111" + mimeStream nextPut: (ToCharTable at: nib+1). + + lineLength := lineLength + 8.]. + + padding ifNotNil: [ + mimeStream skip: padding. + padding to: -1 do: [:i | mimeStream nextPut: $=]. + ^ mimeStream]. Base32MimeConverterTest + nil subclass: #Base32MimeConverterTest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'CollectionsTests-Streams' + + Base32MimeConverterTest class + instanceVariableNames: '' + + "" Base32MimeConverterTest>>testBase32Encoded {tests} · ct 5/18/2023 20:08 + testBase32Encoded + + | encoded | + encoded := (self classToBeTested mimeEncode: message) contents. + self assert: string base32Encoded equals: encoded. Base32MimeConverterTest>>testMimeEncodeDecode {tests} · ct 5/18/2023 20:10 + testMimeEncodeDecode + + | encoded | + encoded := self classToBeTested mimeEncode: message. + self assert: 'JBUSAVDIMVZGKII=' equals: encoded contents. + self assert: message contents equals: (self classToBeTested mimeDecodeToChars: encoded) contents. + + "Encoding should start from the beginning of the stream." + message reset. + message skip: 2. + encoded := self classToBeTested mimeEncode: message. + self assert: 'JBUSAVDIMVZGKII=' equals: encoded contents. + + "Encoding should start from the current position of the stream." + message reset. + message skip: 2. + encoded := self classToBeTested mimeEncodeContinue: message. + self assert: 'EBKGQZLSMUQQ====' equals: encoded contents. Base32MimeConverterTest>>testMimeEncodeDecodeMultiLine {tests} · ct 5/18/2023 20:07 + testMimeEncodeDecodeMultiLine + + | encoded | + encoded := (self classToBeTested mimeEncode: (String new: 100 withAll: $a) readStream) contents. + self assert: encoded = + 'MFQWCYLBMFQWCYLBMFQWCYLBMFQWCYLBMFQWCYLBMFQWCYLBMFQWCYLBMFQWCYLBMFQWCYLB + MFQWCYLBMFQWCYLBMFQWCYLBMFQWCYLBMFQWCYLBMFQWCYLBMFQWCYLBMFQWCYLBMFQWCYLB + MFQWCYLBMFQWCYLB'. + + encoded := (self classToBeTested mimeEncode: (String new: 100 withAll: $a) readStream multiLine: false) contents. + self assert: encoded = + 'MFQWCYLBMFQWCYLBMFQWCYLBMFQWCYLBMFQWCYLBMFQWCYLBMFQWCYLBMFQWCYLBMFQWCYLBMFQWCYLBMFQWCYLBMFQWCYLBMFQWCYLBMFQWCYLBMFQWCYLBMFQWCYLBMFQWCYLBMFQWCYLBMFQWCYLBMFQWCYLB'. Base32MimeConverterTest>>testOnByteArray {tests} · ct 5/18/2023 20:07 + testOnByteArray + + self assert: string base32Encoded = string asByteArray base32Encoded. Base64MimeConverter (changed) - MimeConverter subclass: #Base64MimeConverter - instanceVariableNames: 'data multiLine' + nil subclass: #Base64MimeConverter + instanceVariableNames: '' classVariableNames: 'FromCharTable ToCharTable' poolDictionaries: '' category: 'Collections-Streams' Base64MimeConverter class instanceVariableNames: '' "This class encodes and decodes data in Base64 format. This is MIME encoding. We translate a whole stream at once, taking a Stream as input and giving one as output. Returns a whole stream for the caller to use. 0 A 17 R 34 i 51 z 1 B 18 S 35 j 52 0 2 C 19 T 36 k 53 1 3 D 20 U 37 l 54 2 4 E 21 V 38 m 55 3 5 F 22 W 39 n 56 4 6 G 23 X 40 o 57 5 7 H 24 Y 41 p 58 6 8 I 25 Z 42 q 59 7 9 J 26 a 43 r 60 8 10 K 27 b 44 s 61 9 11 L 28 c 45 t 62 + 12 M 29 d 46 u 63 / 13 N 30 e 47 v 14 O 31 f 48 w (pad) = 15 P 32 g 49 x 16 Q 33 h 50 y Outbound: bytes are broken into 6 bit chunks, and the 0-63 value is converted to a character. 3 data bytes go into 4 characters. Inbound: Characters are translated in to 0-63 values and shifted into 8 bit bytes. (See: N. Borenstein, Bellcore, N. Freed, Innosoft, Network Working Group, Request for Comments: RFC 1521, September 1993, MIME (Multipurpose Internet Mail Extensions) Part One: Mechanisms for Specifying and Describing the Format of Internet Message Bodies. Sec 6.2) By Ted Kaehler, based on Tim Olson's Base64Filter." Base64MimeConverter class>>decodeInteger: {convenience} · tk 2/19/2000 15:53 (removed) - decodeInteger: mimeString - | bytes sum | - "Decode the MIME string into an integer of any length" - - bytes := (Base64MimeConverter mimeDecodeToBytes: - (ReadStream on: mimeString)) contents. - sum := 0. - bytes reverseDo: [:by | sum := sum * 256 + by]. - ^ sum Base64MimeConverter class>>encodeInteger: {convenience} · nice 7/26/2014 23:00 (removed) - encodeInteger: int - | strm | - "Encode an integer of any length and return the MIME string" - - strm := WriteStream on: (ByteArray new: int digitLength). - 1 to: int digitLength do: [:ii | strm nextPut: (int digitAt: ii)]. - ^ ((self mimeEncode: strm readStream) contents) copyUpTo: $= "remove padding" Base64MimeConverter class>>mimeDecodeToBytes: {convenience} · nice 7/26/2014 23:03 (removed) - mimeDecodeToBytes: aStream - "Return a ReadStream of the original ByteArray. aStream has only 65 innocuous character values. aStream is not binary. (See class comment). 4 bytes in aStream goes to 3 bytes in output." - - | me | - aStream position: 0. - me := self new mimeStream: aStream. - me dataStream: (WriteStream on: (ByteArray new: aStream size * 3 // 4)). - me mimeDecodeToByteArray. - ^ me dataStream readStream Base64MimeConverter class>>mimeDecodeToChars: {convenience} · nice 7/26/2014 23:01 (removed) - mimeDecodeToChars: aStream - "Return a ReadWriteStream of the original String. aStream has only 65 innocuous character values. It is not binary. (See class comment). 4 bytes in aStream goes to 3 bytes in output." - - | me | - aStream position: 0. - me := self new mimeStream: aStream. - me dataStream: (WriteStream on: (String new: aStream size * 3 // 4)). - me mimeDecode. - ^ me dataStream readStream Base64MimeConverter class>>mimeEncode: {convenience} · ar 3/9/2010 22:17 (removed) - mimeEncode: aStream - "Return a ReadWriteStream of characters. The data of aStream is encoded as 65 innocuous characters. (See class comment). 3 bytes in aStream goes to 4 bytes in output." - ^self mimeEncode: aStream multiLine: true atStart: true Base64MimeConverter class>>mimeEncode:multiLine: {convenience} · ar 3/9/2010 22:17 (removed) - mimeEncode: aStream multiLine: aBool - "Return a ReadWriteStream of characters. The data of aStream is encoded as 65 innocuous characters. (See class comment). 3 bytes in aStream goes to 4 bytes in output." - - ^self mimeEncode: aStream multiLine: aBool atStart: true Base64MimeConverter class>>mimeEncode:multiLine:atStart: {private - convenience} · nice 7/26/2014 22:59 (removed) - mimeEncode: aStream multiLine: aBool atStart: resetInput - "Return a ReadStream of characters. The data of aStream is encoded as 65 innocuous characters. (See class comment). 3 bytes in aStream goes to 4 bytes in output." - - | me | - resetInput ifTrue:[aStream position: 0]. - me := self new dataStream: aStream. - me multiLine: aBool. - me mimeStream: (WriteStream on: (String new: aStream size + 20 * 4 // 3)). - me mimeEncode. - ^ me mimeStream readStream Base64MimeConverter class>>mimeEncodeContinue: {private - convenience} · ar 3/9/2010 22:17 (removed) - mimeEncodeContinue: aStream - "Return a ReadWriteStream of characters. The data of aStream is encoded as 65 innocuous characters. (See class comment). 3 bytes in aStream goes to 4 bytes in output." - ^self mimeEncode: aStream multiLine: true atStart: false Base64MimeConverter>>fromCharTable {private} · ct 5/18/2023 19:47 + fromCharTable + + ^ FromCharTable Base64MimeConverter>>mimeDecode {conversion} · ct 5/18/2023 19:49 (changed) mimeDecode - "Convert a stream in base 64 with only a-z,A-Z,0-9,+,/ to a full byte stream of characters. Return a whole stream for the user to read." + "Convert the stream in base 64 with only a-z,A-Z,0-9,+,/ to a full byte stream of characters. Answer a whole stream for the user to read." | nibA nibB nibC nibD | [mimeStream atEnd] whileFalse: [ (nibA := self nextValue) ifNil: [^ dataStream]. (nibB := self nextValue) ifNil: [^ dataStream]. dataStream nextPut: ((nibA bitShift: 2) + (nibB bitShift: -4)) asCharacter. nibB := nibB bitAnd: 16rF. (nibC := self nextValue) ifNil: [^ dataStream]. dataStream nextPut: ((nibB bitShift: 4) + (nibC bitShift: -2)) asCharacter. nibC := nibC bitAnd: 16r3. (nibD := self nextValue) ifNil: [^ dataStream]. dataStream nextPut: ((nibC bitShift: 6) + nibD) asCharacter. ]. ^ dataStream Base64MimeConverter>>mimeDecodeToByteArray {conversion} · ct 5/18/2023 19:50 (changed) mimeDecodeToByteArray - "Convert a stream in base 64 with only a-z,A-Z,0-9,+,/ to a full ByteArray of 0-255 values. Return a whole stream for the user to read." + "Convert the stream in base 64 with only a-z,A-Z,0-9,+,/ to a full ByteArray of 0-255 values. Answer a whole stream for the user to read." | nibA nibB nibC nibD | [mimeStream atEnd] whileFalse: [ (nibA := self nextValue) ifNil: [^ dataStream]. (nibB := self nextValue) ifNil: [^ dataStream]. dataStream nextPut: ((nibA bitShift: 2) + (nibB bitShift: -4)). nibB := nibB bitAnd: 16rF. (nibC := self nextValue) ifNil: [^ dataStream]. dataStream nextPut: ((nibB bitShift: 4) + (nibC bitShift: -2)). nibC := nibC bitAnd: 16r3. (nibD := self nextValue) ifNil: [^ dataStream]. dataStream nextPut: ((nibC bitShift: 6) + nibD). ]. ^ dataStream Base64MimeConverterTest (changed) - TestCase subclass: #Base64MimeConverterTest - instanceVariableNames: 'message' + nil subclass: #Base64MimeConverterTest + instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'CollectionsTests-Streams' Base64MimeConverterTest class instanceVariableNames: '' "This is the unit test for the class Base64MimeConverter. Unit tests are a good way to exercise the functionality of your system in a repeatable and automatic manner. They are therefore recommended if you plan to release anything. For more information, see: - http://www.c2.com/cgi/wiki?UnitTest - http://minnow.cc.gatech.edu/squeak/1547 - the sunit class category" Base64MimeConverterTest>>testBase64Encoded {tests} · ct 5/18/2023 20:09 (changed) testBase64Encoded + | encoded | - encoded := (Base64MimeConverter mimeEncode: message) contents. - self assert: encoded = 'Hi There!' base64Encoded. - + encoded := (self classToBeTested mimeEncode: message) contents. + self assert: string base64Encoded equals: encoded. Base64MimeConverterTest>>testMimeEncodeDecode {tests} · ct 5/18/2023 20:10 (changed) testMimeEncodeDecode | encoded | - encoded := Base64MimeConverter mimeEncode: message. - self assert: (encoded contents = 'SGkgVGhlcmUh'). - self assert: ((Base64MimeConverter mimeDecodeToChars: encoded) contents = message contents). - + encoded := self classToBeTested mimeEncode: message. + self assert: 'SGkgVGhlcmUh' equals: encoded contents. + self assert: message contents equals: (self classToBeTested mimeDecodeToChars: encoded) contents. + "Encoding should start from the beginning of the stream." message reset. message skip: 2. - encoded := Base64MimeConverter mimeEncode: message. - self assert: (encoded contents = 'SGkgVGhlcmUh'). + encoded := self classToBeTested mimeEncode: message. + self assert: 'SGkgVGhlcmUh' equals: encoded contents. "Encoding should start from the current position of the stream." message reset. message skip: 2. - encoded := Base64MimeConverter mimeEncodeContinue: message. - self assert: (encoded contents = 'IFRoZXJlIQ=='). + encoded := self classToBeTested mimeEncodeContinue: message. + self assert: 'IFRoZXJlIQ==' equals: encoded contents. Base64MimeConverterTest>>testMimeEncodeDecodeMultiLine {tests} · ct 5/18/2023 20:11 (changed) testMimeEncodeDecodeMultiLine | encoded | - encoded := (Base64MimeConverter mimeEncode: (String new: 100 withAll: $a) readStream) contents. + encoded := (self classToBeTested mimeEncode: (String new: 100 withAll: $a) readStream) contents. self assert: encoded = 'YWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFh YWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYQ=='. - - encoded := (Base64MimeConverter mimeEncode: (String new: 100 withAll: $a) readStream multiLine: false) contents. + + encoded := (self classToBeTested mimeEncode: (String new: 100 withAll: $a) readStream multiLine: false) contents. self assert: encoded = - 'YWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYQ=='. + 'YWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYQ=='. Base64MimeConverterTest>>testOnByteArray {tests} · ct 5/18/2023 20:11 (changed) testOnByteArray - self assert: ('Hi There!' base64Encoded = 'Hi There!' asByteArray base64Encoded) + + self assert: string base64Encoded = string asByteArray base64Encoded. ByteArray>>base32Encoded {converting} · ct 5/18/2023 17:46 + base32Encoded + "Encode the receiver as base32" + "'Hello World' asByteArray base32Encoded" + ^(Base32MimeConverter mimeEncode: self readStream) contents MimeConverter class>>mimeDecode: {convenience} · ct 5/18/2023 20:21 + mimeDecode: aCollectionOrStream + + ^ String streamContents: [:out | + self mimeDecode: aCollectionOrStream to: out] RFC4648MimeConverter + MimeConverter subclass: #RFC4648MimeConverter + instanceVariableNames: 'data multiLine' + classVariableNames: '' + poolDictionaries: '' + category: 'Collections-Streams' + + RFC4648MimeConverter class + instanceVariableNames: '' + + "I am the abstract superclass for power-of-two-base mime converters according to RFC4648. We translate a whole stream at once, taking a Stream as input and giving one as output, and answer a whole stream for the sender to use." RFC4648MimeConverter class>>decodeInteger: {convenience} · ct 5/18/2023 19:50 + decodeInteger: mimeString + "Decode the MIME string into an integer of any length" + + | bytes sum | + bytes := (self mimeDecodeToBytes: + (ReadStream on: mimeString)) contents. + sum := 0. + bytes reverseDo: [:by | sum := sum * 256 + by]. + ^ sum RFC4648MimeConverter class>>encodeInteger: {convenience} · ct 5/18/2023 19:51 + encodeInteger: anInteger + "Encode anInteger of any length and return the MIME string" + + | stream | + stream := WriteStream on: (ByteArray new: anInteger digitLength). + 1 to: anInteger digitLength do: [:ii | stream nextPut: (anInteger digitAt: ii)]. + ^ ((self mimeEncode: stream readStream) contents) copyUpTo: $= "remove padding" RFC4648MimeConverter class>>mimeDecodeToBytes: {convenience} · ct 5/18/2023 19:53 + mimeDecodeToBytes: aStream + "Return a ReadStream of the original ByteArray. aStream has only 33/65/... innocuous character values. aStream is not binary. (See class comment). 8/4/... bytes in aStream goes to 5/3/... bytes in output." + + | me | + aStream position: 0. + me := self new mimeStream: aStream. + me dataStream: (WriteStream on: (ByteArray new: aStream size * 3 // 4)). + me mimeDecodeToByteArray. + ^ me dataStream readStream RFC4648MimeConverter class>>mimeDecodeToChars: {convenience} · ct 5/18/2023 19:54 + mimeDecodeToChars: aStream + "Return a ReadWriteStream of the original String. aStream has only 33/65/... innocuous character values. It is not binary. (See class comment). 8/4/... bytes in aStream goes to 5/3/... bytes in output." + + | me | + aStream position: 0. + me := self new mimeStream: aStream. + me dataStream: (WriteStream on: (String new: aStream size * 3 // 4)). + me mimeDecode. + ^ me dataStream readStream RFC4648MimeConverter class>>mimeEncode: {convenience} · ct 5/18/2023 19:54 + mimeEncode: aStream + "Return a ReadWriteStream of characters. The data of aStream is encoded as 33/65/... innocuous characters. (See class comment). 5/3/... bytes in aStream goes to 8/4/... bytes in output." + self flag: #suspicious. "ct: All other classes answer a String, just this one answers a ReadStream. Unfortunately, expectations of senders are inconsistent as well ..." + ^self mimeEncode: aStream multiLine: true atStart: true RFC4648MimeConverter class>>mimeEncode:multiLine: {convenience} · ct 5/18/2023 19:55 + mimeEncode: aStream multiLine: aBool + "Return a ReadWriteStream of characters. The data of aStream is encoded as 33/65/... innocuous characters. (See class comment). 5/3/... bytes in aStream goes to 8/4/... bytes in output." + + ^self mimeEncode: aStream multiLine: aBool atStart: true RFC4648MimeConverter class>>mimeEncode:multiLine:atStart: {private - convenience} · ct 5/18/2023 19:55 + mimeEncode: aStream multiLine: aBool atStart: resetInput + "Return a ReadStream of characters. The data of aStream is encoded as 33/65/... innocuous characters. (See class comment). 5/3/... bytes in aStream goes to 8/4/... bytes in output." + + | me | + resetInput ifTrue:[aStream position: 0]. + me := self new dataStream: aStream. + me multiLine: aBool. + me mimeStream: (WriteStream on: (String new: aStream size + 20 * 4 // 3)). + me mimeEncode. + ^ me mimeStream readStream RFC4648MimeConverter class>>mimeEncodeContinue: {private - convenience} · ct 5/18/2023 19:55 + mimeEncodeContinue: aStream + "Return a ReadWriteStream of characters. The data of aStream is encoded as 33/65/... innocuous characters. (See class comment). 5/3/... bytes in aStream goes to 8/4/... bytes in output." + ^self mimeEncode: aStream multiLine: true atStart: false RFC4648MimeConverter>>fromCharTable {private} · ct 5/18/2023 19:46 + fromCharTable + + ^ self subclassResponsibility RFC4648MimeConverter>>mimeDecode {conversion} · ct 5/18/2023 19:48 + mimeDecode + "Convert the stream in the respective base to a full byte stream of characters. Answer a whole stream for the user to read." + + ^ self subclassResponsibility RFC4648MimeConverter>>mimeDecodeToByteArray {conversion} · ct 5/18/2023 19:49 + mimeDecodeToByteArray + "Convert the stream in the respective base to a full ByteArray of 0-255 values. Answer a whole stream for the user to read." + + ^ self subclassResponsibility RFC4648MimeConverter>>mimeEncode {conversion} · ct 5/18/2023 19:45 + mimeEncode + "Convert from data to n bit characters." + + ^ self subclassResponsibility RFC4648MimeConverter>>multiLine {accessing} · ar 4/15/2008 17:58 + multiLine + "Determines whether we allow multi-line encodings (the default) or force everything into a single line (for use with URLs etc. where the continuation marker and the line break cause problems)" + ^multiLine RFC4648MimeConverter>>multiLine: {accessing} · ar 4/15/2008 17:58 + multiLine: aBool + "Determines whether we allow multi-line encodings (the default) or force everything into a single line (for use with URLs etc. where the continuation marker and the line break cause problems)" + multiLine := aBool RFC4648MimeConverter>>nextValue {conversion} · ct 5/18/2023 19:46 + nextValue + "The next n bits of data char from the mimeStream, or nil. Skip all other chars" + | raw num | + [raw := mimeStream next. + raw ifNil: [^ nil]. "end of stream" + raw == $= ifTrue: [^ nil]. + num := self fromCharTable at: raw asciiValue + 1. + num ifNotNil: [^ num]. + "else ignore space, return, tab, ..." + ] repeat RFC4648MimeConverterTest + ClassTestCase subclass: #RFC4648MimeConverterTest + instanceVariableNames: 'string message' + classVariableNames: '' + poolDictionaries: '' + category: 'CollectionsTests-Streams' + + RFC4648MimeConverterTest class + instanceVariableNames: '' + + "" RFC4648MimeConverterTest class>>isAbstract {testing} · ct 5/18/2023 20:08 + isAbstract + + ^ self name = #RFC4648MimeConverterTest RFC4648MimeConverterTest>>setUp {running} · ct 5/18/2023 20:04 + setUp + string := 'Hi There!'. + message := string readStream. String>>base32Decoded {converting} · ct 5/18/2023 19:38 + base32Decoded + "Decode the receiver from base 32" + "'JBSWY3DPEBLW64TMMQ======' base32Decoded" + ^ Base32MimeConverter mimeDecode: self as: self class String>>base32Encoded {converting} · ct 5/18/2023 19:15 + base32Encoded + "Encode the receiver as base32" + "'Hello World' base32Encoded" + + ^(Base32MimeConverter + mimeEncode: (ReadStream on: self) + multiLine: false) contents StringTest>>testBase32 {tests - converting} · ct 5/18/2023 20:15 + testBase32 + + self + assert: 'JBSWY3DPEBLW64TMMQ======' base32Decoded = 'Hello World'; + assert: 'Hello World' base32Encoded = 'JBSWY3DPEBLW64TMMQ======'; + assert: (String new: 100 withAll: $x) base32Encoded = 'PB4HQ6DYPB4HQ6DYPB4HQ6DYPB4HQ6DYPB4HQ6DYPB4HQ6DYPB4HQ6DYPB4HQ6DYPB4HQ6DYPB4HQ6DYPB4HQ6DYPB4HQ6DYPB4HQ6DYPB4HQ6DYPB4HQ6DYPB4HQ6DYPB4HQ6DYPB4HQ6DYPB4HQ6DYPB4HQ6DY'. --- Sent from Squeak Inbox Talk ["base32.4.cs"]

3 3

The Trunk: CollectionsTests-ct.396.mcz
by commits＠source.squeak.org 01 Jun '23

01 Jun '23

Christoph Thiede uploaded a new version of CollectionsTests to project The Trunk: http://source.squeak.org/trunk/CollectionsTests-ct.396.mcz ==================== Summary ==================== Name: CollectionsTests-ct.396 Author: ct Time: 1 June 2023, 9:40:49.988127 pm UUID: 03b74a4e-4cf7-0b45-ade9-044f785faba8 Ancestors: CollectionsTests-ct.395 Complements Collections-ct.1041 (Base32MimeConverter). =============== Diff against CollectionsTests-ct.395 =============== Item was added: + RFC4648MimeConverterTest subclass: #Base32MimeConverterTest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'CollectionsTests-Streams'! Item was added: + ----- Method: Base32MimeConverterTest>>testBase32Encoded (in category 'tests') ----- + testBase32Encoded + + | encoded | + encoded := (self classToBeTested mimeEncode: message) contents. + self assert: string base32Encoded equals: encoded.! Item was added: + ----- Method: Base32MimeConverterTest>>testMimeEncodeDecode (in category 'tests') ----- + testMimeEncodeDecode + + | encoded | + encoded := self classToBeTested mimeEncode: message. + self assert: 'JBUSAVDIMVZGKII=' equals: encoded contents. + self assert: message contents equals: (self classToBeTested mimeDecodeToChars: encoded) contents. + + "Encoding should start from the beginning of the stream." + message reset. + message skip: 2. + encoded := self classToBeTested mimeEncode: message. + self assert: 'JBUSAVDIMVZGKII=' equals: encoded contents. + + "Encoding should start from the current position of the stream." + message reset. + message skip: 2. + encoded := self classToBeTested mimeEncodeContinue: message. + self assert: 'EBKGQZLSMUQQ====' equals: encoded contents.! Item was added: + ----- Method: Base32MimeConverterTest>>testMimeEncodeDecodeMultiLine (in category 'tests') ----- + testMimeEncodeDecodeMultiLine + + | encoded | + encoded := (self classToBeTested mimeEncode: (String new: 100 withAll: $a) readStream) contents. + self assert: encoded = + 'MFQWCYLBMFQWCYLBMFQWCYLBMFQWCYLBMFQWCYLBMFQWCYLBMFQWCYLBMFQWCYLBMFQWCYLB + MFQWCYLBMFQWCYLBMFQWCYLBMFQWCYLBMFQWCYLBMFQWCYLBMFQWCYLBMFQWCYLBMFQWCYLB + MFQWCYLBMFQWCYLB'. + + encoded := (self classToBeTested mimeEncode: (String new: 100 withAll: $a) readStream multiLine: false) contents. + self assert: encoded = + 'MFQWCYLBMFQWCYLBMFQWCYLBMFQWCYLBMFQWCYLBMFQWCYLBMFQWCYLBMFQWCYLBMFQWCYLBMFQWCYLBMFQWCYLBMFQWCYLBMFQWCYLBMFQWCYLBMFQWCYLBMFQWCYLBMFQWCYLBMFQWCYLBMFQWCYLBMFQWCYLB'.! Item was added: + ----- Method: Base32MimeConverterTest>>testOnByteArray (in category 'tests') ----- + testOnByteArray + + self assert: string base32Encoded = string asByteArray base32Encoded.! Item was changed: + RFC4648MimeConverterTest subclass: #Base64MimeConverterTest + instanceVariableNames: '' - TestCase subclass: #Base64MimeConverterTest - instanceVariableNames: 'message' classVariableNames: '' poolDictionaries: '' category: 'CollectionsTests-Streams'! !Base64MimeConverterTest commentStamp: '<historical>' prior: 0! This is the unit test for the class Base64MimeConverter. Unit tests are a good way to exercise the functionality of your system in a repeatable and automatic manner. They are therefore recommended if you plan to release anything. For more information, see: - http://www.c2.com/cgi/wiki?UnitTest - http://minnow.cc.gatech.edu/squeak/1547 - the sunit class category! Item was removed: - ----- Method: Base64MimeConverterTest>>setUp (in category 'running') ----- - setUp - message := 'Hi There!!' readStream. - ! Item was changed: ----- Method: Base64MimeConverterTest>>testBase64Encoded (in category 'tests') ----- testBase64Encoded + | encoded | + encoded := (self classToBeTested mimeEncode: message) contents. + self assert: string base64Encoded equals: encoded.! - encoded := (Base64MimeConverter mimeEncode: message) contents. - self assert: encoded = 'Hi There!!' base64Encoded. - ! Item was changed: ----- Method: Base64MimeConverterTest>>testMimeEncodeDecode (in category 'tests') ----- testMimeEncodeDecode | encoded | + encoded := self classToBeTested mimeEncode: message. + self assert: 'SGkgVGhlcmUh' equals: encoded contents. + self assert: message contents equals: (self classToBeTested mimeDecodeToChars: encoded) contents. + - encoded := Base64MimeConverter mimeEncode: message. - self assert: (encoded contents = 'SGkgVGhlcmUh'). - self assert: ((Base64MimeConverter mimeDecodeToChars: encoded) contents = message contents). - "Encoding should start from the beginning of the stream." message reset. message skip: 2. + encoded := self classToBeTested mimeEncode: message. + self assert: 'SGkgVGhlcmUh' equals: encoded contents. - encoded := Base64MimeConverter mimeEncode: message. - self assert: (encoded contents = 'SGkgVGhlcmUh'). "Encoding should start from the current position of the stream." message reset. message skip: 2. + encoded := self classToBeTested mimeEncodeContinue: message. + self assert: 'IFRoZXJlIQ==' equals: encoded contents.! - encoded := Base64MimeConverter mimeEncodeContinue: message. - self assert: (encoded contents = 'IFRoZXJlIQ==').! Item was changed: ----- Method: Base64MimeConverterTest>>testMimeEncodeDecodeMultiLine (in category 'tests') ----- testMimeEncodeDecodeMultiLine | encoded | + encoded := (self classToBeTested mimeEncode: (String new: 100 withAll: $a) readStream) contents. - encoded := (Base64MimeConverter mimeEncode: (String new: 100 withAll: $a) readStream) contents. self assert: encoded = 'YWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFh YWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYQ=='. + + encoded := (self classToBeTested mimeEncode: (String new: 100 withAll: $a) readStream multiLine: false) contents. - - encoded := (Base64MimeConverter mimeEncode: (String new: 100 withAll: $a) readStream multiLine: false) contents. self assert: encoded = + 'YWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYQ=='.! - 'YWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYQ=='. - ! Item was changed: ----- Method: Base64MimeConverterTest>>testOnByteArray (in category 'tests') ----- testOnByteArray + + self assert: string base64Encoded = string asByteArray base64Encoded.! - self assert: ('Hi There!!' base64Encoded = 'Hi There!!' asByteArray base64Encoded)! Item was added: + ClassTestCase subclass: #RFC4648MimeConverterTest + instanceVariableNames: 'string message' + classVariableNames: '' + poolDictionaries: '' + category: 'CollectionsTests-Streams'! Item was added: + ----- Method: RFC4648MimeConverterTest class>>isAbstract (in category 'testing') ----- + isAbstract + + ^ self name = #RFC4648MimeConverterTest! Item was added: + ----- Method: RFC4648MimeConverterTest>>setUp (in category 'running') ----- + setUp + string := 'Hi There!!'. + message := string readStream. + ! Item was added: + ----- Method: StringTest>>testBase32 (in category 'tests - converting') ----- + testBase32 + + self + assert: 'JBSWY3DPEBLW64TMMQ======' base32Decoded = 'Hello World'; + assert: 'Hello World' base32Encoded = 'JBSWY3DPEBLW64TMMQ======'; + assert: (String new: 100 withAll: $x) base32Encoded = 'PB4HQ6DYPB4HQ6DYPB4HQ6DYPB4HQ6DYPB4HQ6DYPB4HQ6DYPB4HQ6DYPB4HQ6DYPB4HQ6DYPB4HQ6DYPB4HQ6DYPB4HQ6DYPB4HQ6DYPB4HQ6DYPB4HQ6DYPB4HQ6DYPB4HQ6DYPB4HQ6DYPB4HQ6DYPB4HQ6DY'.!

1 0

The Trunk: Collections-ct.1041.mcz
by commits＠source.squeak.org 01 Jun '23

01 Jun '23

Christoph Thiede uploaded a new version of Collections to project The Trunk: http://source.squeak.org/trunk/Collections-ct.1041.mcz ==================== Summary ==================== Name: Collections-ct.1041 Author: ct Time: 1 June 2023, 9:40:33.122127 pm UUID: b55600ad-c59d-5840-b2fb-398b2377c8e0 Ancestors: Collections-mt.1040 Merges base32.4.cs: Adds support for base32 encoding and decoding. Adds Base32MimeConverter class and subsumes it with existing Base64MimeConverter class under new abstract RFC4648MimeConverter class. Adds #base32Encoded and #base32Decoded on String and String+ByteArray, resp. Adds convenient MimeConverter class>>#mimeDecode:. Tests new converter in new Base32MimeConverterTest and subsumes it with existing Base64MimeConverterTest under new abstract RFC4648MimeConverterTest. Revision: Minor commentary improvements. =============== Diff against Collections-mt.1040 =============== Item was added: + RFC4648MimeConverter subclass: #Base32MimeConverter + instanceVariableNames: '' + classVariableNames: 'FromCharTable ToCharTable' + poolDictionaries: '' + category: 'Collections-Streams'! + + !Base32MimeConverter commentStamp: 'ct 5/18/2023 20:28' prior: 0! + I encode and decode data in base32 format. I translate a whole stream at once, taking a Stream as input and giving one as output, and answer a whole stream for the sender to use. + 0 A 8 I 16 Q 24 Y + 1 B 9 J 17 R 25 Z + 2 C 10 K 18 S 26 2 + 3 D 11 L 19 T 27 3 + 4 E 12 M 20 U 28 4 + 5 F 13 N 21 V 29 5 + 6 G 14 O 22 W 30 6 + 7 H 15 P 23 X 31 7 + (pad) = + Outbound: bytes are broken into 5 bit chunks, and the 0-31 value is converted to a character. 5 data bytes go into 8 characters. + Inbound: Characters are translated in to 0-31 values and shifted into 8 bit bytes.! Item was added: + ----- Method: Base32MimeConverter class>>initialize (in category 'class initialization') ----- + initialize + + FromCharTable := Array new: 256. "nils" + ToCharTable := ($A to: $Z) , ($2 to: $7) , '='. + ToCharTable keysAndValuesDo: [:ind :char | + FromCharTable at: char asciiValue + 1 put: ind - 1].! Item was added: + ----- Method: Base32MimeConverter>>fromCharTable (in category 'private') ----- + fromCharTable + + ^ FromCharTable! Item was added: + ----- Method: Base32MimeConverter>>mimeDecode (in category 'conversion') ----- + mimeDecode + "Convert the stream in base 32 with only A-Z,2-7 to a full byte stream of characters. Answer a whole stream for the user to read." + + | nibA nibB nibC nibD nibE nibF nibG nibH | + [mimeStream atEnd] whileFalse: [ + (nibA := self nextValue) ifNil: [^ dataStream]. + (nibB := self nextValue) ifNil: [^ dataStream]. + dataStream nextPut: ((nibA bitShift: 3) + (nibB bitShift: -2)) asCharacter. + nibB := nibB bitAnd: 16r3. + (nibC := self nextValue) ifNil: [^ dataStream]. + (nibD := self nextValue) ifNil: [^ dataStream]. + dataStream nextPut: ((nibB bitShift: 6) + (nibC bitShift: 1) + (nibD bitShift: -4)) asCharacter. + nibD := nibD bitAnd: 16rF. + (nibE := self nextValue) ifNil: [^ dataStream]. + dataStream nextPut: ((nibD bitShift: 4) + (nibE bitShift: -1)) asCharacter. + nibE := nibE bitAnd: 16r1. + (nibF := self nextValue) ifNil: [^ dataStream]. + (nibG := self nextValue) ifNil: [^ dataStream]. + dataStream nextPut: ((nibE bitShift: 7) + (nibF bitShift: 2) + (nibG bitShift: -3)) asCharacter. + nibG := nibG bitAnd: 16r7. + (nibH := self nextValue) ifNil: [^ dataStream]. + dataStream nextPut: ((nibG bitShift: 5) + nibH) asCharacter. + ]. + ^ dataStream! Item was added: + ----- Method: Base32MimeConverter>>mimeDecodeToByteArray (in category 'conversion') ----- + mimeDecodeToByteArray + "Convert the stream in base 32 with only A-Z,2-7 to a full ByteArray of 0-255 values. Answer a whole stream for the user to read." + + | nibA nibB nibC nibD nibE nibF nibG nibH | + [mimeStream atEnd] whileFalse: [ + (nibA := self nextValue) ifNil: [^ dataStream]. + (nibB := self nextValue) ifNil: [^ dataStream]. + dataStream nextPut: ((nibA bitShift: 3) + (nibB bitShift: -2)). + nibB := nibB bitAnd: 16r3. + (nibC := self nextValue) ifNil: [^ dataStream]. + (nibD := self nextValue) ifNil: [^ dataStream]. + dataStream nextPut: ((nibB bitShift: 6) + (nibC bitShift: 1) + (nibD bitShift: -4)). + nibD := nibD bitAnd: 16rF. + (nibE := self nextValue) ifNil: [^ dataStream]. + dataStream nextPut: ((nibD bitShift: 4) + (nibE bitShift: -1)). + nibE := nibE bitAnd: 16r1. + (nibF := self nextValue) ifNil: [^ dataStream]. + (nibG := self nextValue) ifNil: [^ dataStream]. + dataStream nextPut: ((nibE bitShift: 7) + (nibF bitShift: 2) + (nibG bitShift: -3)). + nibG := nibG bitAnd: 16r7. + (nibH := self nextValue) ifNil: [^ dataStream]. + dataStream nextPut: ((nibG bitShift: 5) + nibH). + ]. + ^ dataStream! Item was added: + ----- Method: Base32MimeConverter>>mimeEncode (in category 'conversion') ----- + mimeEncode + "Convert from data to 5 bit characters." + + | padding raw nib lineLength | + padding := nil. + lineLength := 0. + [dataStream atEnd] whileFalse: [ + (multiLine and:[lineLength >= 70]) ifTrue: [ mimeStream cr. lineLength := 0. ]. + data := raw := dataStream next asInteger. + nib := (data bitAnd: 16rF8) bitShift: -3. "1111 1000" + mimeStream nextPut: (ToCharTable at: nib+1). + (raw := dataStream next) ifNil: [raw := 0. padding := -6]. + data := ((data bitAnd: 7) bitShift: 8) + raw asInteger. "0000 0111" + nib := (data bitAnd: 16r7C0) bitShift: -6. "0000 0111 1100 0000" + mimeStream nextPut: (ToCharTable at: nib+1). + nib := (data bitAnd: 16r3E) bitShift: -1. "0011 1110" + mimeStream nextPut: (ToCharTable at: nib+1). + (raw := dataStream next) ifNil: [raw := 0. padding ifNil: [padding := -4]]. + data := ((data bitAnd: 1) bitShift: 8) + (raw asInteger). "0000 0001" + nib := (data bitAnd: 16r1F0) bitShift: -4. "0000 0001 1111 0000" + mimeStream nextPut: (ToCharTable at: nib+1). + (raw := dataStream next) ifNil: [raw := 0. padding ifNil: [padding := -3]]. + data := ((data bitAnd: 16rF) bitShift: 8) + (raw asInteger). "0000 1111" + nib := (data bitAnd: 16rF80) bitShift: -7. "0000 1111 1000 0000" + mimeStream nextPut: (ToCharTable at: nib+1). + nib := (data bitAnd: 16r7C) bitShift: -2. "0111 1100" + mimeStream nextPut: (ToCharTable at: nib+1). + (raw := dataStream next) ifNil: [raw := 0. padding ifNil: [padding := -1]]. + data := ((data bitAnd: 3) bitShift: 8) + (raw asInteger). "0000 0011" + nib := (data bitAnd: 16r3E0) bitShift: -5. "0000 0011 1110 0000" + mimeStream nextPut: (ToCharTable at: nib+1). + nib := (data bitAnd: 16r1F). "0001 1111" + mimeStream nextPut: (ToCharTable at: nib+1). + + lineLength := lineLength + 8.]. + + padding ifNotNil: [ + mimeStream skip: padding. + padding to: -1 do: [:i | mimeStream nextPut: $=]. + ^ mimeStream].! Item was changed: + RFC4648MimeConverter subclass: #Base64MimeConverter + instanceVariableNames: '' - MimeConverter subclass: #Base64MimeConverter - instanceVariableNames: 'data multiLine' classVariableNames: 'FromCharTable ToCharTable' poolDictionaries: '' category: 'Collections-Streams'! !Base64MimeConverter commentStamp: '<historical>' prior: 0! This class encodes and decodes data in Base64 format. This is MIME encoding. We translate a whole stream at once, taking a Stream as input and giving one as output. Returns a whole stream for the caller to use. 0 A 17 R 34 i 51 z 1 B 18 S 35 j 52 0 2 C 19 T 36 k 53 1 3 D 20 U 37 l 54 2 4 E 21 V 38 m 55 3 5 F 22 W 39 n 56 4 6 G 23 X 40 o 57 5 7 H 24 Y 41 p 58 6 8 I 25 Z 42 q 59 7 9 J 26 a 43 r 60 8 10 K 27 b 44 s 61 9 11 L 28 c 45 t 62 + 12 M 29 d 46 u 63 / 13 N 30 e 47 v 14 O 31 f 48 w (pad) = 15 P 32 g 49 x 16 Q 33 h 50 y Outbound: bytes are broken into 6 bit chunks, and the 0-63 value is converted to a character. 3 data bytes go into 4 characters. Inbound: Characters are translated in to 0-63 values and shifted into 8 bit bytes. (See: N. Borenstein, Bellcore, N. Freed, Innosoft, Network Working Group, Request for Comments: RFC 1521, September 1993, MIME (Multipurpose Internet Mail Extensions) Part One: Mechanisms for Specifying and Describing the Format of Internet Message Bodies. Sec 6.2) By Ted Kaehler, based on Tim Olson's Base64Filter.! Item was removed: - ----- Method: Base64MimeConverter class>>decodeInteger: (in category 'convenience') ----- - decodeInteger: mimeString - | bytes sum | - "Decode the MIME string into an integer of any length" - - bytes := (Base64MimeConverter mimeDecodeToBytes: - (ReadStream on: mimeString)) contents. - sum := 0. - bytes reverseDo: [:by | sum := sum * 256 + by]. - ^ sum! Item was removed: - ----- Method: Base64MimeConverter class>>encodeInteger: (in category 'convenience') ----- - encodeInteger: int - | strm | - "Encode an integer of any length and return the MIME string" - - strm := WriteStream on: (ByteArray new: int digitLength). - 1 to: int digitLength do: [:ii | strm nextPut: (int digitAt: ii)]. - ^ ((self mimeEncode: strm readStream) contents) copyUpTo: $= "remove padding"! Item was removed: - ----- Method: Base64MimeConverter class>>mimeDecodeToBytes: (in category 'convenience') ----- - mimeDecodeToBytes: aStream - "Return a ReadStream of the original ByteArray. aStream has only 65 innocuous character values. aStream is not binary. (See class comment). 4 bytes in aStream goes to 3 bytes in output." - - | me | - aStream position: 0. - me := self new mimeStream: aStream. - me dataStream: (WriteStream on: (ByteArray new: aStream size * 3 // 4)). - me mimeDecodeToByteArray. - ^ me dataStream readStream! Item was removed: - ----- Method: Base64MimeConverter class>>mimeDecodeToChars: (in category 'convenience') ----- - mimeDecodeToChars: aStream - "Return a ReadWriteStream of the original String. aStream has only 65 innocuous character values. It is not binary. (See class comment). 4 bytes in aStream goes to 3 bytes in output." - - | me | - aStream position: 0. - me := self new mimeStream: aStream. - me dataStream: (WriteStream on: (String new: aStream size * 3 // 4)). - me mimeDecode. - ^ me dataStream readStream! Item was removed: - ----- Method: Base64MimeConverter class>>mimeEncode: (in category 'convenience') ----- - mimeEncode: aStream - "Return a ReadWriteStream of characters. The data of aStream is encoded as 65 innocuous characters. (See class comment). 3 bytes in aStream goes to 4 bytes in output." - ^self mimeEncode: aStream multiLine: true atStart: true! Item was removed: - ----- Method: Base64MimeConverter class>>mimeEncode:multiLine: (in category 'convenience') ----- - mimeEncode: aStream multiLine: aBool - "Return a ReadWriteStream of characters. The data of aStream is encoded as 65 innocuous characters. (See class comment). 3 bytes in aStream goes to 4 bytes in output." - - ^self mimeEncode: aStream multiLine: aBool atStart: true! Item was removed: - ----- Method: Base64MimeConverter class>>mimeEncode:multiLine:atStart: (in category 'private - convenience') ----- - mimeEncode: aStream multiLine: aBool atStart: resetInput - "Return a ReadStream of characters. The data of aStream is encoded as 65 innocuous characters. (See class comment). 3 bytes in aStream goes to 4 bytes in output." - - | me | - resetInput ifTrue:[aStream position: 0]. - me := self new dataStream: aStream. - me multiLine: aBool. - me mimeStream: (WriteStream on: (String new: aStream size + 20 * 4 // 3)). - me mimeEncode. - ^ me mimeStream readStream! Item was removed: - ----- Method: Base64MimeConverter class>>mimeEncodeContinue: (in category 'private - convenience') ----- - mimeEncodeContinue: aStream - "Return a ReadWriteStream of characters. The data of aStream is encoded as 65 innocuous characters. (See class comment). 3 bytes in aStream goes to 4 bytes in output." - ^self mimeEncode: aStream multiLine: true atStart: false! Item was added: + ----- Method: Base64MimeConverter>>fromCharTable (in category 'private') ----- + fromCharTable + + ^ FromCharTable! Item was changed: ----- Method: Base64MimeConverter>>mimeDecode (in category 'conversion') ----- mimeDecode + "Convert the stream in base 64 with only a-z,A-Z,0-9,+,/ to a full byte stream of characters. Answer a whole stream for the user to read." - "Convert a stream in base 64 with only a-z,A-Z,0-9,+,/ to a full byte stream of characters. Return a whole stream for the user to read." | nibA nibB nibC nibD | [mimeStream atEnd] whileFalse: [ (nibA := self nextValue) ifNil: [^ dataStream]. (nibB := self nextValue) ifNil: [^ dataStream]. dataStream nextPut: ((nibA bitShift: 2) + (nibB bitShift: -4)) asCharacter. nibB := nibB bitAnd: 16rF. (nibC := self nextValue) ifNil: [^ dataStream]. dataStream nextPut: ((nibB bitShift: 4) + (nibC bitShift: -2)) asCharacter. nibC := nibC bitAnd: 16r3. (nibD := self nextValue) ifNil: [^ dataStream]. dataStream nextPut: ((nibC bitShift: 6) + nibD) asCharacter. ]. ^ dataStream! Item was changed: ----- Method: Base64MimeConverter>>mimeDecodeToByteArray (in category 'conversion') ----- mimeDecodeToByteArray + "Convert the stream in base 64 with only a-z,A-Z,0-9,+,/ to a full ByteArray of 0-255 values. Answer a whole stream for the user to read." - "Convert a stream in base 64 with only a-z,A-Z,0-9,+,/ to a full ByteArray of 0-255 values. Return a whole stream for the user to read." | nibA nibB nibC nibD | [mimeStream atEnd] whileFalse: [ (nibA := self nextValue) ifNil: [^ dataStream]. (nibB := self nextValue) ifNil: [^ dataStream]. dataStream nextPut: ((nibA bitShift: 2) + (nibB bitShift: -4)). nibB := nibB bitAnd: 16rF. (nibC := self nextValue) ifNil: [^ dataStream]. dataStream nextPut: ((nibB bitShift: 4) + (nibC bitShift: -2)). nibC := nibC bitAnd: 16r3. (nibD := self nextValue) ifNil: [^ dataStream]. dataStream nextPut: ((nibC bitShift: 6) + nibD). ]. ^ dataStream! Item was removed: - ----- Method: Base64MimeConverter>>multiLine (in category 'accessing') ----- - multiLine - "Determines whether we allow multi-line encodings (the default) or force everything into a single line (for use with URLs etc. where the continuation marker and the line break cause problems)" - ^multiLine! Item was removed: - ----- Method: Base64MimeConverter>>multiLine: (in category 'accessing') ----- - multiLine: aBool - "Determines whether we allow multi-line encodings (the default) or force everything into a single line (for use with URLs etc. where the continuation marker and the line break cause problems)" - multiLine := aBool! Item was removed: - ----- Method: Base64MimeConverter>>nextValue (in category 'conversion') ----- - nextValue - "The next six bits of data char from the mimeStream, or nil. Skip all other chars" - | raw num | - [raw := mimeStream next. - raw ifNil: [^ nil]. "end of stream" - raw == $= ifTrue: [^ nil]. - num := FromCharTable at: raw asciiValue + 1. - num ifNotNil: [^ num]. - "else ignore space, return, tab, ..." - ] repeat! Item was added: + ----- Method: ByteArray>>base32Encoded (in category 'converting') ----- + base32Encoded + "Encode the receiver as base32" + "'Hello World' asByteArray base32Encoded" + ^(Base32MimeConverter mimeEncode: self readStream) contents! Item was added: + ----- Method: MimeConverter class>>mimeDecode: (in category 'convenience') ----- + mimeDecode: aCollectionOrStream + + ^ String streamContents: [:out | + self mimeDecode: aCollectionOrStream to: out]! Item was added: + MimeConverter subclass: #RFC4648MimeConverter + instanceVariableNames: 'data multiLine' + classVariableNames: '' + poolDictionaries: '' + category: 'Collections-Streams'! + + !RFC4648MimeConverter commentStamp: 'ct 5/18/2023 20:28' prior: 0! + I am the abstract superclass for power-of-two-base mime converters according to RFC4648. We translate a whole stream at once, taking a Stream as input and giving one as output, and answer a whole stream for the sender to use.! Item was added: + ----- Method: RFC4648MimeConverter class>>decodeInteger: (in category 'convenience') ----- + decodeInteger: mimeString + "Decode the MIME string into an integer of any length" + + | bytes sum | + bytes := (self mimeDecodeToBytes: + (ReadStream on: mimeString)) contents. + sum := 0. + bytes reverseDo: [:by | sum := sum * 256 + by]. + ^ sum! Item was added: + ----- Method: RFC4648MimeConverter class>>encodeInteger: (in category 'convenience') ----- + encodeInteger: anInteger + "Encode anInteger of any length and return the MIME string" + + | stream | + stream := WriteStream on: (ByteArray new: anInteger digitLength). + 1 to: anInteger digitLength do: [:ii | stream nextPut: (anInteger digitAt: ii)]. + ^ ((self mimeEncode: stream readStream) contents) copyUpTo: $= "remove padding"! Item was added: + ----- Method: RFC4648MimeConverter class>>mimeDecodeToBytes: (in category 'convenience') ----- + mimeDecodeToBytes: aStream + "Answer a ReadStream of the original ByteArray. aStream has only 33/65/... innocuous character values. aStream is not binary. (See class comment). 8/4/... bytes in aStream goes to 5/3/... bytes in output." + + | me | + aStream position: 0. + me := self new mimeStream: aStream. + me dataStream: (WriteStream on: (ByteArray new: aStream size * 3 // 4)). + me mimeDecodeToByteArray. + ^ me dataStream readStream! Item was added: + ----- Method: RFC4648MimeConverter class>>mimeDecodeToChars: (in category 'convenience') ----- + mimeDecodeToChars: aStream + "Answer a ReadWriteStream of the original String. aStream has only 33/65/... innocuous character values. It is not binary. (See class comment). 8/4/... bytes in aStream goes to 5/3/... bytes in output." + + | me | + aStream position: 0. + me := self new mimeStream: aStream. + me dataStream: (WriteStream on: (String new: aStream size * 3 // 4)). + me mimeDecode. + ^ me dataStream readStream! Item was added: + ----- Method: RFC4648MimeConverter class>>mimeEncode: (in category 'convenience') ----- + mimeEncode: aStream + "Answer a ReadWriteStream of characters. The data of aStream is encoded as 33/65/... innocuous characters. (See class comment). 5/3/... bytes in aStream goes to 8/4/... bytes in output." + self flag: #suspicious. "ct: All other classes answer a String, just this one answers a ReadStream. Unfortunately, expectations of senders are inconsistent as well ..." + ^self mimeEncode: aStream multiLine: true atStart: true! Item was added: + ----- Method: RFC4648MimeConverter class>>mimeEncode:multiLine: (in category 'convenience') ----- + mimeEncode: aStream multiLine: aBool + "Answer a ReadWriteStream of characters. The data of aStream is encoded as 33/65/... innocuous characters. (See class comment). 5/3/... bytes in aStream goes to 8/4/... bytes in output." + + ^self mimeEncode: aStream multiLine: aBool atStart: true! Item was added: + ----- Method: RFC4648MimeConverter class>>mimeEncode:multiLine:atStart: (in category 'private - convenience') ----- + mimeEncode: aStream multiLine: aBool atStart: resetInput + "Answer a ReadStream of characters. The data of aStream is encoded as 33/65/... innocuous characters. (See class comment). 5/3/... bytes in aStream goes to 8/4/... bytes in output." + + | me | + resetInput ifTrue:[aStream position: 0]. + me := self new dataStream: aStream. + me multiLine: aBool. + me mimeStream: (WriteStream on: (String new: aStream size + 20 * 4 // 3)). + me mimeEncode. + ^ me mimeStream readStream! Item was added: + ----- Method: RFC4648MimeConverter class>>mimeEncodeContinue: (in category 'private - convenience') ----- + mimeEncodeContinue: aStream + "Answer a ReadWriteStream of characters. The data of aStream is encoded as 33/65/... innocuous characters. (See class comment). 5/3/... bytes in aStream goes to 8/4/... bytes in output." + ^self mimeEncode: aStream multiLine: true atStart: false! Item was added: + ----- Method: RFC4648MimeConverter>>fromCharTable (in category 'private') ----- + fromCharTable + + ^ self subclassResponsibility! Item was added: + ----- Method: RFC4648MimeConverter>>mimeDecode (in category 'conversion') ----- + mimeDecode + "Convert the stream in the respective base to a full byte stream of characters. Answer a whole stream for the user to read." + + ^ self subclassResponsibility! Item was added: + ----- Method: RFC4648MimeConverter>>mimeDecodeToByteArray (in category 'conversion') ----- + mimeDecodeToByteArray + "Convert the stream in the respective base to a full ByteArray of 0-255 values. Answer a whole stream for the user to read." + + ^ self subclassResponsibility! Item was added: + ----- Method: RFC4648MimeConverter>>mimeEncode (in category 'conversion') ----- + mimeEncode + "Convert from data to n bit characters." + + ^ self subclassResponsibility! Item was added: + ----- Method: RFC4648MimeConverter>>multiLine (in category 'accessing') ----- + multiLine + "Determines whether we allow multi-line encodings (the default) or force everything into a single line (for use with URLs etc. where the continuation marker and the line break cause problems)" + ^multiLine! Item was added: + ----- Method: RFC4648MimeConverter>>multiLine: (in category 'accessing') ----- + multiLine: aBool + "Determines whether we allow multi-line encodings (the default) or force everything into a single line (for use with URLs etc. where the continuation marker and the line break cause problems)" + multiLine := aBool! Item was added: + ----- Method: RFC4648MimeConverter>>nextValue (in category 'conversion') ----- + nextValue + "The next n bits of data char from the mimeStream, or nil. Skip all other chars" + | raw num | + [raw := mimeStream next. + raw ifNil: [^ nil]. "end of stream" + raw == $= ifTrue: [^ nil]. + num := self fromCharTable at: raw asciiValue + 1. + num ifNotNil: [^ num]. + "else ignore space, return, tab, ..." + ] repeat! Item was added: + ----- Method: String>>base32Decoded (in category 'converting') ----- + base32Decoded + "Decode the receiver from base 32" + "'JBSWY3DPEBLW64TMMQ======' base32Decoded" + ^ Base32MimeConverter mimeDecode: self as: self class! Item was added: + ----- Method: String>>base32Encoded (in category 'converting') ----- + base32Encoded + "Encode the receiver as base32" + "'Hello World' base32Encoded" + + ^(Base32MimeConverter + mimeEncode: (ReadStream on: self) + multiLine: false) contents!

1 0

The Trunk: Monticello-ct.789.mcz
by commits＠source.squeak.org 01 Jun '23

01 Jun '23

Christoph Thiede uploaded a new version of Monticello to project The Trunk: http://source.squeak.org/trunk/Monticello-ct.789.mcz ==================== Summary ==================== Name: Monticello-ct.789 Author: ct Time: 1 June 2023, 9:16:11.900127 pm UUID: 2d6fc220-50da-4b43-94b0-601b35ae8d5b Ancestors: Monticello-tpr.788 Merges mcAddAnythingToChangeSet.2.cs: Makes 'add (all) to current change set' in Monticello code tools capable of class and script definitions. Revision: Uses separate 'change set' category for new selectors. =============== Diff against Monticello-tpr.788 =============== Item was added: + ----- Method: MCAddition>>addToChangeSet: (in category 'change sets') ----- + addToChangeSet: aChangeSet + + ^ self definition addToChangeSet: aChangeSet! Item was added: + ----- Method: MCClassDefinition>>addRemovalToChangeSet: (in category 'change sets') ----- + addRemovalToChangeSet: aChangeSet + + aChangeSet noteRemovalOf: self className.! Item was added: + ----- Method: MCClassDefinition>>addToChangeSet: (in category 'change sets') ----- + addToChangeSet: aChangeSet + + aChangeSet + addClass: self actualClass; + commentClass: self actualClass.! Item was added: + ----- Method: MCDefinition>>addRemovalToChangeSet: (in category 'change sets') ----- + addRemovalToChangeSet: aChangeSet + + ^ self subclassResponsibility! Item was added: + ----- Method: MCDefinition>>addToChangeSet: (in category 'change sets') ----- + addToChangeSet: aChangeSet + + ^ self subclassResponsibility! Item was added: + ----- Method: MCMethodDefinition>>addRemovalToChangeSet: (in category 'change sets') ----- + addRemovalToChangeSet: aChangeSet + + aChangeSet removeSelector: self selector class: self actualClass priorMethod: nil lastMethodInfo: nil.! Item was added: + ----- Method: MCMethodDefinition>>addToChangeSet: (in category 'change sets') ----- + addToChangeSet: aChangeSet + + aChangeSet adoptSelector: self selector forClass: self actualClass.! Item was added: + ----- Method: MCModification>>addToChangeSet: (in category 'change sets') ----- + addToChangeSet: aChangeSet + + ^ self definition addToChangeSet: aChangeSet! Item was changed: ----- Method: MCOperationsBrowser>>adoptMessageInCurrentChangeset (in category 'menus') ----- adoptMessageInCurrentChangeset + (selection ifNotNil: [{selection}] ifNil: [items]) + do: [:item | item addToChangeSet: ChangeSet current]. - selection ifNotNil: [^ super adoptMessageInCurrentChangeset]. - - items select: [:each | each definition isMethodDefinition] thenDo: [:item | - self forItem: item setClassAndSelectorIn: [:class :selector | - ((item isAddition or: [item isModification]) and: [class includesSelector: selector]) - ifTrue: [ChangeSet current adoptSelector: selector forClass: class]. - item isRemoval - ifTrue: [ChangeSet current removeSelector: selector class: class priorMethod: nil lastMethodInfo: nil]]]. self changed: #annotations.! Item was changed: ----- Method: MCOperationsBrowser>>methodListMenu: (in category 'menus') ----- methodListMenu: aMenu selection ifNil: [items ifNotEmpty: [ aMenu addList: #( ('add all to current change set' adoptMessageInCurrentChangeset))]] ifNotNil: [aMenu addList: #( ('install' installSelection) ('revert (x)' revertSelection) ('browse origin' browseSelectionOrigin) -)]. self unchangedMethods ifNotEmpty: [aMenu addList: #( ('revert unchanged methods...' revertUnchangedMethods) ('filter out unchanged methods...' filterOutUnchangedMethods) -)]. super methodListMenu: aMenu. + self selectedMessageName ifNil: + [aMenu addList: #( + ('add to current change set' adoptMessageInCurrentChangeset))]. ^ aMenu! Item was added: + ----- Method: MCPatchOperation>>addToChangeSet: (in category 'change sets') ----- + addToChangeSet: aChangeSet + + ^ self subclassResponsibility! Item was added: + ----- Method: MCPatchOperation>>applyTo: (in category 'applying') ----- + applyTo: anObject + + ^ self subclassResponsibility! Item was added: + ----- Method: MCPostscriptDefinition>>addToChangeSet: (in category 'change sets') ----- + addToChangeSet: aChangeSet + + super addToChangeSet: aChangeSet. + aChangeSet + assurePostscriptExists; + postscript: aChangeSet postscript , ('\"{1}"\{2}.' withCRs format: {self packageName. self script}).! Item was added: + ----- Method: MCPreambleDefinition>>addToChangeSet: (in category 'change sets') ----- + addToChangeSet: aChangeSet + + super addToChangeSet: aChangeSet. + aChangeSet + assurePreambleExists; + preamble: aChangeSet preamble , ('\\"{1}"\{2}.' withCRs format: {self packageName. self script}).! Item was added: + ----- Method: MCRemoval>>addToChangeSet: (in category 'change sets') ----- + addToChangeSet: aChangeSet + + ^ self definition addRemovalToChangeSet: aChangeSet! Item was changed: + ----- Method: MCRemoval>>applyTo: (in category 'applying') ----- - ----- Method: MCRemoval>>applyTo: (in category 'accessing') ----- applyTo: anObject anObject removeDefinition: definition! Item was changed: ----- Method: MCSaveVersionDialog>>adoptMessageInCurrentChangeset (in category 'menus') ----- adoptMessageInCurrentChangeset selection ifNotNil: [^ super adoptMessageInCurrentChangeset]. + (items copyWithoutAll: ignore) do: [:item | item addToChangeSet: ChangeSet current]. - (items copyWithoutAll: ignore) select: [:each | each definition isMethodDefinition] thenDo: [:item | - self forItem: item setClassAndSelectorIn: [:class :selector | - ((item isAddition or: [item isModification]) and: [class includesSelector: selector]) - ifTrue: [ChangeSet current adoptSelector: selector forClass: class]. - item isRemoval - ifTrue: [ChangeSet current removeSelector: selector class: class priorMethod: nil lastMethodInfo: nil]]]. self changed: #annotations.! Item was added: + ----- Method: MCScriptDefinition>>addRemovalToChangeSet: (in category 'change sets') ----- + addRemovalToChangeSet: aChangeSet + + ^ self addToChangeSet: aChangeSet script: ''! Item was added: + ----- Method: MCScriptDefinition>>addToChangeSet: (in category 'change sets') ----- + addToChangeSet: aChangeSet + + ^ self addToChangeSet: aChangeSet script: self script! Item was added: + ----- Method: MCScriptDefinition>>addToChangeSet:script: (in category 'change sets') ----- + addToChangeSet: aChangeSet script: aString + + aChangeSet + assurePostscriptExists; + postscript: aChangeSet postscript , ('<n><n>(PackageInfo named: <1p>) <2s>: <3p>.' expandMacrosWithArguments: {self packageName. self scriptSelector. aString}).!

1 0

Review Request: mcAddAnythingToChangeSet.1.cs
by christoph.thiede＠student.hpi.uni-potsdam.de 01 Jun '23

01 Jun '23

=============== Summary =============== Change Set: mcAddAnythingToChangeSet Date: 18 May 2023 Author: Christoph Thiede Makes 'add (all) to current change set' in Monticello code tools capable of class and script definitions. =============== Diff =============== ChangeSet>>noteRemovalOf: {class changes} · ct 5/18/2023 22:25 (changed) noteRemovalOf: class "The class is about to be removed from the system. Adjust the receiver to reflect that fact." - class wantsChangeSetLogging ifFalse: [^ self]. + | c ccname | + class isString + ifTrue: [c := self environment classNamed: class. ccname := class , ' class'] + ifFalse: [c := class. ccname := class class name]. + (c notNil and: [c wantsChangeSetLogging not]) ifTrue: [^ self]. (self changeRecorderFor: class) - noteChangeType: #remove fromClass: class. - changeRecords removeKey: class class name ifAbsent: []. + noteChangeType: #remove fromClass: c. + changeRecords removeKey: ccname ifAbsent: []. MCAddition>>addToChangeSet: {applying} · ct 5/18/2023 21:33 + addToChangeSet: aChangeSet + + ^ self definition addToChangeSet: aChangeSet MCClassDefinition>>addRemovalToChangeSet: {installing} · ct 5/18/2023 22:21 + addRemovalToChangeSet: aChangeSet + + aChangeSet noteRemovalOf: self className. MCClassDefinition>>addToChangeSet: {installing} · ct 5/18/2023 21:45 + addToChangeSet: aChangeSet + + aChangeSet addClass: self actualClass. MCDefinition>>addRemovalToChangeSet: {installing} · ct 5/18/2023 21:34 + addRemovalToChangeSet: aChangeSet + + ^ self subclassResponsibility MCDefinition>>addToChangeSet: {installing} · ct 5/18/2023 21:34 + addToChangeSet: aChangeSet + + ^ self subclassResponsibility MCMethodDefinition>>addRemovalToChangeSet: {installing} · ct 5/18/2023 21:44 + addRemovalToChangeSet: aChangeSet + + aChangeSet removeSelector: self selector class: self actualClass priorMethod: nil lastMethodInfo: nil. MCMethodDefinition>>addToChangeSet: {installing} · ct 5/18/2023 21:42 + addToChangeSet: aChangeSet + + aChangeSet adoptSelector: self selector forClass: self actualClass. MCModification>>addToChangeSet: {applying} · ct 5/18/2023 21:33 + addToChangeSet: aChangeSet + + ^ self definition addToChangeSet: aChangeSet MCOperationsBrowser>>adoptMessageInCurrentChangeset {menus} · ct 5/18/2023 22:06 (changed) adoptMessageInCurrentChangeset - selection ifNotNil: [^ super adoptMessageInCurrentChangeset]. - - items select: [:each | each definition isMethodDefinition] thenDo: [:item | - self forItem: item setClassAndSelectorIn: [:class :selector | - ((item isAddition or: [item isModification]) and: [class includesSelector: selector]) - ifTrue: [ChangeSet current adoptSelector: selector forClass: class]. - item isRemoval - ifTrue: [ChangeSet current removeSelector: selector class: class priorMethod: nil lastMethodInfo: nil]]]. + (selection ifNotNil: [{selection}] ifNil: [items]) + do: [:item | item addToChangeSet: ChangeSet current]. self changed: #annotations. MCOperationsBrowser>>methodListMenu: {menus} · ct 5/18/2023 22:15 (changed) methodListMenu: aMenu selection ifNil: [items ifNotEmpty: [ aMenu addList: #( ('add all to current change set' adoptMessageInCurrentChangeset))]] ifNotNil: [aMenu addList: #( ('install' installSelection) ('revert (x)' revertSelection) ('browse origin' browseSelectionOrigin) -)]. self unchangedMethods ifNotEmpty: [aMenu addList: #( ('revert unchanged methods...' revertUnchangedMethods) ('filter out unchanged methods...' filterOutUnchangedMethods) -)]. super methodListMenu: aMenu. + self selectedMessageName ifNil: + [aMenu addList: #( + ('add to current change set' adoptMessageInCurrentChangeset))]. ^ aMenu MCPatchOperation>>addToChangeSet: {applying} · ct 5/18/2023 21:32 + addToChangeSet: aChangeSet + + ^ self subclassResponsibility MCPatchOperation>>applyTo: {applying} · ct 5/18/2023 21:30 + applyTo: anObject + + ^ self subclassResponsibility MCPostscriptDefinition>>addToChangeSet: {installing} · ct 5/18/2023 22:05 + addToChangeSet: aChangeSet + + super addToChangeSet: aChangeSet. + aChangeSet + assurePostscriptExists; + postscript: aChangeSet postscript , ('\"{1}"\{2}.' withCRs format: {self packageName. self script}). MCPreambleDefinition>>addToChangeSet: {installing} · ct 5/18/2023 22:07 + addToChangeSet: aChangeSet + + super addToChangeSet: aChangeSet. + aChangeSet + assurePreambleExists; + preamble: aChangeSet preamble , ('\\"{1}"\{2}.' withCRs format: {self packageName. self script}). MCRemoval>>addToChangeSet: {applying} · ct 5/18/2023 21:34 + addToChangeSet: aChangeSet + + ^ self definition addRemovalToChangeSet: aChangeSet MCRemoval>>applyTo: {applying} · ab 5/24/2003 16:11 (changed and recategorized) applyTo: anObject anObject removeDefinition: definition MCSaveVersionDialog>>adoptMessageInCurrentChangeset {menus} · ct 5/18/2023 22:00 (changed) adoptMessageInCurrentChangeset selection ifNotNil: [^ super adoptMessageInCurrentChangeset]. - (items copyWithoutAll: ignore) select: [:each | each definition isMethodDefinition] thenDo: [:item | - self forItem: item setClassAndSelectorIn: [:class :selector | - ((item isAddition or: [item isModification]) and: [class includesSelector: selector]) - ifTrue: [ChangeSet current adoptSelector: selector forClass: class]. - item isRemoval - ifTrue: [ChangeSet current removeSelector: selector class: class priorMethod: nil lastMethodInfo: nil]]]. + (items copyWithoutAll: ignore) do: [:item | item addToChangeSet: ChangeSet current]. self changed: #annotations. MCScriptDefinition>>addRemovalToChangeSet: {installing} · ct 5/18/2023 21:58 + addRemovalToChangeSet: aChangeSet + + ^ self addToChangeSet: aChangeSet script: '' MCScriptDefinition>>addToChangeSet: {installing} · ct 5/18/2023 21:58 + addToChangeSet: aChangeSet + + ^ self addToChangeSet: aChangeSet script: self script MCScriptDefinition>>addToChangeSet:script: {installing} · ct 5/18/2023 22:04 + addToChangeSet: aChangeSet script: aString + + aChangeSet + assurePostscriptExists; + postscript: aChangeSet postscript , ('<n><n>(PackageInfo named: <1p>) <2s>: <3p>.' expandMacrosWithArguments: {self packageName. self scriptSelector. aString}). --- Sent from Squeak Inbox Talk ["mcAddAnythingToChangeSet.1.cs"]

2 3

The Trunk: System-ct.1414.mcz
by commits＠source.squeak.org 01 Jun '23

01 Jun '23

Christoph Thiede uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-ct.1414.mcz ==================== Summary ==================== Name: System-ct.1414 Author: ct Time: 1 June 2023, 9:16:00.354127 pm UUID: 8e9106d6-a0a7-f84e-8c3d-7fc2fc7198dc Ancestors: System-ct.1413 Complements Monticello-ct.789. =============== Diff against System-ct.1413 =============== Item was changed: ----- Method: ChangeSet>>noteRemovalOf: (in category 'class changes') ----- noteRemovalOf: class "The class is about to be removed from the system. Adjust the receiver to reflect that fact." + | c ccname | + class isString + ifTrue: [c := self environment classNamed: class. ccname := class , ' class'] + ifFalse: [c := class. ccname := class class name]. + (c notNil and: [c wantsChangeSetLogging not]) ifTrue: [^ self]. - class wantsChangeSetLogging ifFalse: [^ self]. (self changeRecorderFor: class) + noteChangeType: #remove fromClass: c. + changeRecords removeKey: ccname ifAbsent: [].! - noteChangeType: #remove fromClass: class. - changeRecords removeKey: class class name ifAbsent: [].!

1 0

The Trunk: ToolBuilder-Morphic-ct.342.mcz
by commits＠source.squeak.org 01 Jun '23

01 Jun '23

Christoph Thiede uploaded a new version of ToolBuilder-Morphic to project The Trunk: http://source.squeak.org/trunk/ToolBuilder-Morphic-ct.342.mcz ==================== Summary ==================== Name: ToolBuilder-Morphic-ct.342 Author: ct Time: 20 May 2023, 8:36:35.416721 pm UUID: fe89f5d8-869f-854f-8b5d-7f897ac1cb54 Ancestors: ToolBuilder-Morphic-mt.341 Proposal: When opening them as tools, also attach regular morphs to the cursor depending on #openToolsAttachedToMouseCursor. Thus, opening non-window tools using the mouse feels more natural when the preference is enabled. For instance, TextMessageLink would benefit from this. "SketchMorph extraExampleCook openAsTool" =============== Diff against ToolBuilder-Morphic-mt.341 =============== Item was changed: ----- Method: Morph>>openAsTool (in category '*ToolBuilder-Morphic-opening') ----- openAsTool + "Open this morph as a tool, that is, honor the preference #openToolsAttachedToMouseCursor." + self openInWorld. + (Project uiManager openToolsAttachedToMouseCursor + and: [ | event | + event := self currentEvent. + event isMouse and: [event isMouseUp]]) + ifTrue: [ + self currentHand attachMorph: self].! - self openInWorld.!

1 0

Review Request: Color-fromString-css-function.1.cs
by christoph.thiede＠student.hpi.uni-potsdam.de 01 Jun '23

01 Jun '23

What do you think about that? Alternatively, I could parse these expressions from HtmlReadWriter, but I imagined they could be useful for other senders of Color fromString: as well. :-) Best, Christoph =============== Summary =============== Change Set: Color-fromString-css-function Date: 20 May 2023 Author: Christoph Thiede Adds support for basic CSS color functions to Color fromString:. This may be especially helpful for parsing HTML. While there are other color functions in CSS such as hsv(), lch(), oklab(), et al. for color models that we don't support, and CSS colors may be complex expressions, simple rgb() and argb() expressions are especially common. =============== Diff =============== Color class>>fromRGBAString: {other} · ct 5/19/2023 23:49 + fromRGBAString: rgba + "Do not call this method directly, call Color>>#fromString: instead as it is more generic" + + | alpha | + alpha := (Float readFrom:(rgba at: 4)) min: 1 max: 0. + ^ (self fromRGBString: rgba) + alpha: alpha Color class>>fromString: {instance creation} · ct 5/20/2023 18:40 (changed) fromString: aString "for HTML color spec: #FFCCAA or white/black/red/other name, or an r,g,b triplet string" "Color fromString: '#FFCCAA'. Color fromString: 'white'. Color fromString: 'orange' Color fromString: '126,42,33' " | aColorHex rgb| aString isEmptyOrNil ifTrue: [ ^self white ]. aString first = $# ifTrue: [ aColorHex := aString allButFirst ] ifFalse: [ aColorHex := aString ]. "is the string a 6 digit hex number?" ((aColorHex size = 6 or: [aColorHex size = 8]) and: [ aColorHex allSatisfy: [ :each | '0123456789ABCDEFabcdef' includes: each ] ]) ifTrue: [^ self fromHTMLString: aColorHex ]. + "is the string a CSS function?" + aString last = $) ifTrue: [ + "While there are other color functions in CSS such as hsv(), lch(), oklab(), et al. for color models that we don't support, and CSS colors may be complex expressions, simple rgb() and argb() expressions are especially common." + (aString beginsWith: 'rgb(') ifTrue: [ + rgb := ((aString allButLast allButFirst: 4) findTokens: $,) collect: #withBlanksTrimmed. + ^ self fromRGBString: rgb]. + (aString beginsWith: 'rgba(') ifTrue: [ + | rgba | + rgba := ((aString allButLast allButFirst: 5) findTokens: $,) collect: #withBlanksTrimmed. + ^ self fromRGBAString: rgba]. + self flag: #forLater. "support hsl and hsla" + ^ self white]. + "is the string in the form a,b,c ?" rgb := aColorHex findTokens: $, . rgb size = 3 ifTrue: [^ self fromRGBString: rgb]. "try to match aColorHex with known named colors, case insensitive" ^self perform: (ColorNames detect: [:colorSymbol | aColorHex sameAs: colorSymbol] ifNone: [ #white ]) ColorTest>>testFromString {tests} · ct 5/19/2023 23:48 (changed) testFromString self assert: ((Color fromString: '#FF8800') asHTMLColor sameAs: '#ff8800'); assert: ((Color fromString: 'FF8800') asHTMLColor sameAs: '#ff8800'); assert: ((Color fromString: '126,42,33') asHTMLColor sameAs: '#7E2A21'); assert: ((Color fromString: '00000000') asHTMLColor sameAs: '#00000000'); "html with alpha channel" assert: ((Color fromString: '#8C500BAE') asHTMLColor sameAs: '#8C500BAE'); assert: ((Color fromString: 'white') asHTMLColor sameAs: '#ffffff'); assert: ((Color fromString: 'black') asHTMLColor sameAs: '#000000'); assert: ((Color fromString: nil) asHTMLColor sameAs: '#ffffff'); assert: ((Color fromString: 'inexistent color') asHTMLColor sameAs: '#ffffff'); "should return white" assert: ((Color fromString: 'XXXXXX') asHTMLColor sameAs: '#ffffff') description: 'Color string should be alphanumeric'; assert: ((Color fromString: '000000000') asHTMLColor sameAs: '#ffffff') description: 'number string too long'. self assert: (Color fromString: 'DARKGRAY') = Color darkGray description: 'Color can be specified with a case insensitive color name'; - assert: (Color fromString: '#blue') = Color blue description: 'Color can be specified with a leading literal sharp'. + assert: (Color fromString: '#blue') = Color blue description: 'Color can be specified with a leading literal sharp'. + + self + assert: (Color fromString: 'rgb(12,34,56)') = (Color r: 12 g: 34 b: 56 range: 255); + assert: (Color fromString: 'rgba(12,34,56,0.78)') = ((Color r: 12 g: 34 b: 56 range: 255) alpha: 0.78). ["Color-fromString-css-function.1.cs"] --- Sent from Squeak Inbox Talk ["Color-fromString-css-function.1.cs"]

2 2