Packages December 2017

packages@lists.squeakfoundation.org

1 participants
92 discussions

The Trunk: Multilingual-pre.231.mcz
by commits＠source.squeak.org 07 Dec '17

07 Dec '17

Patrick Rein uploaded a new version of Multilingual to project The Trunk: http://source.squeak.org/trunk/Multilingual-pre.231.mcz ==================== Summary ==================== Name: Multilingual-pre.231 Author: pre Time: 7 December 2017, 12:14:14.664608 pm UUID: 79a4b260-626e-6449-a8dc-b36f278e03bc Ancestors: Multilingual-pre.230 Adds a NoConverterFound exception to deal with the (hopefully now rare) case that there is no converter for an encoding. =============== Diff against Multilingual-pre.230 =============== Item was added: + Error subclass: #NoConverterFound + instanceVariableNames: 'encoding' + classVariableNames: '' + poolDictionaries: '' + category: 'Multilingual-TextConversion'! Item was added: + ----- Method: NoConverterFound class>>signalFor: (in category 'as yet unclassified') ----- + signalFor: encodingName + + self new + encoding: encodingName; + signal! Item was added: + ----- Method: NoConverterFound>>encoding (in category 'accessing') ----- + encoding + + ^ encoding! Item was added: + ----- Method: NoConverterFound>>encoding: (in category 'accessing') ----- + encoding: anObject + + encoding := anObject!

1 0

The Trunk: Multilingual-pre.231.mcz
by commits＠source.squeak.org 07 Dec '17

07 Dec '17

1 0

The Trunk: Network-pre.213.mcz
by commits＠source.squeak.org 07 Dec '17

07 Dec '17

Patrick Rein uploaded a new version of Network to project The Trunk: http://source.squeak.org/trunk/Network-pre.213.mcz ==================== Summary ==================== Name: Network-pre.213 Author: pre Time: 7 December 2017, 12:08:21.729608 pm UUID: c8734836-b900-d542-8a4b-bcd0ced9670b Ancestors: Network-nice.212 This commit includes a major refactoring of the mail message infrastructure and some new logic for handling attachments. The refactoring extracts the logic dealing with MIMEDocuments from the MailMessage and puts it into the MIMEDocument class. Before that multi part MailMessages contained MailMessage objects as body parts. This might make sense from a re-use perspective as they share some methods (mostly for handling meta data stored in header fields) but at the same time it is conceptually confusing and complicates the serialization logic. =============== Diff against Network-nice.212 =============== Item was changed: Object subclass: #MIMEDocument + instanceVariableNames: 'mainType subType content fields url parts' - instanceVariableNames: 'mainType subType content parameters url' classVariableNames: 'MIMEdatabase' poolDictionaries: '' category: 'Network-Url'! !MIMEDocument commentStamp: '<historical>' prior: 0! a MIME object, along with its type and the URL it was found at (if any)! Item was changed: ----- Method: MIMEDocument class>>contentType:content: (in category 'instance creation') ----- + contentType: aString content: content - contentType: aString content: content "create a MIMEObject with the given content-type and content" "MIMEDocument contentType: 'text/plain' content: 'This is a test'" | ans | ans := self new. + ans contentTypeHeaderValue: (MIMEHeaderValue fromMIMEHeader: aString). - "parse the content-type" - ((aString isNil or: [ (aString includes: $/) not])) - ifTrue: [ - ans privateMainType: 'application'. - ans privateSubType: 'octet-stream' ] - ifFalse: [ | value parts | - value := MIMEHeaderValue fromMIMEHeader: aString. - parts := value mainValue splitBy: '/'. - ans privateMainType: parts first. - ans privateSubType: parts second. - ans privateParameters: value parameters ]. (ans isPlaintext or: [ans isHTML]) + ifTrue: [ans content: (self tryToDecodeBody: content as: ans charset)] + ifFalse: [ans isMultipart + ifTrue: [| separator | + separator := ans attachmentSeparator asLowercase. + separator ifNil: [self error: 'Bad attachment separater']. + + separator := '--', separator withoutTrailingBlanks. + ans addAllParts: (self parseParts: content withSeparator:separator).] + ifFalse: [ans content: content]]. - ifTrue: [ans privateContent: (self tryToDecodeBody: content as: (ans parameterNamed: 'charset' ifAbsent: [nil]))] - ifFalse: [ans privateContent: content]. ^ ans ! Item was added: + ----- Method: MIMEDocument class>>contentTypeMultipartAlternative (in category 'content-types') ----- + contentTypeMultipartAlternative + ^'multipart/alternative'! Item was added: + ----- Method: MIMEDocument class>>contentTypeMultipartMixed (in category 'content-types') ----- + contentTypeMultipartMixed + ^'multipart/mixed'! Item was added: + ----- Method: MIMEDocument class>>fromPartString: (in category 'instance creation') ----- + fromPartString: aString + "This method allows for easy creation of MIME documents + representing parts in a multipart MIME document" + + ^ self new initializeFromString: aString! Item was added: + ----- Method: MIMEDocument class>>newMultipart (in category 'instance creation') ----- + newMultipart + + | ans | + + ans := self new. + + ans contentTypeHeaderValue: (MIMEHeaderValue fromMIMEHeader: self contentTypeMultipartMixed). + ans contentTypeHeaderValue parameterAt: 'boundary' put: MailMessage generateSeparator. + + ^ ans! Item was added: + ----- Method: MIMEDocument class>>parseParts:withSeparator: (in category 'instance creation') ----- + parseParts: bodyText withSeparator: separator + "private -- parse the parts of the message and store them into a collection" + + | parseStream msgStream messages normalizedSeparator | + + parseStream := ReadStream on: bodyText. + + msgStream := LimitingLineStreamWrapper on: parseStream delimiter: separator. + normalizedSeparator := separator asLowercase. + msgStream limitingBlock: [:aLine | | normalizedLine | + normalizedLine := aLine withoutTrailingBlanks asLowercase. + normalizedLine = normalizedSeparator or: "Match the separator" + [normalizedLine = ('--',normalizedSeparator)] or: "or -- and the separator" + [normalizedLine = (normalizedSeparator, '--')]]. "or the final separator with --" + + "Throw away everything up to and including the first separator" + msgStream upToEnd. + msgStream skipThisLine. + + "Extract each of the multi-parts as strings" + messages := OrderedCollection new. + [parseStream atEnd] + whileFalse: + [messages add: msgStream upToEnd. + msgStream skipThisLine]. + + ^ messages collect: [:e | MIMEDocument fromPartString: e]! Item was changed: + ----- Method: MIMEDocument class>>resetMIMEdatabase (in category 'initialize-release') ----- - ----- Method: MIMEDocument class>>resetMIMEdatabase (in category 'content-types') ----- resetMIMEdatabase MIMEdatabase := self extendedMIMEdatabase! Item was changed: ----- Method: MIMEDocument class>>tryToDecodeBody:as: (in category 'instance creation') ----- tryToDecodeBody: content as: encodingName ^ [(MultiByteBinaryOrTextStream with: content encoding: encodingName) contents] + on: InvalidUTF8 , NoConverterFound do: [(MultiByteBinaryOrTextStream + with: content + encoding: 'latin1') contents]! - on: InvalidUTF8 do: [(MultiByteBinaryOrTextStream - with: content - encoding: 'latin1') contents]! Item was added: + ----- Method: MIMEDocument class>>tryToEncodeBody:as: (in category 'instance creation') ----- + tryToEncodeBody: content as: encodingName + + ^ content convertToEncoding: encodingName! Item was added: + ----- Method: MIMEDocument>>addAllParts: (in category 'parts') ----- + addAllParts: MIMEDocuments + + parts addAll: MIMEDocuments! Item was added: + ----- Method: MIMEDocument>>addPart: (in category 'parts') ----- + addPart: aMIMEDocument + + parts add: aMIMEDocument! Item was added: + ----- Method: MIMEDocument>>asSendableBodyText (in category 'serializing') ----- + asSendableBodyText + + | sendableBodyText | + sendableBodyText := self isMultipart + ifTrue: [self sendableMultipartBodyText] + ifFalse: [(self isPlaintext or: [self isHTML]) + ifTrue: [self class tryToEncodeBody: self contents as: self charset] + ifFalse: [self contents]]. + + ^ (self hasFieldNamed: 'content-transfer-encoding') + ifFalse: [sendableBodyText] + ifTrue: [ | transferEncoding | + transferEncoding := self contentTransferEncoding. + (MimeConverter forEncoding: transferEncoding) mimeEncode: sendableBodyText readStream ] ! Item was added: + ----- Method: MIMEDocument>>asSendablePartText (in category 'serializing') ----- + asSendablePartText + + ^ String streamContents: [ :str | | | + "first put the header" + fields keysAndValuesDo: [ :fieldName :fieldValues | + fieldValues do: [ :fieldValue | + str + nextPutAll: fieldName capitalized ; + nextPutAll: ': '; + nextPutAll: fieldValue asHeaderValue; + cr ]. ]. + + str cr. + + str nextPutAll: self asSendableBodyText].! Item was added: + ----- Method: MIMEDocument>>attachmentSeparator (in category 'accessing') ----- + attachmentSeparator + ^(self fieldNamed: 'content-type' ifAbsent: [^nil]) parameters + at: 'boundary' ifAbsent: [^nil]! Item was added: + ----- Method: MIMEDocument>>bodyTextFormatted (in category 'serializing') ----- + bodyTextFormatted + "Answer a version of the text in my body suitable for display. This will parse multipart forms, decode HTML, and other such things" + + self isMultipart ifTrue: [ + self isMultipartAlternative ifTrue: [ + "it's multipart/alternative. search for a part that we can display, biasing towards simpler formats" + #('text/plain' 'text/html') do: [ :format | + self parts do: [ :part | + part contentType = format ifTrue: [ ^ part bodyTextFormatted ] ] ]. + + "couldn't find a desirable part to display; just display the first part" + ^self parts first bodyTextFormatted ]. + + "not alternative parts. put something for each part" + ^Text streamContents: [ :str | + self parts do: [ :part | + ((#('text' 'multipart') includes: part mainType) or: + [ part contentType = 'message/rfc822']) + ifTrue: [ + "try to inline the message part" + str nextPutAll: part bodyTextFormatted. ] + ifFalse: [ + |descript | + str cr. + descript := part name ifNil: [ 'attachment' ]. + str nextPutAll: (Text string: '[', descript, ']' attribute: (TextMessageLink message: part)). ] ] ]. ]. + + + "check for HTML" + (self contentType = 'text/html') ifTrue: [ + Smalltalk at: #HtmlParser ifPresent: [ :htmlParser | + ^(htmlParser parse: (ReadStream on: self content)) formattedText]. + Smalltalk at: #HtmlReadWriter ifPresent: [:html | + ^ self content asTextFromHtml] + ]. + + "check for an embedded message" + self contentType = 'message/rfc822' ifTrue: [ + ^(MailMessage from: self content) formattedText ]. + + "nothing special--just return the text" + ^self content. + ! Item was changed: ----- Method: MIMEDocument>>charset (in category 'accessing') ----- charset + ^ self contentTypeHeaderValue parameterAt: #charset ifAbsent: ['us-ascii']! - ^ self parameterNamed: 'charset' ifAbsent: ['us-ascii']! Item was changed: ----- Method: MIMEDocument>>charset: (in category 'accessing') ----- charset: aString + ^ self contentTypeHeaderValue parameterAt: #charset put: aString! - ^ parameters at: 'charset' put: aString! Item was added: + ----- Method: MIMEDocument>>containsViewableImage (in category 'testing') ----- + containsViewableImage + + ^ self isJpeg or: [self isGif or: [self isPng]]! Item was changed: ----- Method: MIMEDocument>>content (in category 'accessing') ----- content "Answer the receiver's raw data." + - ^ content! Item was added: + ----- Method: MIMEDocument>>content: (in category 'accessing') ----- + content: aString + content := aString! Item was added: + ----- Method: MIMEDocument>>contentTransferEncoding (in category 'accessing') ----- + contentTransferEncoding + + ^ self contentTransferEncodingHeaderValue mainValue! Item was added: + ----- Method: MIMEDocument>>contentTransferEncodingHeaderValue (in category 'accessing') ----- + contentTransferEncodingHeaderValue + + ^ self fieldNamed: 'content-transfer-encoding' ifAbsent: [nil]! Item was changed: ----- Method: MIMEDocument>>contentType (in category 'accessing') ----- contentType - "Answer the MIME contents type." + ^ self contentTypeHeaderValue mainValue! - ^ self mainType , '/' , self subType! Item was added: + ----- Method: MIMEDocument>>contentTypeHeaderValue (in category 'accessing') ----- + contentTypeHeaderValue + + ^ self fieldNamed: 'content-type' ifAbsent: [self error: 'MIMEDocument requires a content-type field']! Item was added: + ----- Method: MIMEDocument>>contentTypeHeaderValue: (in category 'accessing') ----- + contentTypeHeaderValue: aMIMEHeaderValue + + ^ self setField: 'content-type' to: aMIMEHeaderValue! Item was added: + ----- Method: MIMEDocument>>fieldNamed:ifAbsent: (in category 'fields') ----- + fieldNamed: aString ifAbsent: aBlock + | matchingFields | + "return the value of the field with the specified name. If there is more than one field, then return the first one" + matchingFields := fields at: aString asLowercase ifAbsent: [ ^aBlock value ]. + ^matchingFields first! Item was added: + ----- Method: MIMEDocument>>fieldsFrom:do: (in category 'fields') ----- + fieldsFrom: aStream do: aBlock + "Invoke the given block with each of the header fields from the given stream. The block arguments are the field name and value. The streams position is left right after the empty line separating header and body. + Duplicate of code in MailMessage" + + | savedLine line s | + savedLine := aStream nextLine. + [aStream atEnd] whileFalse: [ + line := savedLine. + (line isEmpty) ifTrue: [^self]. "quit when we hit a blank line" + [savedLine := aStream nextLine. + savedLine notNil and: [savedLine notEmpty] and: [savedLine first isSeparator]] whileTrue: [ + "lines starting with white space are continuation lines" + s := ReadStream on: savedLine. + s skipSeparators. + line := line, ' ', s upToEnd]. + self reportField: line withBlanksTrimmed to: aBlock]. + + "process final header line of a body-less message" + (savedLine isEmpty) ifFalse: [self reportField: savedLine withBlanksTrimmed to: aBlock]. + ! Item was added: + ----- Method: MIMEDocument>>hasFieldNamed: (in category 'fields') ----- + hasFieldNamed: aString + ^fields includesKey: aString asLowercase! Item was added: + ----- Method: MIMEDocument>>initialize (in category 'testing') ----- + initialize + + parts := OrderedCollection new. + fields := Dictionary new. + self setField: 'content-type' toString: self class defaultContentType.! Item was added: + ----- Method: MIMEDocument>>initializeFromString: (in category 'initialize-release') ----- + initializeFromString: aString + "This can only be used for MIME documents which are not multipart." + + | parseStream contentType bodyText contentTransferEncoding text | + + text := aString withoutTrailingBlanks, String cr, String cr. + parseStream := ReadStream on: text. + contentType := 'text/plain'. + contentTransferEncoding := nil. + fields := Dictionary new. + + "Extract information out of the header fields" + self fieldsFrom: parseStream do: + [:fName :fValue | + "NB: fName is all lowercase" + + fName = 'content-type' ifTrue: [contentType := fValue asLowercase]. + fName = 'content-transfer-encoding' ifTrue: [contentTransferEncoding := fValue asLowercase]. + + (fields at: fName ifAbsentPut: [OrderedCollection new: 1]) + add: (MIMEHeaderValue forField: fName fromString: fValue)]. + + "Extract the body of the message" + bodyText := parseStream upToEnd. + bodyText := (MimeConverter forEncoding: contentTransferEncoding) + mimeDecode: (ReadStream on: bodyText) as: String. + bodyText := self class tryToDecodeBody: bodyText as: self charset. + + self isMultipart + ifTrue: [parts := self class parseParts: bodyText withSeparator: self attachmentSeparator] + ifFalse: [content := bodyText] + ! Item was changed: ----- Method: MIMEDocument>>mainType (in category 'accessing') ----- mainType + ^ (self contentType splitBy: '/') first! - ^ mainType! Item was added: + ----- Method: MIMEDocument>>name (in category 'accessing') ----- + name + "return a default name for this part, if any was specified. If not, return nil" + | type nameField disposition | + + "try in the content-type: header" + type := self fieldNamed: 'content-type' ifAbsent: [nil]. + (type notNil and: [(nameField := type parameters at: 'name' ifAbsent: [nil]) notNil]) + ifTrue: [^ nameField]. + + "try in content-disposition:" + disposition := self fieldNamed: 'content-disposition' ifAbsent: [nil]. + (disposition notNil and: [(nameField := disposition parameters at: 'filename' ifAbsent: [nil]) notNil]) + ifTrue: [^ nameField]. + + "give up" + ^ nil! Item was added: + ----- Method: MIMEDocument>>parameterizedContentTransferEncoding (in category 'accessing') ----- + parameterizedContentTransferEncoding + + ^ self contentTransferEncoding asHeaderValue! Item was added: + ----- Method: MIMEDocument>>parameterizedContentType (in category 'accessing') ----- + parameterizedContentType + + ^ self contentTypeHeaderValue asHeaderValue + + ! Item was changed: ----- Method: MIMEDocument>>parts (in category 'accessing') ----- parts + ^ parts - "Return the parts of this message. There is a far more reliable implementation of parts in MailMessage, but for now we are continuing to use this implementation" - - | parseStream currLine separator msgStream messages | - self isMultipart ifFalse: [^ #()]. - parseStream := ReadStream on: self content. - currLine := ''. - ['--*' match: currLine] - whileFalse: [currLine := parseStream nextLine]. - separator := currLine copy. - msgStream := LimitingLineStreamWrapper on: parseStream delimiter: separator. - messages := OrderedCollection new. - [parseStream atEnd] - whileFalse: - [messages add: msgStream upToEnd. - msgStream skipThisLine]. - ^ messages collect: [:e | MailMessage from: e] ! Item was changed: ----- Method: MIMEDocument>>privateMainType: (in category 'private') ----- privateMainType: aString + + self contentTypeHeaderValue mainValue: (aString , '/' , self subType)! - mainType := aString! Item was changed: ----- Method: MIMEDocument>>privateSubType: (in category 'private') ----- privateSubType: aString + + self contentTypeHeaderValue mainValue: (self mainType , '/' , aString)! - subType := aString! Item was added: + ----- Method: MIMEDocument>>reportField:to: (in category 'fields') ----- + reportField: aString to: aBlock + "Evaluate the given block with the field name a value in the given field. Do nothing if the field is malformed. + Duplicate of code in MailMessage" + + | s fieldName fieldValue | + (aString includes: $:) ifFalse: [^self]. + s := ReadStream on: aString. + fieldName := (s upTo: $:) asLowercase. "fieldname must be lowercase" + fieldValue := s upToEnd withBlanksTrimmed. + fieldValue isEmpty ifFalse: [aBlock value: fieldName value: fieldValue]. + ! Item was added: + ----- Method: MIMEDocument>>save (in category 'interactions') ----- + save + "save the part to a file" + | fileName file | + fileName := self name + ifNil: ['attachment' , Utilities dateTimeSuffix]. + (fileName includes: $.) ifFalse: [ + #(isJpeg 'jpg' isGif 'gif' isPng 'png' isPnm 'pnm') pairsDo: [ :s :e | + (self perform: s) ifTrue: [fileName := fileName, '.', e] + ] + ]. + fileName := UIManager default request: 'File name for save?' initialAnswer: fileName. + fileName isEmpty + ifTrue: [^ nil]. + + + file := FileStream newFileNamed: fileName. + self contentTransferEncoding = 'base64' ifTrue: [file binary]. + file nextPutAll: self contents. + file close! Item was added: + ----- Method: MIMEDocument>>sendableMultipartBodyText (in category 'serializing') ----- + sendableMultipartBodyText + + ^ String streamContents: [ :str | + str cr. + parts do: [ :part | + str + cr; + nextPutAll: '--'; + nextPutAll: self attachmentSeparator; + cr; + nextPutAll: part asSendablePartText ]. + + str + cr; + nextPutAll: '--'; + nextPutAll: self attachmentSeparator; + nextPutAll: '--'; + cr ]! Item was added: + ----- Method: MIMEDocument>>setField:to: (in category 'fields') ----- + setField: fieldName to: aFieldValue + "set a field. If any field of the specified name exists, it will be overwritten" + fields at: fieldName asLowercase put: (OrderedCollection with: aFieldValue).! Item was added: + ----- Method: MIMEDocument>>setField:toString: (in category 'fields') ----- + setField: fieldName toString: fieldValue + ^self setField: fieldName to: (MIMEHeaderValue forField: fieldName fromString: fieldValue)! Item was changed: ----- Method: MIMEDocument>>subType (in category 'accessing') ----- subType + ^ (self contentType splitBy: '/') second! - ^ subType! Item was added: + ----- Method: MIMEDocument>>text (in category 'accessing') ----- + text + "Compatibility with MailMessage protocol" + ^self contents! Item was added: + ----- Method: MIMEDocument>>view (in category 'interactions') ----- + view + + self containsViewableImage + ifTrue: [^ self viewImage]. + (StringHolder new contents: self bodyTextFormatted; + yourself) + openLabel: (self name ifNil: ['(a message part)'])! Item was added: + ----- Method: MIMEDocument>>viewImage (in category 'interactions') ----- + viewImage + | stream image | + stream := self contentStream. + image := Form fromBinaryStream: stream. + (Project current world drawingClass withForm: image) openInWorld! Item was changed: ----- Method: MIMEHeaderValue>>asHeaderValue (in category 'printing') ----- asHeaderValue | strm | strm := WriteStream on: (String new: 20). strm nextPutAll: mainValue. + parameters associationsDo: [:e | + strm + nextPut: $; ; + nextPutAll: e key; + nextPutAll: '='; + nextPutAll: e value]. - parameters associationsDo: [:e | strm nextPut: $; ; nextPutAll: e key; - nextPutAll: '="'; - nextPutAll: e value , '"']. ^ strm contents! Item was changed: ----- Method: MIMEHeaderValue>>mainValue (in category 'accessing') ----- mainValue + ^ [mainValue decodeMimeHeader] + on: InvalidUTF8 , NoConverterFound do: [:e | mainValue]! - ^mainValue decodeMimeHeader! Item was added: + ----- Method: MIMEHeaderValue>>parameterAt:ifAbsent: (in category 'accessing') ----- + parameterAt: aParameter ifAbsent: absentBlock + + ^ parameters at: aParameter ifAbsent: absentBlock! Item was changed: ----- Method: MailMessage class>>from: (in category 'instance creation') ----- from: aString "Initialize a new instance from the given string." + ^(self new) initializeFromString: aString! - ^ self new - setText: aString; - yourself! Item was added: + ----- Method: MailMessage class>>replyAllFor: (in category 'instance creation') ----- + replyAllFor: aMailMessage + + ^ self replyFor: aMailMessage excluding: {}! Item was added: + ----- Method: MailMessage class>>replyAllFor:excluding: (in category 'instance creation') ----- + replyAllFor: aMailMessage excluding: ignoredEmailAddresses + + | replySubject references replyReceivers ccReceivers | + + replyReceivers := MailAddressParser addressesIn: (aMailMessage fieldsNamed: 'to' separatedBy: ', '). + replyReceivers := replyReceivers reject: [:m | + ignoredEmailAddresses includes: m ]. + replyReceivers addFirst: aMailMessage replyReceiver. + + replySubject := aMailMessage replySubject. + references := aMailMessage references. + + ccReceivers := MailAddressParser addressesIn: aMailMessage cc. + ccReceivers := ccReceivers reject: [:m | + ignoredEmailAddresses includes: m ]. + + ^ self empty + to: (replyReceivers joinSeparatedBy: ','); + cc: (ccReceivers joinSeparatedBy: ','); + subject: replySubject; + setField: 'in-reply-to' toString: aMailMessage messageId; + setField: 'references' toString: references; + yourself + ! Item was changed: ----- Method: MailMessage class>>replyFor: (in category 'instance creation') ----- replyFor: aMailMessage | replyReceiver replySubject references | + replyReceiver := aMailMessage replyReceiver. + replySubject := aMailMessage replySubject. + references := aMailMessage references. - replyReceiver := (aMailMessage - fieldNamed: 'reply-to' - ifAbsent: [aMailMessage - fieldNamed: 'from' - ifAbsent: [self error: 'there is a field missing in the original message']]) mainValue. - - replySubject := (aMailMessage subject beginsWith: 'Re:') - ifTrue: [aMailMessage subject] - ifFalse: ['Re: ' , aMailMessage subject]. - - references := (aMailMessage hasFieldNamed: 'references') - ifTrue: [(aMailMessage fieldNamed: 'references' ifAbsent: [self error: 'Something changed the mail between the check and now']) mainValue , ', ' , aMailMessage messageId] - ifFalse: [aMailMessage messageId]. ^ self empty to: replyReceiver; subject: replySubject; setField: 'in-reply-to' toString: aMailMessage messageId; setField: 'references' toString: references; yourself ! Item was removed: - ----- Method: MailMessage class>>selfTest (in category 'testing') ----- - selfTest - - | msgText msg | - - msgText := - 'Date: Tue, 20 Feb 2001 13:52:53 +0300 - From: mdr(a)scn.rg (Me Ru) - Subject: RE: Windows 2000 on your laptop - To: "Greg Y" <to1(a)mail.com> - cc: cc1(a)scn.org, cc1also(a)test.org - To: to2(a)no.scn.org, to2also(a)op.org - cc: cc2(a)scn.org - - Hmmm... Good. I will try to swap my German copy for something in - English, and then do the deed. Oh, and expand my RAM to 128 first. - - Mike - '. - - msg := self new from: msgText. - - [msg text = msgText] assert. - [msg subject = 'RE: Windows 2000 on your laptop'] assert. - [msg from = 'mdr(a)scn.rg (Me Ru)'] assert. - [msg date = '2/20/01'] assert. - [msg time = 667133573] assert. - "[msg name] assert." - [msg to = '"Greg Y" <to1(a)mail.com>, to2(a)no.scn.org, to2also(a)op.org'] assert. - [msg cc = 'cc1(a)scn.org, cc1also(a)test.org, cc2(a)scn.org'] assert. - - "MailMessage selfTest" - ! Item was changed: ----- Method: MailMessage>>addAttachmentFrom:withName: (in category 'multipart') ----- addAttachmentFrom: aStream withName: aName + "add an attachment, encoding with base64. aName is the optional filename" - "add an attachment, encoding with base64. aName is the option filename to encode" | newPart | self makeMultipart. - self parts. "make sure parts have been parsed" + newPart := MIMEDocument contentType: (MIMEDocument guessTypeFromName: aName) content: ''. - "create the attachment as a MailMessage" - newPart := MailMessage empty. - newPart setField: 'content-type' toString: 'application/octet-stream'. newPart setField: 'content-transfer-encoding' toString: 'base64'. + newPart setField: 'content-disposition' toString: 'attachment'. + aName ifNotNil: [ + | dispositionField contentTypeField | + dispositionField := newPart fieldNamed: 'content-disposition' + ifAbsent: [self error: 'Should be initialized by now']. + dispositionField parameterAt: 'filename' put: '"' , aName , '"'. + + contentTypeField := newPart fieldNamed: 'content-type' + ifAbsent: [self error: 'Should be initialized by now']. + contentTypeField parameterAt: 'name' put: '"' , aName , '"'.]. + + newPart content: aStream upToEnd. + self body addPart: newPart.! - | dispositionField | - dispositionField := MIMEHeaderValue fromMIMEHeader: 'attachment'. - dispositionField parameterAt: 'filename' put: aName. - newPart setField: 'content-disposition' to: dispositionField ]. - newPart body: (MIMEDocument contentType: 'application/octet-stream' content: aStream upToEnd). - - - "regenerate our text" - parts := parts copyWith: newPart. - self regenerateBodyFromParts. - text := nil.! Item was changed: ----- Method: MailMessage>>asSendableText (in category 'printing/formatting') ----- asSendableText + + | serializedMail | + serializedMail := self text. + ^ self wrapLinesOf: serializedMail! - "break lines in the given string into shorter lines" - | result atAttachment width aString pastHeader | - width := 72. - aString := self text. - result := WriteStream on: (String new: aString size * 50 // 49). - pastHeader := false. - atAttachment := false. - aString asString - linesDo: - [:line | | end start | - line isEmpty ifTrue: [pastHeader := true]. - pastHeader - ifTrue: - ["(line beginsWith: '--==') - ifTrue: [atAttachment := true]." - atAttachment - ifTrue: - ["at or after an attachment line; no more - wrapping for the rest of the message" - result nextPutAll: line. - result cr] - ifFalse: [(line beginsWith: '>') - ifTrue: - ["it's quoted text; don't wrap it" - result nextPutAll: line. - result cr] - ifFalse: - ["regular old line. Wrap it to multiple - lines " - start := 1. - "output one shorter line each time - through this loop" - [start + width <= line size] - whileTrue: - ["find the end of the line" - end := start + width - 1. - [end >= start and: [(line at: end + 1) isSeparator not]] - whileTrue: [end := end - 1]. - end < start ifTrue: ["a word spans the entire - width!! " - end := start + width - 1]. - "copy the line to the output" - result nextPutAll: (line copyFrom: start to: end). - result cr. - "get ready for next iteration" - start := end + 1. - (line at: start) isSeparator ifTrue: [start := start + 1]]. - "write out the final part of the line" - result nextPutAll: (line copyFrom: start to: line size). - result cr]]] - ifFalse: - [result nextPutAll: line. - result cr]]. - ^ result contents! Item was changed: + ----- Method: MailMessage>>body (in category 'accessing') ----- - ----- Method: MailMessage>>body (in category 'access') ----- body "return just the body of the message" ^body! Item was changed: ----- Method: MailMessage>>body: (in category 'initialize-release') ----- body: newBody + + self isMultipart + ifTrue: [self body parts at: 1 put: newBody] + ifFalse: [body := newBody]! - "change the body" - body := newBody. - text := nil.! Item was changed: + ----- Method: MailMessage>>bodyText (in category 'accessing') ----- - ----- Method: MailMessage>>bodyText (in category 'access') ----- bodyText "return the text of the body of the message" + ^ body asSendableBodyText! - ^body content! Item was changed: ----- Method: MailMessage>>bodyTextFormatted (in category 'printing/formatting') ----- bodyTextFormatted - "Answer a version of the text in my body suitable for display. This will parse multipart forms, decode HTML, and other such things" + ^ self body bodyTextFormatted - "check for multipart" - self body isMultipart ifTrue: [ - "check for alternative forms" - self body isMultipartAlternative ifTrue: [ - "it's multipart/alternative. search for a part that we can display, biasing towards nicer formats" - #('text/html' 'text/plain') do: [ :format | - self parts do: [ :part | - part body contentType = format ifTrue: [ ^ part bodyTextFormatted ] ] ]. - - "couldn't find a desirable part to display; just display the first part" - ^self parts first bodyTextFormatted ]. - - "not alternative parts. put something for each part" - ^Text streamContents: [ :str | - self parts do: [ :part | - ((#('text' 'multipart') includes: part body mainType) or: - [ part body contentType = 'message/rfc822']) - ifTrue: [ - "try to inline the message part" - str nextPutAll: part bodyTextFormatted. ] - ifFalse: [ - |descript | - str cr. - descript := part name ifNil: [ 'attachment' ]. - str nextPutAll: (Text string: '[', descript, ']' attribute: (TextMessageLink message: part)). ] ] ]. ]. - - - "check for HTML" - (self body contentType = 'text/html') ifTrue: [ - Smalltalk at: #HtmlParser ifPresent: [ :htmlParser | - ^(htmlParser parse: (ReadStream on: body content)) formattedText]. - Smalltalk at: #HtmlReadWriter ifPresent: [:html | - ^ body content asTextFromHtml] - ]. - - "check for an embedded message" - self body contentType = 'message/rfc822' ifTrue: [ - ^(MailMessage from: self body content) formattedText ]. - - "nothing special--just return the text" - ^body content. - ! Item was added: + ----- Method: MailMessage>>contentType (in category 'accessing') ----- + contentType + + ^ self body contentTypeHeaderValue! Item was changed: + ----- Method: MailMessage>>date (in category 'accessing') ----- - ----- Method: MailMessage>>date (in category 'access') ----- date + - ^ DateAndTime fromSeconds: self time + (Date newDay: 1 year: 1980) asSeconds! Item was changed: + ----- Method: MailMessage>>dateString (in category 'accessing') ----- - ----- Method: MailMessage>>dateString (in category 'access') ----- dateString "Answer a date string for this message." + ^(Date fromSeconds: self time + (Date newDay: 1 year: 1980) asSeconds) + printFormat: #(2 1 3 47 1 2)! - ^ self date asDate printFormat: #(2 1 3 47 1 2)! Item was changed: + ----- Method: MailMessage>>dateTime: (in category 'accessing') ----- - ----- Method: MailMessage>>dateTime: (in category 'access') ----- dateTime: aDateTime self setField: 'date' toString: aDateTime asMailMessageString! Item was changed: + ----- Method: MailMessage>>fields (in category 'accessing') ----- - ----- Method: MailMessage>>fields (in category 'access') ----- fields "return the internal fields structure. This is private and subject to change!!" ^ fields! Item was changed: + ----- Method: MailMessage>>from (in category 'accessing') ----- - ----- Method: MailMessage>>from (in category 'access') ----- from ^(self fieldNamed: 'from' ifAbsent: [ ^'' ]) mainValue! Item was changed: + ----- Method: MailMessage>>from: (in category 'accessing') ----- - ----- Method: MailMessage>>from: (in category 'access') ----- from: aString | sanitizedMailAddress | sanitizedMailAddress := (MailAddressParser addressesIn: aString) first. ^self setField: 'from' toString: sanitizedMailAddress! Item was changed: ----- Method: MailMessage>>initialize (in category 'initialize-release') ----- initialize "initialize as an empty message" text := String cr. fields := Dictionary new. + body := MIMEDocument contentType: 'text/plain' content: String cr. + self dateTime: TimeStamp now.! - body := MIMEDocument contentType: 'text/plain' content: String cr! Item was added: + ----- Method: MailMessage>>initializeFromString: (in category 'initialize-release') ----- + initializeFromString: aString + "Parse aString to initialize myself." + + | parseStream contentType bodyText contentTransferEncoding | + + text := aString withoutTrailingBlanks, String cr, String cr. + parseStream := ReadStream on: text. + contentType := 'text/plain'. + contentTransferEncoding := nil. + fields := Dictionary new. + + "Extract information out of the header fields" + self fieldsFrom: parseStream do: + [:fName :fValue | + "NB: fName is all lowercase" + + fName = 'content-type' ifTrue: [contentType := fValue asLowercase]. + fName = 'content-transfer-encoding' ifTrue: [contentTransferEncoding := fValue asLowercase]. + + (fields at: fName ifAbsentPut: [OrderedCollection new: 1]) + add: (MIMEHeaderValue forField: fName fromString: fValue)]. + + "Extract the body of the message" + bodyText := parseStream upToEnd. + bodyText := (MimeConverter forEncoding: contentTransferEncoding) + mimeDecode: (ReadStream on: bodyText) as: String. + + body := MIMEDocument contentType: contentType content: bodyText! Item was added: + ----- Method: MailMessage>>isMultipart (in category 'multipart') ----- + isMultipart + + ^ self body isMultipart! Item was changed: ----- Method: MailMessage>>makeMultipart (in category 'multipart') ----- makeMultipart "if I am not multipart already, then become a multipart message with one part" + | newBody | - | part multipartHeader | body isMultipart ifTrue: [ ^self ]. "set up the new message part" + newBody := MIMEDocument newMultipart. + newBody addPart: body. + - part := MailMessage empty. - part body: body. - (self hasFieldNamed: 'content-type') ifTrue: [ - part setField: 'content-type' to: (self fieldNamed: 'content-type' ifAbsent: ['']) ]. - parts := Array with: part. - - "fix up our header" - multipartHeader := MIMEHeaderValue fromMIMEHeader: 'multipart/mixed'. - multipartHeader parameterAt: 'boundary' put: self class generateSeparator . - self setField: 'content-type' to: multipartHeader. - self setField: 'mime-version' to: (MIMEHeaderValue fromMIMEHeader: '1.0'). - self removeFieldNamed: 'content-transfer-encoding'. + body := newBody.! - "regenerate everything" - self regenerateBodyFromParts. - text := nil.! Item was changed: + ----- Method: MailMessage>>messageId (in category 'accessing') ----- - ----- Method: MailMessage>>messageId (in category 'access') ----- messageId + ^ (self fieldNamed: 'message-id' ifAbsent: [ ^'' ]) mainValue! - ^ (self fieldNamed: 'message-id' ifAbsent: [ ^'' ]) mainValue - ! Item was changed: + ----- Method: MailMessage>>messageId: (in category 'accessing') ----- - ----- Method: MailMessage>>messageId: (in category 'access') ----- messageId: aString ^ self setField: 'message-id' toString: aString! Item was added: + ----- Method: MailMessage>>parseParts: (in category 'multipart') ----- + parseParts: bodyText + "private -- parse the parts of the message and store them into a collection" + + | parseStream msgStream messages separator | + + "If we can't find a valid separator, handle it as if the message is not multipart" + separator := self attachmentSeparator. + separator ifNil: [self error: 'Bad attachment separater']. + + separator := '--', separator withoutTrailingBlanks. + parseStream := ReadStream on: bodyText. + + msgStream := LimitingLineStreamWrapper on: parseStream delimiter: separator. + msgStream limitingBlock: [:aLine | + aLine withoutTrailingBlanks = separator or: "Match the separator" + [aLine withoutTrailingBlanks = (separator, '--')]]. "or the final separator with --" + + "Throw away everything up to and including the first separator" + msgStream upToEnd. + msgStream skipThisLine. + + "Extract each of the multi-parts as strings" + messages := OrderedCollection new. + [parseStream atEnd] + whileFalse: + [messages add: msgStream upToEnd. + msgStream skipThisLine]. + + ^ messages collect: [:e | MIMEDocument from: e]! Item was changed: ----- Method: MailMessage>>parts (in category 'multipart') ----- parts + + ^ self body parts! - parts ifNil: [self parseParts]. - ^ parts! Item was changed: ----- Method: MailMessage>>printOn: (in category 'printing/formatting') ----- printOn: aStream - "For text parts with no filename show: 'text/plain: first line of text...' - for attachments/filenamed parts show: 'attachment: filename.ext'" + aStream nextPutAll: 'Text: ' , self excerpt! - | name | - - aStream nextPutAll: ((name := self name) ifNil: ['Text: ' , self excerpt] - ifNotNil: ['File: ' , name])! Item was changed: ----- Method: MailMessage>>readDateFrom: (in category 'parsing') ----- readDateFrom: aStream "Parse a date from the given stream and answer nil if the date can't be parsed. The date may be in any of the following forms: <day> <monthName> <year> (5 April 1982; 5-APR-82) <monthName> <day> <year> (April 5, 1982) <monthNumber> <day> <year> (4/5/82) In addition, the date may be preceded by the day of the week and an optional comma, such as: Tue, November 14, 1989" | day month year | self skipWeekdayName: aStream. aStream peek isDigit ifTrue: [day := Integer readFrom: aStream]. [aStream peek isAlphaNumeric] whileFalse: [aStream skip: 1]. aStream peek isLetter ifTrue: "month name or weekday name" [month := WriteStream on: (String new: 10). [aStream peek isLetter] whileTrue: [month nextPut: aStream next]. month := month contents. day isNil ifTrue: "name/number..." [[aStream peek isAlphaNumeric] whileFalse: [aStream skip: 1]. (aStream peek isDigit) ifFalse: [^nil]. day := Integer readFrom: aStream]] ifFalse: "number/number..." [month := Date nameOfMonth: day. day := Integer readFrom: aStream]. [aStream peek isAlphaNumeric] whileFalse: [aStream skip: 1]. (aStream peek isDigit) ifFalse: [^nil]. year := Integer readFrom: aStream. + ^ Date newDay: day month: month year: year! - ^Date newDay: day month: month year: year! Item was added: + ----- Method: MailMessage>>references (in category 'accessing') ----- + references + + ^ (self hasFieldNamed: 'references') + ifTrue: [(self fieldNamed: 'references' ifAbsent: [self error: 'Something changed the mail between the check and now']) + mainValue , ', ' , self messageId] + ifFalse: [self messageId].! Item was added: + ----- Method: MailMessage>>replyReceiver (in category 'accessing') ----- + replyReceiver + + ^ (self + fieldNamed: 'reply-to' + ifAbsent: [self + fieldNamed: 'from' + ifAbsent: [self error: 'there is a field missing in the original message']]) mainValue. + ! Item was added: + ----- Method: MailMessage>>replySubject (in category 'accessing') ----- + replySubject + + ^ (self subject asLowercase beginsWith: 're:') + ifTrue: [self subject] + ifFalse: ['Re: ' , self subject].! Item was changed: ----- Method: MailMessage>>selfTest (in category 'testing') ----- selfTest "For testing only: Check that this instance is well formed and makes sense" + - self formattedText. [MailAddressParser addressesIn: self from] ifError: [ :err :rcvr | Transcript show: 'Error parsing From: (', self from, ') ', err]. [MailAddressParser addressesIn: self to] ifError: [ :err :rcvr | Transcript show: 'Error parsing To: (', self to, ') ', err]. [MailAddressParser addressesIn: self cc] ifError: [ :err :rcvr | Transcript show: 'Error parsing CC: (', self cc, ') ', err]. ! Item was changed: + ----- Method: MailMessage>>setField:to: (in category 'fields') ----- - ----- Method: MailMessage>>setField:to: (in category 'initialize-release') ----- setField: fieldName to: aFieldValue "set a field. If any field of the specified name exists, it will be overwritten" fields at: fieldName asLowercase put: (OrderedCollection with: aFieldValue). text := nil.! Item was changed: + ----- Method: MailMessage>>setField:toString: (in category 'fields') ----- - ----- Method: MailMessage>>setField:toString: (in category 'initialize-release') ----- setField: fieldName toString: fieldValue ^self setField: fieldName to: (MIMEHeaderValue forField: fieldName fromString: fieldValue)! Item was changed: + ----- Method: MailMessage>>subject (in category 'accessing') ----- - ----- Method: MailMessage>>subject (in category 'access') ----- subject ^ (self fieldNamed: 'subject' ifAbsent: [ ^'' ]) mainValue! Item was changed: + ----- Method: MailMessage>>subject: (in category 'accessing') ----- - ----- Method: MailMessage>>subject: (in category 'access') ----- subject: aString + ^self setField: 'subject' toString: aString! - ^ self setField: 'subject' toString: aString! Item was changed: + ----- Method: MailMessage>>text (in category 'accessing') ----- - ----- Method: MailMessage>>text (in category 'access') ----- text + + ^ String streamContents: [ :str | | encodedBodyText | + "first put the header" + (fields associations , {'content-type' -> {self body contentTypeHeaderValue} }) + do: [ :assoc | | fieldName fieldValues | + fieldName := assoc key. + fieldValues := assoc value. + fieldValues do: [ :fieldValue | + str + nextPutAll: fieldName capitalized ; + nextPutAll: ': '; + nextPutAll: fieldValue asHeaderValue; + cr ]]. + + self body contentTransferEncodingHeaderValue + ifNotNil: [:headerValue | + str + nextPutAll: 'content-transfer-encoding' capitalized; + nextPutAll: ': '; + nextPutAll: headerValue asHeaderValue; + cr ]. + + "skip a line between header and body" + str cr. + + "put the body, being sure to encode it according to the header" + encodedBodyText := body asSendableBodyText. + str nextPutAll: encodedBodyText ].! - "the full, unprocessed text of the message" - text ifNil: [ self regenerateText ]. - ^text! Item was changed: + ----- Method: MailMessage>>time (in category 'accessing') ----- - ----- Method: MailMessage>>time (in category 'access') ----- time | dateField | dateField := (self fieldNamed: 'date' ifAbsent: [ ^0 ]) mainValue. ^ [self timeFrom: dateField] ifError: [:err :rcvr | Date today asSeconds]. ! Item was changed: + ----- Method: MailMessage>>to (in category 'accessing') ----- - ----- Method: MailMessage>>to (in category 'access') ----- to ^self fieldsNamed: 'to' separatedBy: ', '! Item was changed: + ----- Method: MailMessage>>to: (in category 'accessing') ----- - ----- Method: MailMessage>>to: (in category 'access') ----- to: aString + - "Set the to address(es). Make sure order is preserved when uniqueing the addresses." | sanitizedMailAddresses | + sanitizedMailAddresses := (MailAddressParser addressesIn: aString) asSet asArray. + ^self setField: 'to' toString: (sanitizedMailAddresses joinSeparatedBy: ', ')! - sanitizedMailAddresses := MailAddressParser addressesIn: aString. - ^self setField: 'to' toString: (sanitizedMailAddresses withoutDuplicates joinSeparatedBy: ', ')! Item was added: + ----- Method: MailMessage>>wrapLinesOf: (in category 'printing/formatting') ----- + wrapLinesOf: aString + + "break lines in the given string into shorter lines" + | result atAttachment width pastHeader | + width := 72. + result := WriteStream on: (String new: aString size * 50 // 49). + pastHeader := false. + atAttachment := false. + aString asString + linesDo: + [:line | | end start | + line isEmpty ifTrue: [pastHeader := true]. + pastHeader + ifTrue: + ["(line beginsWith: '--==') + ifTrue: [atAttachment := true]." + atAttachment + ifTrue: + ["at or after an attachment line; no more + wrapping for the rest of the message" + result nextPutAll: line. + result cr] + ifFalse: [(line beginsWith: '>') + ifTrue: + ["it's quoted text; don't wrap it" + result nextPutAll: line. + result cr] + ifFalse: + ["regular old line. Wrap it to multiple + lines " + start := 1. + "output one shorter line each time + through this loop" + [start + width <= line size] + whileTrue: + ["find the end of the line" + end := start + width - 1. + [end >= start and: [(line at: end + 1) isSeparator not]] + whileTrue: [end := end - 1]. + end < start ifTrue: ["a word spans the entire + width!! " + end := start + width - 1]. + "copy the line to the output" + result nextPutAll: (line copyFrom: start to: end). + result cr. + "get ready for next iteration" + start := end + 1. + (line at: start) isSeparator ifTrue: [start := start + 1]]. + "write out the final part of the line" + result nextPutAll: (line copyFrom: start to: line size). + result cr]]] + ifFalse: + [result nextPutAll: line. + result cr]]. + + ^ result contents!

1 0

The Trunk: NetworkTests-pre.54.mcz
by commits＠source.squeak.org 07 Dec '17

07 Dec '17

Patrick Rein uploaded a new version of NetworkTests to project The Trunk: http://source.squeak.org/trunk/NetworkTests-pre.54.mcz ==================== Summary ==================== Name: NetworkTests-pre.54 Author: pre Time: 7 December 2017, 12:04:46.893608 pm UUID: 366056e6-74fb-f04b-a77d-20e1be317b8b Ancestors: NetworkTests-pre.53 Updates the tests for MailMessage attachments to take correct care of the content-type and the file name. Also fixes a MailDateAndTimeTest. =============== Diff against NetworkTests-pre.53 =============== Item was changed: ----- Method: MailDateAndTimeTest>>testBasicDate (in category 'as yet unclassified') ----- testBasicDate | date | + date := DateAndTime year: 2017 month: 2 day: 3 hour: 0 minute: 0 second: 0 offset: (Duration hours: 0). + self assert: 'Fri, 03 Feb 2017 00:00:00 +0000' equals: date asMailMessageString! - date := DateAndTime year: 2017 month: 2 day: 3. - self assert: 'Fri, 03 Feb 2017 00:00:00 +0200' equals: date asMailMessageString! Item was added: + ----- Method: MailMessageTest>>testAttachmentsGetTheirOwnContentType (in category 'testing') ----- + testAttachmentsGetTheirOwnContentType + + | message contentType | + message := MailMessage empty + addAttachmentFrom: 'abcxxx' readStream withName: 'aTestingAttachment.pdf'; + body: ((MIMEDocument contentType: 'application/foo' content: 'This is the main text' squeakToUtf8) + charset: 'utf-8'; yourself). + + self assert: message attachments size equals: 1. + + contentType := (message attachments first fieldNamed: 'content-type' ifAbsent: [self fail]) + mainValue. + self assert: contentType equals: 'application/pdf'. + ! Item was changed: ----- Method: MailMessageTest>>testAttachmentsReturnsTheAttachments (in category 'testing') ----- testAttachmentsReturnsTheAttachments | fileName message | message := MailMessage empty addAttachmentFrom: 'abcxxx' readStream withName: 'aTestingAttachment'; body: ((MIMEDocument contentType: 'application/foo' content: 'This is the main text' squeakToUtf8) charset: 'utf-8'; yourself). + self assert: 1 equals: message attachments size. - self assert: message attachments size equals: 1. fileName := (message attachments first fieldNamed: 'content-disposition' ifAbsent: [self fail]) parameterAt: 'filename' ifAbsent: ['']. + self assert: fileName equals: '"aTestingAttachment"'. + + fileName := (message attachments first fieldNamed: 'content-type' ifAbsent: [self fail]) + parameterAt: 'name' ifAbsent: ['']. + + self assert: fileName equals: '"aTestingAttachment"'.! - self assert: fileName equals: 'aTestingAttachment'. - ! Item was added: + ----- Method: MailMessageTest>>testAttachmentsWorkWithVeryLongFilenames (in category 'testing') ----- + testAttachmentsWorkWithVeryLongFilenames + + | fileName message | + message := MailMessage empty + addAttachmentFrom: 'abcxxx' readStream withName: 'aTestingAttachmentWithAVeryVeryVeryVeryVeryVeryVeryVeryLongName.file'; + body: ((MIMEDocument contentType: 'application/foo' content: 'This is the main text' squeakToUtf8) + charset: 'utf-8'; yourself). + + self assert: message attachments size equals: 1. + + fileName := (message attachments first fieldNamed: 'content-disposition' ifAbsent: [self fail]) + parameterAt: 'filename' ifAbsent: ['']. + + self assert: '"aTestingAttachmentWithAVeryVeryVeryVeryVeryVeryVeryVeryLongName.file"' equals: fileName + ! Item was changed: ----- Method: MailMessageTest>>testCreateAReplyForReplyTos (in category 'testing') ----- testCreateAReplyForReplyTos | replyMail startMail | startMail := self fixtureMail setField: 'reply-to' toString: 'anothersender(a)mail.com, andanothersender(a)mail.com'; yourself. replyMail := MailMessage replyFor: startMail. + self + assert: {'anothersender(a)mail.com' . 'andanothersender(a)mail.com'} asSet + equals: ((replyMail to findTokens: ',') collect: [:e | e withBlanksTrimmed]) asSet.! - self assert: 'anothersender(a)mail.com, andanothersender(a)mail.com' equals: replyMail to.!

1 0

The Trunk: Tests-nice.387.mcz
by commits＠source.squeak.org 07 Dec '17

07 Dec '17

Nicolas Cellier uploaded a new version of Tests to project The Trunk: http://source.squeak.org/trunk/Tests-nice.387.mcz ==================== Summary ==================== Name: Tests-nice.387 Author: nice Time: 7 December 2017, 1:02:38.147384 am UUID: 6ba78d9d-9e75-4507-8095-3e6693a32c91 Ancestors: Tests-tpr.386 Fix MCMethodDefinitionTest which was not reentrant The tearDown unregister a working copy of (MCPackage named: 'FooBarBaz'), so the setUp somehow has to recreate it. Otherwise, the tests might start failing at second run. The bug has been identified by Torsten Bergmann and reported on pharo dev mailing list (see thread "Running tests in MCMethodDefinitionTest"). Cherry pick his fix from https://github.com/pharo-project/pharo/pull/583/files, along with a few other cosmetics: - Fix a missing super tearDown. - Classify the unclassified methods. - Comment some classes. - remove an unused ivar TODO: setUp should better call super setUp (even if no-op) =============== Diff against Tests-tpr.386 =============== Item was changed: SystemOrganization addCategory: #'Tests-Bugs'! SystemOrganization addCategory: #'Tests-Compiler'! SystemOrganization addCategory: #'Tests-Dependencies'! SystemOrganization addCategory: #'Tests-Digital Signatures'! SystemOrganization addCategory: #'Tests-Environments'! SystemOrganization addCategory: #'Tests-Exceptions'! SystemOrganization addCategory: #'Tests-FilePackage'! SystemOrganization addCategory: #'Tests-Files'! SystemOrganization addCategory: #'Tests-Finalization'! SystemOrganization addCategory: #'Tests-Hex'! SystemOrganization addCategory: #'Tests-Installer-Core'! SystemOrganization addCategory: #'Tests-Localization'! SystemOrganization addCategory: #'Tests-Monticello'! SystemOrganization addCategory: #'Tests-Monticello-Mocks'! SystemOrganization addCategory: #'Tests-Monticello-Utils'! SystemOrganization addCategory: #'Tests-Object Events'! SystemOrganization addCategory: #'Tests-ObjectsAsMethods'! SystemOrganization addCategory: #'Tests-PrimCallController'! SystemOrganization addCategory: #'Tests-Release'! + SystemOrganization addCategory: #'Tests-System-Digital Signatures'! SystemOrganization addCategory: #'Tests-System-Object Storage'! + SystemOrganization addCategory: #'Tests-System-Preferences'! SystemOrganization addCategory: #'Tests-System-Support'! SystemOrganization addCategory: #'Tests-Utilities'! SystemOrganization addCategory: #'Tests-VM'! - SystemOrganization addCategory: #'Tests-System-Digital Signatures'! - SystemOrganization addCategory: #'Tests-System-Preferences'! Item was changed: + ----- Method: MCDictionaryRepositoryTest>>addVersion: (in category 'actions') ----- - ----- Method: MCDictionaryRepositoryTest>>addVersion: (in category 'as yet unclassified') ----- addVersion: aVersion dict at: aVersion info put: aVersion! Item was changed: + ----- Method: MCDictionaryRepositoryTest>>deleteNode: (in category 'actions') ----- - ----- Method: MCDictionaryRepositoryTest>>deleteNode: (in category 'as yet unclassified') ----- deleteNode: aNode dict removeKey: aNode! Item was changed: + ----- Method: MCDictionaryRepositoryTest>>dictionary (in category 'accessing') ----- - ----- Method: MCDictionaryRepositoryTest>>dictionary (in category 'as yet unclassified') ----- dictionary ^ dict ifNil: [dict := Dictionary new]! Item was changed: + ----- Method: MCDictionaryRepositoryTest>>setUp (in category 'running') ----- - ----- Method: MCDictionaryRepositoryTest>>setUp (in category 'as yet unclassified') ----- setUp repository := MCDictionaryRepository new dictionary: self dictionary! Item was changed: + ----- Method: MCDirectoryRepositoryTest>>addVersion: (in category 'actions') ----- - ----- Method: MCDirectoryRepositoryTest>>addVersion: (in category 'as yet unclassified') ----- addVersion: aVersion | file | file := FileStream newFileNamed: (directory fullNameFor: aVersion fileName). aVersion fileOutOn: file. file close.! Item was changed: + ----- Method: MCDirectoryRepositoryTest>>directory (in category 'accessing') ----- - ----- Method: MCDirectoryRepositoryTest>>directory (in category 'as yet unclassified') ----- directory directory ifNil: [directory := FileDirectory default directoryNamed: 'mctest'. directory assureExistence]. ^ directory! Item was changed: + ----- Method: MCDirectoryRepositoryTest>>setUp (in category 'running') ----- - ----- Method: MCDirectoryRepositoryTest>>setUp (in category 'as yet unclassified') ----- setUp repository := MCDirectoryRepository directory: self directory! Item was changed: + ----- Method: MCDirectoryRepositoryTest>>tearDown (in category 'running') ----- - ----- Method: MCDirectoryRepositoryTest>>tearDown (in category 'as yet unclassified') ----- tearDown super tearDown. self directory recursiveDelete! Item was changed: ----- Method: MCEnvironmentLoadTest>>tearDown (in category 'running') ----- tearDown (environment allClassesAndTraits sorted: [:a :b | (a allSuperclasses includes: b) or: [a name < b name]]) + do: [:each | each removeFromSystem]. + super tearDown! - do: [:each | each removeFromSystem]! Item was changed: + ----- Method: MCInitializationTest>>tearDown (in category 'running') ----- - ----- Method: MCInitializationTest>>tearDown (in category 'as yet unclassified') ----- tearDown super tearDown. (MCWorkingCopy forPackage: self mockPackage) unregister! Item was changed: + ----- Method: MCInitializationTest>>testWorkingCopy (in category 'tests') ----- - ----- Method: MCInitializationTest>>testWorkingCopy (in category 'as yet unclassified') ----- testWorkingCopy MczInstaller storeVersionInfo: self mockVersion. MCWorkingCopy initialize. MCWorkingCopy allManagers detect: [:man | man package name = self mockPackage name] ifNone: [self assert: false]! Item was changed: + ----- Method: MCMczInstallerTest>>assertDict:matchesInfo: (in category 'asserting') ----- - ----- Method: MCMczInstallerTest>>assertDict:matchesInfo: (in category 'as yet unclassified') ----- assertDict: dict matchesInfo: info #(name id message date time author) do: [:sel | (info perform: sel) ifNotNil: [:i | dict at: sel ifPresent: [:d | self assert: i = d]]]. info ancestors with: (dict at: #ancestors) do: [:i :d | self assertDict: d matchesInfo: i]! Item was changed: + ----- Method: MCMczInstallerTest>>assertNoChange (in category 'asserting') ----- - ----- Method: MCMczInstallerTest>>assertNoChange (in category 'as yet unclassified') ----- assertNoChange | actual | actual := MCSnapshotResource takeSnapshot. diff := actual patchRelativeToBase: expected snapshot. self assert: diff isEmpty! Item was changed: + ----- Method: MCMczInstallerTest>>assertVersionInfoPresent (in category 'asserting') ----- - ----- Method: MCMczInstallerTest>>assertVersionInfoPresent (in category 'as yet unclassified') ----- assertVersionInfoPresent | dict info | dict := MczInstaller versionInfo at: self mockPackage name. info := expected info. self assertDict: dict matchesInfo: info.! Item was changed: + ----- Method: MCMczInstallerTest>>defaultTimeout (in category 'accessing') ----- - ----- Method: MCMczInstallerTest>>defaultTimeout (in category 'as yet unclassified') ----- defaultTimeout ^ super defaultTimeout * 10 "seconds"! Item was changed: + ----- Method: MCMczInstallerTest>>deleteFile (in category 'actions') ----- - ----- Method: MCMczInstallerTest>>deleteFile (in category 'as yet unclassified') ----- deleteFile (FileDirectory default fileExists: self fileName) ifTrue: [FileDirectory default deleteFileNamed: self fileName]! Item was changed: + ----- Method: MCMczInstallerTest>>fileName (in category 'accessing') ----- - ----- Method: MCMczInstallerTest>>fileName (in category 'as yet unclassified') ----- fileName ^ 'InstallerTest.mcz' asMCVersionName! Item was changed: + ----- Method: MCMczInstallerTest>>fileStream (in category 'accessing') ----- - ----- Method: MCMczInstallerTest>>fileStream (in category 'as yet unclassified') ----- fileStream ^ FileStream forceNewFileNamed: self fileName.! Item was changed: + ----- Method: MCMczInstallerTest>>setUp (in category 'running') ----- - ----- Method: MCMczInstallerTest>>setUp (in category 'as yet unclassified') ----- setUp expected := self mockVersion. self change: #one toReturn: 2.! Item was changed: + ----- Method: MCMczInstallerTest>>tearDown (in category 'running') ----- - ----- Method: MCMczInstallerTest>>tearDown (in category 'as yet unclassified') ----- tearDown super tearDown. expected snapshot updatePackage: self mockPackage. self deleteFile.! Item was changed: + ----- Method: MCMczInstallerTest>>testInstallFromFile (in category 'testing') ----- - ----- Method: MCMczInstallerTest>>testInstallFromFile (in category 'as yet unclassified') ----- testInstallFromFile MCMczWriter fileOut: expected on: self fileStream. MczInstaller installFileNamed: self fileName. self assertNoChange.! Item was changed: + ----- Method: MCMczInstallerTest>>testInstallFromStream (in category 'testing') ----- - ----- Method: MCMczInstallerTest>>testInstallFromStream (in category 'as yet unclassified') ----- testInstallFromStream | stream | stream := RWBinaryOrTextStream on: String new. MCMczWriter fileOut: expected on: stream. MczInstaller installStream: stream reset. self assertNoChange. self assertVersionInfoPresent. ! Item was changed: MCTestCase subclass: #MCMethodDefinitionTest + instanceVariableNames: 'navigation isModified overrideTimestamp extensionPackage' - instanceVariableNames: 'navigation isModified overrideTimestamp' classVariableNames: '' poolDictionaries: '' category: 'Tests-Monticello'! Item was changed: ----- Method: MCMethodDefinitionTest>>setUp (in category 'running') ----- setUp + extensionPackage := (MCWorkingCopy forPackage: (MCPackage named: 'FooBarBaz')). - navigation := (Smalltalk hasClassNamed: #SystemNavigation) ifTrue: [(Smalltalk at: #SystemNavigation) new] ifFalse: [Smalltalk]. isModified := self ownPackage modified. overrideTimestamp := (self class >> #override) timeStamp! Item was changed: ----- Method: MCMethodDefinitionTest>>tearDown (in category 'running') ----- tearDown self restoreMocks. + extensionPackage unregister. + extensionPackage := nil. - (MCWorkingCopy forPackage: (MCPackage named: 'FooBarBaz')) unregister. MCMockPackageInfo new mcPackage workingCopy unregister. self class compile: 'override ^ 1' classified: 'mocks' withStamp: overrideTimestamp notifying: nil. SystemOrganizer default removeEmptyCategories. self ownPackage modified: isModified. super tearDown ! Item was changed: + ----- Method: MCOrganizationTest>>testReordering (in category 'testing') ----- - ----- Method: MCOrganizationTest>>testReordering (in category 'as yet unclassified') ----- testReordering |dec cats newCats | dec := MCOrganizationDefinition categories: #(A B C). cats := #(X Y B Z C A Q). newCats := dec reorderCategories: cats original: #(B C A). self assert: newCats asArray = #(X Y A B C Z Q).! Item was changed: + ----- Method: MCOrganizationTest>>testReorderingWithNoCategoriesInVersion (in category 'testing') ----- - ----- Method: MCOrganizationTest>>testReorderingWithNoCategoriesInVersion (in category 'as yet unclassified') ----- testReorderingWithNoCategoriesInVersion |dec cats newCats | dec := MCOrganizationDefinition categories: #(). cats := #(X Y B Z C A Q). newCats := dec reorderCategories: cats original: #(). self assert: newCats asArray = cats.! Item was changed: + ----- Method: MCOrganizationTest>>testReorderingWithRemovals (in category 'testing') ----- - ----- Method: MCOrganizationTest>>testReorderingWithRemovals (in category 'as yet unclassified') ----- testReorderingWithRemovals |dec cats newCats | dec := MCOrganizationDefinition categories: #(A B C). cats := #(X Y B Z C A Q). newCats := dec reorderCategories: cats original: #(Y B C A Q). self assert: newCats asArray = #(X A B C Z).! Item was changed: + ----- Method: MCPatchTest>>setUp (in category 'running') ----- - ----- Method: MCPatchTest>>setUp (in category 'as yet unclassified') ----- setUp |rev1 rev2| rev1 := MCSnapshotResource takeSnapshot. self change: #one toReturn: 2. rev2 := MCSnapshotResource takeSnapshot. patch := rev2 patchRelativeToBase: rev1. self change: #one toReturn: 1.! Item was changed: + ----- Method: MCPatchTest>>tearDown (in category 'running') ----- - ----- Method: MCPatchTest>>tearDown (in category 'as yet unclassified') ----- tearDown super tearDown. self restoreMocks! Item was changed: + ----- Method: MCPatchTest>>testPatchContents (in category 'testing') ----- - ----- Method: MCPatchTest>>testPatchContents (in category 'as yet unclassified') ----- testPatchContents self assert: patch operations size = 1. self assert: patch operations first isModification. self assert: patch operations first definition selector = #one. ! Item was changed: MCTestCase subclass: #MCRepositoryTest + instanceVariableNames: 'repository' - instanceVariableNames: 'repository ancestors' classVariableNames: '' poolDictionaries: '' category: 'Tests-Monticello'! + + !MCRepositoryTest commentStamp: 'nice 12/7/2017 00:08' prior: 0! + Abstract superclass for Monticello Repository tests + + Instance Variables + repository: <MCRepository> + + repository + - the instance of MCRepository subclass being tested + ! Item was changed: + ----- Method: MCSnapshotResource>>definitions (in category 'accessing') ----- - ----- Method: MCSnapshotResource>>definitions (in category 'as yet unclassified') ----- definitions ^ snapshot definitions! Item was changed: + ----- Method: MCSnapshotResource>>setUp (in category 'running') ----- - ----- Method: MCSnapshotResource>>setUp (in category 'as yet unclassified') ----- setUp snapshot := self class takeSnapshot.! Item was changed: + ----- Method: MCSnapshotResource>>snapshot (in category 'accessing') ----- - ----- Method: MCSnapshotResource>>snapshot (in category 'as yet unclassified') ----- snapshot ^ snapshot! Item was changed: + ----- Method: MCStReaderTest>>commentWithStyle (in category 'accessing') ----- - ----- Method: MCStReaderTest>>commentWithStyle (in category 'as yet unclassified') ----- commentWithStyle ^ '!!AEDesc commentStamp: ''<historical>'' prior: 0!! I represent an Apple Event Descriptor. I am a low-level representation of Apple Event (and hence Applescript) information. For further Information, see Apple''s Inside Macintosh: Interapplication Communications, at http://developer.apple.com/techpubs/mac/IAC/IAC-2.html. Essentially, I represent a record comprising a one-word "string" (treating the word as fourbyte characters) representing a data type, followed by a pointer to a pointer (a handle) to the data I represent. Care must be taken to assure that the Handle data is disposed after use, or memory leaks result. At this time, I make no effort to do this automatically through finalization.!! ]style[(218 54 384)f1,f1Rhttp://developer.apple.com/techpubs/mac/IAC/IAC-2.html;,f1!! '! Item was changed: + ----- Method: MCStReaderTest>>commentWithoutStyle (in category 'accessing') ----- - ----- Method: MCStReaderTest>>commentWithoutStyle (in category 'as yet unclassified') ----- commentWithoutStyle ^ ' CharacterScanner subclass: #CanvasCharacterScanner instanceVariableNames: ''canvas fillBlt foregroundColor runX lineY '' classVariableNames: '''' poolDictionaries: '''' category: ''Morphic-Support''!! !!CanvasCharacterScanner commentStamp: ''<historical>'' prior: 0!! A displaying scanner which draws its output to a Morphic canvas.!! !!CanvasCharacterScanner methodsFor: ''stop conditions'' stamp: ''ar 12/15/2001 23:27''!! setStopConditions "Set the font and the stop conditions for the current run." self setFont. stopConditions at: Space asciiValue + 1 put: (alignment = Justified ifTrue: [#paddedSpace])!! !!'! Item was changed: + ----- Method: MCStReaderTest>>methodWithStyle (in category 'accessing') ----- - ----- Method: MCStReaderTest>>methodWithStyle (in category 'as yet unclassified') ----- methodWithStyle ^ '!!EventHandler methodsFor: ''copying'' stamp: ''tk 1/22/2001 17:39''!! veryDeepInner: deepCopier "ALL fields are weakly copied. Can''t duplicate an object by duplicating a button that activates it. See DeepCopier." super veryDeepInner: deepCopier. "just keep old pointers to all fields" clickRecipient := clickRecipient.!! ]style[(25 108 10 111)f1b,f1,f1LDeepCopier Comment;,f1!! !! '! Item was changed: + ----- Method: MCStReaderTest>>testCommentWithStyle (in category 'tests') ----- - ----- Method: MCStReaderTest>>testCommentWithStyle (in category 'as yet unclassified') ----- testCommentWithStyle | reader | reader := MCStReader on: self commentWithStyle readStream. reader definitions! Item was changed: + ----- Method: MCStReaderTest>>testCommentWithoutStyle (in category 'tests') ----- - ----- Method: MCStReaderTest>>testCommentWithoutStyle (in category 'as yet unclassified') ----- testCommentWithoutStyle | reader | reader := MCStReader on: self commentWithoutStyle readStream. self assert: (reader definitions anySatisfy: [:ea | ea isMethodDefinition]).! Item was changed: + ----- Method: MCStReaderTest>>testMethodWithStyle (in category 'tests') ----- - ----- Method: MCStReaderTest>>testMethodWithStyle (in category 'as yet unclassified') ----- testMethodWithStyle | reader | reader := MCStReader on: self methodWithStyle readStream. self assert: reader definitions first isMethodDefinition.! Item was changed: TestCase subclass: #MCTestCase instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Tests-Monticello'! + + !MCTestCase commentStamp: 'nice 12/7/2017 00:11' prior: 0! + Abstract superclass for Monticello tests + Monticello is the distributed source code management system.! Item was changed: + ----- Method: MCVersionNameTest>>allValidFixtures (in category 'accessing') ----- - ----- Method: MCVersionNameTest>>allValidFixtures (in category 'as yet unclassified') ----- allValidFixtures ^ self standardFixtures , (self diffyFixtures pairsCollect: [:diffy :base | diffy])! Item was changed: + ----- Method: MCVersionNameTest>>diffyBranchFixtures (in category 'accessing') ----- - ----- Method: MCVersionNameTest>>diffyBranchFixtures (in category 'as yet unclassified') ----- diffyBranchFixtures ^ #( 'Package.branch-author.123(origAuthor.122)' 'Package.branch-origAuthor.122' 'Package.branch-author.123(origAuthor.122).mcd' 'Package.branch-origAuthor.122.mcd' 'Package.branch-author.123(122)' 'Package.branch-author.122' 'Package.branch-author.123((a)origPackage-origAuthor.122)' 'origPackage-origAuthor.122' 'Package-author.123((a)origPackage.branch-origAuthor.122)' 'origPackage.branch-origAuthor.122' ) collect: [ : each | each asMCVersionName ]! Item was changed: + ----- Method: MCVersionNameTest>>diffyFixtures (in category 'accessing') ----- - ----- Method: MCVersionNameTest>>diffyFixtures (in category 'as yet unclassified') ----- diffyFixtures ^ #( 'Package-author.123(origAuthor.122)' 'Package-origAuthor.122' 'Package-author.123(origAuthor.122).mcd' 'Package-origAuthor.122.mcd' 'Package-author.123(122)' 'Package-author.122' 'Package-author.123((a)origPackage-origAuthor.122)' 'origPackage-origAuthor.122' ) collect: [ : each | each asMCVersionName ]! Item was changed: + ----- Method: MCVersionNameTest>>invalidFixtures (in category 'accessing') ----- - ----- Method: MCVersionNameTest>>invalidFixtures (in category 'as yet unclassified') ----- invalidFixtures ^ {String empty. 'abc'. '123' } collect: [ : each | each asMCVersionName ]! Item was changed: + ----- Method: MCVersionNameTest>>standardFixtures (in category 'accessing') ----- - ----- Method: MCVersionNameTest>>standardFixtures (in category 'as yet unclassified') ----- standardFixtures ^ #('Package-author.123' 'Package-author.123.mcz' ) collect: [ : each | each asMCVersionName ]! Item was changed: + ----- Method: MCVersionNameTest>>verifyDiffy:base: (in category 'tests') ----- - ----- Method: MCVersionNameTest>>verifyDiffy:base: (in category 'as yet unclassified') ----- verifyDiffy: diffyMCVersionName base: expectedBaseMCVersionName self assert: diffyMCVersionName baseVersionName = expectedBaseMCVersionName! Item was changed: + ----- Method: MCVersionNameTest>>verifyPackageAuthorVersion: (in category 'tests') ----- - ----- Method: MCVersionNameTest>>verifyPackageAuthorVersion: (in category 'as yet unclassified') ----- verifyPackageAuthorVersion: aMCFileName self assert: aMCFileName versionName = 'Package-author.123'; assert: aMCFileName packageName = 'Package' ; assert: aMCFileName versionNumber = 123 ; assert: aMCFileName author = 'author' ; assert: aMCFileName isValid!

1 0

The Trunk: Files-nice.175.mcz
by commits＠source.squeak.org 06 Dec '17

06 Dec '17

Nicolas Cellier uploaded a new version of Files to project The Trunk: http://source.squeak.org/trunk/Files-nice.175.mcz ==================== Summary ==================== Name: Files-nice.175 Author: nice Time: 6 December 2017, 11:06:36.405817 pm UUID: f8c4858f-bd11-425d-86e7-32e4f353f43d Ancestors: Files-tpr.174 Workaround for truncated readOnlyCopy of .changes log file on linux. On linux, the latest bytes written to the change log are not allways taken into account when we create a readOnlyCopy. The readOnlyCopy then appear as truncated. This can cause an infinite loop in MCMockPackageInfo(PackageInfo)>>changeRecordForOverriddenMethod: See https://github.com/hpi-swa/smalltalkCI/issues/350 =============== Diff against Files-tpr.174 =============== Item was changed: ----- Method: StandardFileStream>>readOnlyCopy (in category 'read, write, position') ----- readOnlyCopy + self flush. "Some linux open a truncated readOnlyCopy. Force it to take latest bytes written into account." - ^ self class readOnlyFileNamed: self name. !

1 0

The Trunk: Graphics-mt.388.mcz
by commits＠source.squeak.org 05 Dec '17

05 Dec '17

Marcel Taeumel uploaded a new version of Graphics to project The Trunk: http://source.squeak.org/trunk/Graphics-mt.388.mcz ==================== Summary ==================== Name: Graphics-mt.388 Author: mt Time: 5 December 2017, 7:44:18.464667 am UUID: c4dbc715-98d3-ea4d-9837-df2ebd8f6b18 Ancestors: Graphics-mt.387 Addition to last commit. Due to the "self depth" call the previous change did not reach into #scaledIntoFormOfSize:smoothing:. *sigh* =============== Diff against Graphics-mt.387 =============== Item was added: + ----- Method: ColorForm>>scaledIntoFormOfSize:smoothing: (in category 'scaling, rotation') ----- + scaledIntoFormOfSize: aNumberOrPoint smoothing: factor + + ^ (self asFormOfDepth: 32) scaledIntoFormOfSize: aNumberOrPoint smoothing: factor!

1 0

The Trunk: Graphics-mt.387.mcz
by commits＠source.squeak.org 05 Dec '17

05 Dec '17

Marcel Taeumel uploaded a new version of Graphics to project The Trunk: http://source.squeak.org/trunk/Graphics-mt.387.mcz ==================== Summary ==================== Name: Graphics-mt.387 Author: mt Time: 5 December 2017, 7:39:11.735052 am UUID: d672e9af-b20d-284b-9e54-799643bcd0ee Ancestors: Graphics-pre.386 Updates workaround to fix broken colors after scaling color(-palette) forms. =============== Diff against Graphics-pre.386 =============== Item was removed: - ----- Method: ColorForm>>scaledToSize: (in category 'scaling, rotation') ----- - scaledToSize: newExtent - - "super method did not seem to work so well on ColorForms" - - ^(self asFormOfDepth: 16) scaledToSize: newExtent! Item was added: + ----- Method: ColorForm>>scaledToSize:smoothing: (in category 'scaling, rotation') ----- + scaledToSize: newExtent smoothing: factor + "super method did not seem to work so well on ColorForms" + + ^(self asFormOfDepth: 32) scaledToSize: newExtent smoothing: factor!

1 0

The Trunk: Network-nice.212.mcz
by commits＠source.squeak.org 02 Dec '17

02 Dec '17

Nicolas Cellier uploaded a new version of Network to project The Trunk: http://source.squeak.org/trunk/Network-nice.212.mcz ==================== Summary ==================== Name: Network-nice.212 Author: nice Time: 2 December 2017, 10:29:23.48884 pm UUID: be2cd95d-5a11-437a-9014-2de33fdbe2bc Ancestors: Network-pre.211 Remove remnant methods from MailComposition now that it has been refactored (Tool-builder-ized and using a MailMessage instance) =============== Diff against Network-pre.211 =============== Item was removed: - ----- Method: MailComposition>>menuGet:shifted: (in category 'interface') ----- - menuGet: aMenu shifted: shifted - - aMenu addList: { - {'find...(f)' translated. #find}. - {'find selection again (g)' translated. #findAgain}. - #-. - {'accept (s)' translated. #accept}. - {'send message' translated. #submit}}. - - ^aMenu.! Item was removed: - ----- Method: MailComposition>>submit (in category 'access') ----- - submit - | message | - "submit the message" - textEditor - ifNotNil: [self hasUnacceptedEdits ifTrue: [textEditor accept]]. - message := MailMessage from: messageText asString. - self breakLinesInMessage: message. - SMTPClient deliverMailFrom: message from to: (Array with: message to) text: message text usingServer: self smtpServer. - - morphicWindow ifNotNil: [morphicWindow delete]. - mvcWindow ifNotNil: [mvcWindow controller close]!

1 0

The Trunk: ST80-nice.232.mcz
by commits＠source.squeak.org 02 Dec '17

02 Dec '17

Nicolas Cellier uploaded a new version of ST80 to project The Trunk: http://source.squeak.org/trunk/ST80-nice.232.mcz ==================== Summary ==================== Name: ST80-nice.232 Author: nice Time: 2 December 2017, 10:05:36.568131 pm UUID: 8575119e-3256-4a18-add5-d4a5f5e1b526 Ancestors: ST80-dtl.231 MailComposition has been tool-builder-ized, remove obsolete mvcOpen extension. =============== Diff against ST80-dtl.231 =============== Item was removed: - ----- Method: MailComposition>>mvcOpen (in category '*ST80-Support') ----- - mvcOpen - | textView sendButton | - - mvcWindow := StandardSystemView new - label: 'Mister Postman'; - minimumSize: 400@250; - model: self. - - textView := PluggableTextView - on: self - text: #messageText - accept: #messageText:. - textEditor := textView controller. - - sendButton := PluggableButtonView - on: self - getState: nil - action: #submit. - sendButton label: 'Send'. - sendButton borderWidth: 1. - - sendButton window: (1@1 extent: 398@38). - mvcWindow addSubView: sendButton. - - textView window: (0@40 corner: 400@250). - mvcWindow addSubView: textView below: sendButton. - - mvcWindow controller open. - - - !

1 0

← Newer
1
2
3
4
5
6
7
8
9
10
Older →

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Packages December 2017