Packages May 2023

packages@lists.squeakfoundation.org

1 participants
55 discussions

The Trunk: NetworkTests-ct.69.mcz
by commits＠source.squeak.org 20 May '23

20 May '23

Christoph Thiede uploaded a new version of NetworkTests to project The Trunk: http://source.squeak.org/trunk/NetworkTests-ct.69.mcz ==================== Summary ==================== Name: NetworkTests-ct.69 Author: ct Time: 20 May 2023, 9:38:06.86756 pm UUID: 0f327edd-9f2f-4a43-afcc-614671e5b8df Ancestors: NetworkTests-ct.68 Complements Network-ct.272 (#bodyTextFormatted: shouldPreferRichText for nested multipart documents). =============== Diff against NetworkTests-ct.68 =============== Item was changed: ----- Method: MIMEDocumentTest>>testBodyTextFormatted (in category 'tests') ----- testBodyTextFormatted | pngContent pngText pngContent2 pngText2 mailContent mailText | pngContent := (ByteArray streamContents: [:s | PNGReadWriter putForm: (Form dotOfSize: 8 color: Color orange) onStream: s]) asString. pngText := '<img src="code://Form dotOfSize: 8 color: Color orange" />' asTextFromHtml removeAttributesThat: [:ea | ea isKindOf: TextColor]; yourself. pngContent2 := (ByteArray streamContents: [:s | PNGReadWriter putForm: (Form dotOfSize: 16 color: Color blue) onStream: s]) asString. pngText2 := '<img src="code://Form dotOfSize: 16 color: Color blue" />' asTextFromHtml removeAttributesThat: [:ea | ea isKindOf: TextColor]; yourself. mailContent := MailMessage empty in: [:m | m body content: 'hi']; text. mailText := 'hi\\' withCRs. "short framework test in advance - can we distinguish between different images?" self deny: pngText runs printString equals: pngText2 runs printString. OrderedDictionary new "text" at: (MIMEDocument contentType: MIMEDocument contentTypePlainText content: 'plain test') put: 'plain test'; at: (MIMEDocument contentType: MIMEDocument contentTypeHtml content: 'html test') put: 'html test' asText; at: (MIMEDocument contentType: MIMEDocument contentTypeHtml content: 'bold <img src="https://squeak.org/static/img/squeak.png" /> <img src="code://Form dotOfSize: 8" />') put: 'bold <img src="https://squeak.org/static/img/squeak.png" /> <img src="lol" />' asTextFromHtml; "embedded stuff" at: (MIMEDocument contentType: 'image/png' content: pngContent) put: pngText; at: (MIMEDocument contentType: 'message/rfc822' content: mailContent) put: mailText; "multipart/alternative" "plain and rich text" at: ((MIMEDocument contentType: 'multipart/alternative') addPart: (MIMEDocument contentType: MIMEDocument contentTypePlainText content: 'plain test'); addPart: (MIMEDocument contentType: MIMEDocument contentTypeHtml content: 'html test'); yourself) put: {'plain test'. 'html test' asText}; + "plain and rich text (different order)" - "plain and rich text (different ordr)" at: ((MIMEDocument contentType: 'multipart/alternative') addPart: (MIMEDocument contentType: MIMEDocument contentTypeHtml content: 'html test'); addPart: (MIMEDocument contentType: MIMEDocument contentTypePlainText content: 'plain test'); yourself) put: {'plain test'. 'html test' asText}; "only plain text" at: ((MIMEDocument contentType: 'multipart/alternative') addPart: (MIMEDocument contentType: MIMEDocument contentTypePlainText content: 'plain test'); yourself) put: 'plain test'; "only rich text" at: ((MIMEDocument contentType: 'multipart/alternative') addPart: (MIMEDocument contentType: MIMEDocument contentTypeHtml content: 'html test'); yourself) put: 'html test' asText; "only other stuff" at: ((MIMEDocument contentType: 'multipart/alternative') addPart: (MIMEDocument contentType: 'message/rfc822' content: mailContent); yourself) put: mailText; + "plain and rich text, but nested" + at: ((MIMEDocument contentType: 'multipart/alternative') addPart: ((MIMEDocument contentType: 'multipart/mixed') addPart: (MIMEDocument contentType: MIMEDocument contentTypePlainText content: 'plain test'); yourself); addPart: ((MIMEDocument contentType: 'multipart/related') addPart: (MIMEDocument contentType: MIMEDocument contentTypeHtml content: 'html test'); yourself); yourself) put: {'plain test' asText. 'html test' asText}; + "plain and rich text, but nested, different order" + at: ((MIMEDocument contentType: 'multipart/alternative') addPart: ((MIMEDocument contentType: 'multipart/related') addPart: (MIMEDocument contentType: MIMEDocument contentTypeHtml content: 'html test'); yourself); addPart: ((MIMEDocument contentType: 'multipart/mixed') addPart: (MIMEDocument contentType: MIMEDocument contentTypePlainText content: 'plain test'); yourself); yourself) put: {'plain test' asText. 'html test' asText}; "multipart/related" "plain text with CIDs" at: ((MIMEDocument contentType: 'multipart/related') addPart: (MIMEDocument contentType: MIMEDocument contentTypePlainText content: 'plain test [cid:griffle] [cid:plonk] [cid:goo]'); addPart: ((MIMEDocument contentType: 'image/png' content: pngContent) setField: 'content-id' toString: 'plonk'; yourself); addPart: ((MIMEDocument contentType: 'image/png' content: pngContent2) setField: 'content-id' toString: 'griffle'; yourself); yourself) put: ('plain test {1} {2} [cid:goo]' asTextFromHtml format: {pngText2. pngText}); "rich text with CIDs" at: ((MIMEDocument contentType: 'multipart/related') addPart: (MIMEDocument contentType: MIMEDocument contentTypeHtml content: 'html test <img src="cid:griffle" /> <img src="cid:plonk" /> <img src="cid:goo" />'); addPart: ((MIMEDocument contentType: 'image/png' content: pngContent) setField: 'content-id' toString: 'plonk'; yourself); addPart: ((MIMEDocument contentType: 'image/png' content: pngContent2) setField: 'content-id' toString: 'griffle'; yourself); yourself) put: 'html test <img src="code://Form dotOfSize: 16 color: Color blue" /> <img src="code://Form dotOfSize: 8 color: Color orange" /> <img src="lol" />' asTextFromHtml; "multipart/mixed" at: ((MIMEDocument contentType: 'multipart/mixed') addPart: ((MIMEDocument contentType: MIMEDocument contentTypePlainText content: 'plonk') setField: 'content-disposition' toString: 'inline'; yourself); addPart: ((MIMEDocument contentType: MIMEDocument contentTypePlainText content: 'griffle') setField: 'content-disposition' toString: 'attachment'; yourself); addPart: (MIMEDocument contentType: 'image/png' content: pngContent); yourself) put: ('plonk\' withCRs asText , ('[attachment]' asText addAttribute: TextMessageLink new; yourself) , '\' withCRs , pngText); keysAndValuesDo: [:document :expectedTexts | | expectedText actualText | expectedText := expectedTexts isArray ifTrue: [expectedTexts first] ifFalse: [expectedTexts]. actualText := document bodyTextFormatted. self assert: expectedText asString equals: actualText asString; assert: (expectedText isText ifTrue: [expectedText runs printString]) equals: (actualText isText ifTrue: [actualText runs printString])]; keysAndValuesDo: [:document :expectedTexts | | expectedText actualText | expectedText := expectedTexts isArray ifTrue: [expectedTexts second] ifFalse: [expectedTexts]. actualText := document bodyTextFormattedRich. self assert: expectedText asString equals: actualText asString; assert: (expectedText isText ifTrue: [expectedText runs printString]) equals: (actualText isText ifTrue: [actualText runs printString])].!

1 0

The Trunk: Network-ct.272.mcz
by commits＠source.squeak.org 20 May '23

20 May '23

Christoph Thiede uploaded a new version of Network to project The Trunk: http://source.squeak.org/trunk/Network-ct.272.mcz ==================== Summary ==================== Name: Network-ct.272 Author: ct Time: 20 May 2023, 9:37:17.72456 pm UUID: 858f929e-1da2-e648-a89b-3c9d5e6702a5 Ancestors: Network-ct.271 Makes #bodyTextFormatted: find the preferred message format even when it is nested in another multipart document. =============== Diff against Network-ct.271 =============== Item was changed: ----- Method: MIMEDocument>>bodyTextFormatted: (in category 'serializing') ----- bodyTextFormatted: shouldPreferRichText self isMultipart ifTrue: [ self isMultipartAlternative ifTrue: [ "https://www.w3.org/Protocols/rfc1341/7_2_Multipart.html" | preferredTypes | preferredTypes := #('text/plain' 'text/html'). shouldPreferRichText ifTrue: [preferredTypes := preferredTypes reversed]. preferredTypes do: [:format | self parts do: [:part | + (part containsInlineContentType: format) ifTrue: [ - part contentType = format ifTrue: [ ^ part bodyTextFormatted: shouldPreferRichText]]]. "fallback" ^ self parts first bodyTextFormatted: shouldPreferRichText]. self subType = 'related' ifTrue: [ "RFC2387" ^ [self parts first bodyTextFormatted: shouldPreferRichText] on: MIMEContentRequest do: [:request | (self partWithContentID: request cid) ifNotNil: [:part | request resume: part]. request pass]]. ^ Text streamContents: [:stream | self parts do: [:part | stream nextPutAll: (part contentDisposition = 'inline' ifTrue: [part bodyTextFormatted: shouldPreferRichText] ifFalse: [part attachmentText])] separatedBy: [stream cr]]]. self contentType = 'message/rfc822' ifTrue: [ "embedded message" ^ (MailMessage from: self content) bodyTextFormatted: shouldPreferRichText]. self isHTML ifTrue: [ (Smalltalk classNamed: #HtmlReadWriter) ifNotNil: [:readerClass | ^ (readerClass on: self content readStream) shallEvaluateResources: false; nextText]]. self isPlaintext ifTrue: [ ^ self plainTextWithResolvedCIDReferences: shouldPreferRichText]. self containsViewableImage ifTrue: [ | form scaleFactor | form := self image. (scaleFactor := RealEstateAgent scaleFactor) = 1.0 ifFalse: [form := form scaledToSize: form extent * scaleFactor]. ^ Text string: Character startOfHeader asString attribute: form asTextAnchor]. "fallback" ^ self content! Item was added: + ----- Method: MIMEDocument>>containsInlineContentType: (in category 'testing') ----- + containsInlineContentType: type + + self contentType = type ifTrue: [^ true]. + + self isMultipart ifTrue: [ + self subType = 'related' ifTrue: [ + ^ self parts first containsInlineContentType: type]. + + ^ self parts anySatisfy: [:part | + part contentDisposition = #inline and: [ + part containsInlineContentType: type]]]. + + ^ false!

1 0

The Trunk: CollectionsTests-ct.393.mcz
by commits＠source.squeak.org 20 May '23

20 May '23

Christoph Thiede uploaded a new version of CollectionsTests to project The Trunk: http://source.squeak.org/trunk/CollectionsTests-ct.393.mcz ==================== Summary ==================== Name: CollectionsTests-ct.393 Author: ct Time: 20 May 2023, 9:34:38.34256 pm UUID: fb386fef-9047-4f49-8bd6-9d475ca0655e Ancestors: CollectionsTests-ct.392 Complements Collections-ct.1039. =============== Diff against CollectionsTests-ct.392 =============== Item was changed: ----- Method: HtmlReadWriterTest>>test16ImgTag (in category 'tests') ----- test16ImgTag <timeout: 10> | imgUrl imgExpression formFromUrl formFromExpression | imgUrl := 'https://squeak.org/img/downloads/image.png'. imgExpression := 'Form dotOfSize: 12@12 color: Color green'. self ensureSecureInternetConnection. formFromUrl := (Smalltalk classNamed: 'WebClient') ifNotNil: [:client | Form fromBinaryStream: (client httpGet: imgUrl) content asByteArray readStream]. formFromExpression := Compiler evaluate: imgExpression. RealEstateAgent scaleFactor = 1.0 ifFalse: [ formFromUrl := formFromUrl scaledToSize: (formFromUrl extent * RealEstateAgent scaleFactor). formFromExpression := formFromExpression scaledToSize: (formFromExpression extent * RealEstateAgent scaleFactor)]. ({ []. imgUrl. formFromUrl. []. 'fantasy:wonderland/alice'. readWriter imagePlaceholder. []. 'code://' , imgExpression. formFromExpression. []. 'code://Object'. readWriter imagePlaceholder. []. 'code://' , imgExpression , ';'. readWriter imagePlaceholder. [readWriter shallDownloadResources: false]. imgUrl. readWriter imagePlaceholder. [readWriter shallEvaluateResources: false]. 'code://' , imgExpression. readWriter imagePlaceholder. } groupsCollect: [:prepareBlock :src :expectedForm | { 'Hello <img src="{1}"> World' format: { src }. ('Hello {1} World' format: { Character startOfHeader }) asText addAttribute: expectedForm asTextAnchor from: 7 to: 7; addAttribute: (TextColor color: Color transparent) from: 7 to: 7. prepareBlock}]) , ({ + "different closing tag styles" 'Hello <img src="code://{1}"></img> World' format: { imgExpression }. ('Hello {1} World' format: { Character startOfHeader }) asText addAttribute: formFromExpression asTextAnchor from: 7 to: 7; addAttribute: (TextColor color: Color transparent) from: 7 to: 7. 'Hello <img src="code://{1}"/> World' format: { imgExpression }. ('Hello {1} World' format: { Character startOfHeader }) asText addAttribute: formFromExpression asTextAnchor from: 7 to: 7; addAttribute: (TextColor color: Color transparent) from: 7 to: 7. + "case, spaces, escape sequence" 'Hello <IMG SRC = "code://{1}"> World' format: { imgExpression }. ('Hello {1} World' format: { Character startOfHeader }) asText addAttribute: formFromExpression asTextAnchor from: 7 to: 7; addAttribute: (TextColor color: Color transparent) from: 7 to: 7. + "leading and trailing images" + '<img src="code://{1}"> squeak <img src="code://{1}">' format: { imgExpression }. + ('{1} squeak {1}' format: { Character startOfHeader }) asText + addAttribute: formFromExpression asTextAnchor from: 1 to: 1; + addAttribute: (TextColor color: Color transparent) from: 1 to: 1; + addAttribute: formFromExpression asTextAnchor from: 10 to: 10; + addAttribute: (TextColor color: Color transparent) from: 10 to: 10. + } pairsCollect: [:html :expectedText | {html. expectedText}]) collect: [:spec | | html expectedText prepareBlock | html := spec first. expectedText := spec second. prepareBlock := spec at: 3 ifAbsent: []. self setUpReadWriter. prepareBlock value. self convertHtml: html. self assert: expectedText string equals: text string. expectedText runs with: text runs do: [:expectedAttributes :actualAttributes | expectedAttributes with: actualAttributes do: [:expectedAttribute :actualAttribute | self assert: (expectedAttribute = actualAttribute or: [ ((expectedAttribute respondsTo: #anchoredMorph) and: [actualAttribute respondsTo: #anchoredMorph]) and: [(expectedAttribute anchoredMorph "aForm" unhibernate; bits) = (actualAttribute anchoredMorph "aForm" unhibernate; bits)] ]) ]]].!

1 0

The Trunk: Collections-ct.1039.mcz
by commits＠source.squeak.org 20 May '23

20 May '23

Christoph Thiede uploaded a new version of Collections to project The Trunk: http://source.squeak.org/trunk/Collections-ct.1039.mcz ==================== Summary ==================== Name: Collections-ct.1039 Author: ct Time: 20 May 2023, 9:33:55.67956 pm UUID: 27d6fdaf-29ca-1740-9542-92d053fc1810 Ancestors: Collections-ct.1038 Fixes two new slips in HtmlReadWriter. Typo in #shallEvaluateResources[:] and undesired truncation of leading and trailing images. =============== Diff against Collections-ct.1038 =============== Item was changed: ----- Method: HtmlReadWriter>>nextText (in category 'private') ----- nextText | text last | count := 0. offset := 0. "To ignore characters in the input string that are used by tags." runStack := Stack new. runArray := RunArray new. string := OrderedCollection new. "{text attributes. current start index. original start}" runStack push: {OrderedCollection new. 1. 1}. [stream atEnd] whileFalse: [self processNextTag]. self processRunStackTop. "Add last run." string := String withAll: string. runArray coalesce. text := Text string: string runs: runArray. preformattingLevel <= 0 ifFalse: [^ text]. "trim trailing blanks (leading blanks have been removed in #assureLinebreak and #assureSeparator)" last := string size + 1. [(last := last - 1) > lastFixedWhitespace] whileTrue: [ + | c | + ((c := string at: last) isSeparator and: [c ~= Character startOfHeader]) + ifFalse: [^ text first: last]]. - (string at: last) isSeparator ifFalse: [^ text first: last]]. ^ text! Item was changed: ----- Method: HtmlReadWriter>>shallEvaluateResources (in category 'accessing') ----- shallEvaluateResources "Indicate whether the receiver shall evaluate resources during parsing, such as an code URI in "'<img src="code://MenuIcons squeakIcon">'." May be useful for performance or security concerns." + ^ self hasPermission: #evaluateResources! - ^ self hasPermission: #downloadResources! Item was changed: ----- Method: HtmlReadWriter>>shallEvaluateResources: (in category 'accessing') ----- shallEvaluateResources: aBoolean "Set whether the receiver shall evaluate resources during parsing, such as an code URI in "'<img src="code://MenuIcons squeakIcon">'." May be useful for performance or security concerns." + ^ self setPermission: #evaluateResources to: aBoolean! - ^ self setPermission: #downloadResources to: aBoolean!

1 0

The Trunk: Network-ct.271.mcz
by commits＠source.squeak.org 20 May '23

20 May '23

Christoph Thiede uploaded a new version of Network to project The Trunk: http://source.squeak.org/trunk/Network-ct.271.mcz ==================== Summary ==================== Name: Network-ct.271 Author: ct Time: 20 May 2023, 8:27:23.43356 pm UUID: 6ca9c70d-186d-8949-ac35-ddebd6a61844 Ancestors: Network-ct.270 Adds missing comment to MIMEContentRequest. Sorry for the noise. =============== Diff against Network-ct.270 =============== Item was changed: Notification subclass: #MIMEContentRequest instanceVariableNames: 'cid' classVariableNames: '' poolDictionaries: '' category: 'Network-MIME'! + + !MIMEContentRequest commentStamp: 'ct 5/18/2023 21:10' prior: 0! + I represent the request for a related content resource in a complex MIMEDocument according to RFC2392. While reading a document from a message, I can be signaled to access another resource from the same message. If someone knows the content for the requested CID, they can #resume: me with the relevant document. Otherwise, I will eventually return nil to the signaler and leave them to their fate to deal without the desired document.!

1 0

The Trunk: Morphic-ct.2109.mcz
by commits＠source.squeak.org 20 May '23

20 May '23

Christoph Thiede uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-ct.2109.mcz ==================== Summary ==================== Name: Morphic-ct.2109 Author: ct Time: 20 May 2023, 8:24:43.98056 pm UUID: fc9a2204-f36d-ae45-9892-1503c208b785 Ancestors: Morphic-ct.2108 Complements NetworkTests-ct.67. =============== Diff against Morphic-ct.2108 =============== Item was added: + ----- Method: TextAnchor>>printOn: (in category 'as yet unclassified') ----- + printOn: aStream + + super printOn: aStream. + aStream nextPutAll: ' for '. + self anchoredMorph printOn: aStream.!

1 0

The Trunk: NetworkTests-ct.68.mcz
by commits＠source.squeak.org 20 May '23

20 May '23

Christoph Thiede uploaded a new version of NetworkTests to project The Trunk: http://source.squeak.org/trunk/NetworkTests-ct.68.mcz ==================== Summary ==================== Name: NetworkTests-ct.68 Author: ct Time: 20 May 2023, 8:24:35.121721 pm UUID: 27d792b6-f4f8-f546-8d4e-9066c66a4cc6 Ancestors: NetworkTests-ct.67 Postscript for last version: Avoids false green bar in MIMEDocumentTest>>testBodyTextFormatted. =============== Diff against NetworkTests-ct.67 =============== Item was changed: ----- Method: MIMEDocumentTest>>testBodyTextFormatted (in category 'tests') ----- testBodyTextFormatted | pngContent pngText pngContent2 pngText2 mailContent mailText | pngContent := (ByteArray streamContents: [:s | PNGReadWriter putForm: (Form dotOfSize: 8 color: Color orange) onStream: s]) asString. pngText := '<img src="code://Form dotOfSize: 8 color: Color orange" />' asTextFromHtml removeAttributesThat: [:ea | ea isKindOf: TextColor]; yourself. pngContent2 := (ByteArray streamContents: [:s | PNGReadWriter putForm: (Form dotOfSize: 16 color: Color blue) onStream: s]) asString. pngText2 := '<img src="code://Form dotOfSize: 16 color: Color blue" />' asTextFromHtml removeAttributesThat: [:ea | ea isKindOf: TextColor]; yourself. mailContent := MailMessage empty in: [:m | m body content: 'hi']; text. mailText := 'hi\\' withCRs. + + "short framework test in advance - can we distinguish between different images?" + self deny: pngText runs printString equals: pngText2 runs printString. + OrderedDictionary new "text" at: (MIMEDocument contentType: MIMEDocument contentTypePlainText content: 'plain test') put: 'plain test'; at: (MIMEDocument contentType: MIMEDocument contentTypeHtml content: 'html test') put: 'html test' asText; at: (MIMEDocument contentType: MIMEDocument contentTypeHtml content: 'bold <img src="https://squeak.org/static/img/squeak.png" /> <img src="code://Form dotOfSize: 8" />') put: 'bold <img src="https://squeak.org/static/img/squeak.png" /> <img src="lol" />' asTextFromHtml; "embedded stuff" at: (MIMEDocument contentType: 'image/png' content: pngContent) put: pngText; at: (MIMEDocument contentType: 'message/rfc822' content: mailContent) put: mailText; "multipart/alternative" "plain and rich text" at: ((MIMEDocument contentType: 'multipart/alternative') addPart: (MIMEDocument contentType: MIMEDocument contentTypePlainText content: 'plain test'); addPart: (MIMEDocument contentType: MIMEDocument contentTypeHtml content: 'html test'); yourself) put: {'plain test'. 'html test' asText}; "plain and rich text (different ordr)" at: ((MIMEDocument contentType: 'multipart/alternative') addPart: (MIMEDocument contentType: MIMEDocument contentTypeHtml content: 'html test'); addPart: (MIMEDocument contentType: MIMEDocument contentTypePlainText content: 'plain test'); yourself) put: {'plain test'. 'html test' asText}; "only plain text" at: ((MIMEDocument contentType: 'multipart/alternative') addPart: (MIMEDocument contentType: MIMEDocument contentTypePlainText content: 'plain test'); yourself) put: 'plain test'; "only rich text" at: ((MIMEDocument contentType: 'multipart/alternative') addPart: (MIMEDocument contentType: MIMEDocument contentTypeHtml content: 'html test'); yourself) put: 'html test' asText; "only other stuff" at: ((MIMEDocument contentType: 'multipart/alternative') addPart: (MIMEDocument contentType: 'message/rfc822' content: mailContent); yourself) put: mailText; "multipart/related" "plain text with CIDs" at: ((MIMEDocument contentType: 'multipart/related') addPart: (MIMEDocument contentType: MIMEDocument contentTypePlainText content: 'plain test [cid:griffle] [cid:plonk] [cid:goo]'); addPart: ((MIMEDocument contentType: 'image/png' content: pngContent) setField: 'content-id' toString: 'plonk'; yourself); addPart: ((MIMEDocument contentType: 'image/png' content: pngContent2) setField: 'content-id' toString: 'griffle'; yourself); yourself) put: ('plain test {1} {2} [cid:goo]' asTextFromHtml format: {pngText2. pngText}); "rich text with CIDs" at: ((MIMEDocument contentType: 'multipart/related') addPart: (MIMEDocument contentType: MIMEDocument contentTypeHtml content: 'html test <img src="cid:griffle" /> <img src="cid:plonk" /> <img src="cid:goo" />'); addPart: ((MIMEDocument contentType: 'image/png' content: pngContent) setField: 'content-id' toString: 'plonk'; yourself); addPart: ((MIMEDocument contentType: 'image/png' content: pngContent2) setField: 'content-id' toString: 'griffle'; yourself); yourself) put: 'html test <img src="code://Form dotOfSize: 16 color: Color blue" /> <img src="code://Form dotOfSize: 8 color: Color orange" /> <img src="lol" />' asTextFromHtml; "multipart/mixed" at: ((MIMEDocument contentType: 'multipart/mixed') addPart: ((MIMEDocument contentType: MIMEDocument contentTypePlainText content: 'plonk') setField: 'content-disposition' toString: 'inline'; yourself); addPart: ((MIMEDocument contentType: MIMEDocument contentTypePlainText content: 'griffle') setField: 'content-disposition' toString: 'attachment'; yourself); addPart: (MIMEDocument contentType: 'image/png' content: pngContent); yourself) put: ('plonk\' withCRs asText , ('[attachment]' asText addAttribute: TextMessageLink new; yourself) , '\' withCRs , pngText); keysAndValuesDo: [:document :expectedTexts | | expectedText actualText | expectedText := expectedTexts isArray ifTrue: [expectedTexts first] ifFalse: [expectedTexts]. actualText := document bodyTextFormatted. self assert: expectedText asString equals: actualText asString; assert: (expectedText isText ifTrue: [expectedText runs printString]) equals: (actualText isText ifTrue: [actualText runs printString])]; keysAndValuesDo: [:document :expectedTexts | | expectedText actualText | expectedText := expectedTexts isArray ifTrue: [expectedTexts second] ifFalse: [expectedTexts]. actualText := document bodyTextFormattedRich. self assert: expectedText asString equals: actualText asString; assert: (expectedText isText ifTrue: [expectedText runs printString]) equals: (actualText isText ifTrue: [actualText runs printString])].!

1 0

The Trunk: 61Deprecated-ct.7.mcz
by commits＠source.squeak.org 20 May '23

20 May '23

Christoph Thiede uploaded a new version of 61Deprecated to project The Trunk: http://source.squeak.org/trunk/61Deprecated-ct.7.mcz ==================== Summary ==================== Name: 61Deprecated-ct.7 Author: ct Time: 20 May 2023, 8:16:45.557721 pm UUID: e9d325c9-1e8d-3642-82ff-bdac23732616 Ancestors: 61Deprecated-mt.6 Complements Network-ct.270 (improves reading/exploring of MailMessages). =============== Diff against 61Deprecated-mt.6 =============== Item was added: + ----- Method: MailMessage>>viewBody (in category '*61Deprecated-printing/formatting') ----- + viewBody + + self deprecated: 'ct: send #view instead'. + ^ self view! Item was added: + ----- Method: MailMessage>>viewImageInBody (in category '*61Deprecated-printing/formatting') ----- + viewImageInBody + + self deprecated: 'ct: send #viewImage instead'. + ^ self viewImage! Item was added: + ----- Method: TextMessageLink class>>message: (in category '*61Deprecated-instance creation') ----- + message: aMessage + + self deprecated: 'ct: use #toDocument: instead'. + ^ self toDocument: aMessage!

1 0

The Trunk: NetworkTests-ct.67.mcz
by commits＠source.squeak.org 20 May '23

20 May '23

Christoph Thiede uploaded a new version of NetworkTests to project The Trunk: http://source.squeak.org/trunk/NetworkTests-ct.67.mcz ==================== Summary ==================== Name: NetworkTests-ct.67 Author: ct Time: 20 May 2023, 8:15:20.041721 pm UUID: b341bb29-4f6f-9348-840d-fdfbe22204a4 Ancestors: NetworkTests-ct.66 Complements Network-ct.270 (improves reading/exploring of MailMessages). Adds detailed acceptance tests for #bodyTextFormatted:. =============== Diff against NetworkTests-ct.66 =============== Item was added: + ----- Method: MIMEDocumentTest>>testBodyTextFormatted (in category 'tests') ----- + testBodyTextFormatted + + | pngContent pngText pngContent2 pngText2 mailContent mailText | + pngContent := (ByteArray streamContents: [:s | PNGReadWriter putForm: (Form dotOfSize: 8 color: Color orange) onStream: s]) asString. + pngText := '<img src="code://Form dotOfSize: 8 color: Color orange" />' asTextFromHtml removeAttributesThat: [:ea | ea isKindOf: TextColor]; yourself. + pngContent2 := (ByteArray streamContents: [:s | PNGReadWriter putForm: (Form dotOfSize: 16 color: Color blue) onStream: s]) asString. + pngText2 := '<img src="code://Form dotOfSize: 16 color: Color blue" />' asTextFromHtml removeAttributesThat: [:ea | ea isKindOf: TextColor]; yourself. + mailContent := MailMessage empty in: [:m | m body content: 'hi']; text. + mailText := 'hi\\' withCRs. + OrderedDictionary new + "text" + at: (MIMEDocument contentType: MIMEDocument contentTypePlainText content: 'plain test') put: 'plain test'; + at: (MIMEDocument contentType: MIMEDocument contentTypeHtml content: 'html test') put: 'html test' asText; + at: (MIMEDocument contentType: MIMEDocument contentTypeHtml content: 'bold <img src="https://squeak.org/static/img/squeak.png" /> <img src="code://Form dotOfSize: 8" />') put: 'bold <img src="https://squeak.org/static/img/squeak.png" /> <img src="lol" />' asTextFromHtml; + + "embedded stuff" + at: (MIMEDocument contentType: 'image/png' content: pngContent) put: pngText; + at: (MIMEDocument contentType: 'message/rfc822' content: mailContent) put: mailText; + + "multipart/alternative" + "plain and rich text" + at: ((MIMEDocument contentType: 'multipart/alternative') addPart: (MIMEDocument contentType: MIMEDocument contentTypePlainText content: 'plain test'); addPart: (MIMEDocument contentType: MIMEDocument contentTypeHtml content: 'html test'); yourself) put: {'plain test'. 'html test' asText}; + "plain and rich text (different ordr)" + at: ((MIMEDocument contentType: 'multipart/alternative') addPart: (MIMEDocument contentType: MIMEDocument contentTypeHtml content: 'html test'); addPart: (MIMEDocument contentType: MIMEDocument contentTypePlainText content: 'plain test'); yourself) put: {'plain test'. 'html test' asText}; + "only plain text" + at: ((MIMEDocument contentType: 'multipart/alternative') addPart: (MIMEDocument contentType: MIMEDocument contentTypePlainText content: 'plain test'); yourself) put: 'plain test'; + "only rich text" + at: ((MIMEDocument contentType: 'multipart/alternative') addPart: (MIMEDocument contentType: MIMEDocument contentTypeHtml content: 'html test'); yourself) put: 'html test' asText; + "only other stuff" + at: ((MIMEDocument contentType: 'multipart/alternative') addPart: (MIMEDocument contentType: 'message/rfc822' content: mailContent); yourself) put: mailText; + + "multipart/related" + "plain text with CIDs" + at: ((MIMEDocument contentType: 'multipart/related') addPart: (MIMEDocument contentType: MIMEDocument contentTypePlainText content: 'plain test [cid:griffle] [cid:plonk] [cid:goo]'); addPart: ((MIMEDocument contentType: 'image/png' content: pngContent) setField: 'content-id' toString: 'plonk'; yourself); addPart: ((MIMEDocument contentType: 'image/png' content: pngContent2) setField: 'content-id' toString: 'griffle'; yourself); yourself) put: ('plain test {1} {2} [cid:goo]' asTextFromHtml format: {pngText2. pngText}); + "rich text with CIDs" + at: ((MIMEDocument contentType: 'multipart/related') addPart: (MIMEDocument contentType: MIMEDocument contentTypeHtml content: 'html test <img src="cid:griffle" /> <img src="cid:plonk" /> <img src="cid:goo" />'); addPart: ((MIMEDocument contentType: 'image/png' content: pngContent) setField: 'content-id' toString: 'plonk'; yourself); addPart: ((MIMEDocument contentType: 'image/png' content: pngContent2) setField: 'content-id' toString: 'griffle'; yourself); yourself) put: 'html test <img src="code://Form dotOfSize: 16 color: Color blue" /> <img src="code://Form dotOfSize: 8 color: Color orange" /> <img src="lol" />' asTextFromHtml; + + "multipart/mixed" + at: ((MIMEDocument contentType: 'multipart/mixed') addPart: ((MIMEDocument contentType: MIMEDocument contentTypePlainText content: 'plonk') setField: 'content-disposition' toString: 'inline'; yourself); addPart: ((MIMEDocument contentType: MIMEDocument contentTypePlainText content: 'griffle') setField: 'content-disposition' toString: 'attachment'; yourself); addPart: (MIMEDocument contentType: 'image/png' content: pngContent); yourself) put: ('plonk\' withCRs asText , ('[attachment]' asText addAttribute: TextMessageLink new; yourself) , '\' withCRs , pngText); + + keysAndValuesDo: [:document :expectedTexts | + | expectedText actualText | + expectedText := expectedTexts isArray ifTrue: [expectedTexts first] ifFalse: [expectedTexts]. + actualText := document bodyTextFormatted. + self + assert: expectedText asString + equals: actualText asString; + assert: (expectedText isText ifTrue: [expectedText runs printString]) + equals: (actualText isText ifTrue: [actualText runs printString])]; + + keysAndValuesDo: [:document :expectedTexts | + | expectedText actualText | + expectedText := expectedTexts isArray ifTrue: [expectedTexts second] ifFalse: [expectedTexts]. + actualText := document bodyTextFormattedRich. + self + assert: expectedText asString + equals: actualText asString; + assert: (expectedText isText ifTrue: [expectedText runs printString]) + equals: (actualText isText ifTrue: [actualText runs printString])].!

1 0

The Trunk: Network-ct.270.mcz
by commits＠source.squeak.org 20 May '23

20 May '23

Christoph Thiede uploaded a new version of Network to project The Trunk: http://source.squeak.org/trunk/Network-ct.270.mcz ==================== Summary ==================== Name: Network-ct.270 Author: ct Time: 20 May 2023, 8:14:29.579721 pm UUID: 9b82fe9b-b49e-af4e-a06b-7fd89553148e Ancestors: Network-ct.269 MailMessage-bodyTextFormatted Improves reading/exploring of MailMessages: * Adds #bodyTextFormatted: with parameter to prefer richText over plainText and #bodyTextFormattedRich as a shorthand. * In #bodyTextFormatted..., adds support for multipart/related documents with inline images (CIDs) in plaintext and HTML documents. Always uses HtmlReadWriter for parsing HTML documents and secures parsing by disabling evaluation of resources (uses Collections-ct.1038). Inline images are requested by the parser through a MIMEContentRequest and answered by any containing document (see Collections-ct.1038). * Fixes TextMessageLink which in fact does not link to a message but to a document. Improves multilingual support. * Overall refactoring. Extends accessors on MIMEDocument. Deduplicates save/view logic from MailMessage. =============== Diff against Network-ct.269 =============== Item was added: + Notification subclass: #MIMEContentRequest + instanceVariableNames: 'cid' + classVariableNames: '' + poolDictionaries: '' + category: 'Network-MIME'! Item was added: + ----- Method: MIMEContentRequest class>>signal: (in category 'signaling') ----- + signal: cid + "Answer a MIMEDocument or nil." + + ^ self new cid: cid; signal! Item was added: + ----- Method: MIMEContentRequest>>cid (in category 'accessing') ----- + cid + + ^ cid! Item was added: + ----- Method: MIMEContentRequest>>cid: (in category 'accessing') ----- + cid: aString + + cid := aString.! Item was added: + ----- Method: MIMEDocument>>attachmentText (in category 'serializing') ----- + attachmentText + + ^ Text + string: ('[{1}]' format: {self name ifNil: ['attachment' translated]}) + attributes: {TextMessageLink toDocument: self}! Item was added: + ----- Method: MIMEDocument>>attachments (in category 'accessing') ----- + attachments + + ^ self parts select: [:part | + part contentDisposition = #attachment]! Item was changed: ----- 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 bodyTextFormatted: false! - 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 added: + ----- Method: MIMEDocument>>bodyTextFormatted: (in category 'serializing') ----- + bodyTextFormatted: shouldPreferRichText + + self isMultipart ifTrue: [ + self isMultipartAlternative ifTrue: [ + "https://www.w3.org/Protocols/rfc1341/7_2_Multipart.html" + | preferredTypes | + preferredTypes := #('text/plain' 'text/html'). + shouldPreferRichText ifTrue: [preferredTypes := preferredTypes reversed]. + preferredTypes do: [:format | + self parts do: [:part | + part contentType = format ifTrue: [ + ^ part bodyTextFormatted: shouldPreferRichText]]]. + + "fallback" + ^ self parts first bodyTextFormatted: shouldPreferRichText]. + + self subType = 'related' ifTrue: [ + "RFC2387" + ^ [self parts first bodyTextFormatted: shouldPreferRichText] + on: MIMEContentRequest do: [:request | + (self partWithContentID: request cid) ifNotNil: [:part | + request resume: part]. + request pass]]. + + ^ Text streamContents: [:stream | + self parts + do: [:part | stream nextPutAll: + (part contentDisposition = 'inline' + ifTrue: [part bodyTextFormatted: shouldPreferRichText] + ifFalse: [part attachmentText])] + separatedBy: [stream cr]]]. + + self contentType = 'message/rfc822' ifTrue: [ + "embedded message" + ^ (MailMessage from: self content) bodyTextFormatted: shouldPreferRichText]. + + self isHTML ifTrue: [ + (Smalltalk classNamed: #HtmlReadWriter) ifNotNil: [:readerClass | + ^ (readerClass on: self content readStream) + shallEvaluateResources: false; + nextText]]. + + self isPlaintext ifTrue: [ + ^ self plainTextWithResolvedCIDReferences: shouldPreferRichText]. + + self containsViewableImage ifTrue: [ + | form scaleFactor | + form := self image. + (scaleFactor := RealEstateAgent scaleFactor) = 1.0 + ifFalse: [form := form scaledToSize: form extent * scaleFactor]. + ^ Text string: Character startOfHeader asString attribute: form asTextAnchor]. + + "fallback" + ^ self content! Item was added: + ----- Method: MIMEDocument>>bodyTextFormattedRich (in category 'serializing') ----- + bodyTextFormattedRich + + ^ self bodyTextFormatted: true! Item was added: + ----- Method: MIMEDocument>>contentDisposition (in category 'accessing') ----- + contentDisposition + + ^ self contentDispositionHeaderValue mainValue! Item was added: + ----- Method: MIMEDocument>>contentDispositionHeaderValue (in category 'accessing') ----- + contentDispositionHeaderValue + + ^ self fieldNamed: 'content-disposition' ifAbsent: [MIMEHeaderValue fromMIMEHeader: 'inline']! Item was added: + ----- Method: MIMEDocument>>contentID (in category 'accessing') ----- + contentID + + | value | + value := (self fieldNamed: 'content-id' ifAbsent: [^ nil]) mainValue. + (value notEmpty and: [value first = $<] and: [value last = $>]) ifTrue: [ + value := value allButFirst allButLast]. + ^ value! Item was added: + ----- Method: MIMEDocument>>image (in category 'interactions') ----- + image + + ^ Form fromBinaryStream: self contentStream! Item was changed: ----- 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: + [self attachmentSeparator ifNotNil: + [:separator | + parts := self class parseParts: bodyText withSeparator: separator. + ^ self]]. + content := bodyText.! - self isMultipart - ifTrue: [parts := self class parseParts: bodyText withSeparator: self attachmentSeparator] - ifFalse: [content := bodyText] - ! Item was added: + ----- Method: MIMEDocument>>partWithContentID: (in category 'accessing') ----- + partWithContentID: cid + + ^ self parts + detect: [:part | part contentID = cid] + ifNone: [nil]! Item was added: + ----- Method: MIMEDocument>>plainTextWithResolvedCIDReferences: (in category 'private') ----- + plainTextWithResolvedCIDReferences: shouldPreferRichText + "RFC2387/RFC2392" + + | nextIndex lastIndex | + nextIndex := content findString: '[cid:' startingAt: (lastIndex := 1). + nextIndex = 0 ifTrue: [^ content]. + ^ Text new: content size * 11 // 10 "+10%" streamContents: [:stream | + | cid | + [stream next: nextIndex - lastIndex putAll: content startingAt: lastIndex. + nextIndex := content indexOf: $] startingAt: (lastIndex := nextIndex + 1). + cid := content copyFrom: lastIndex + 4 "'cid:' size" to: nextIndex - 1. + (MIMEContentRequest signal: cid) + ifNotNil: [:inlineDocument | stream nextPutAll: (inlineDocument bodyTextFormatted: shouldPreferRichText)] + ifNil: [stream nextPutAll: '[cid:'; nextPutAll: cid; nextPut: $]]. + (nextIndex := content findString: '[cid:' startingAt: (lastIndex := nextIndex + 1)) > 0] + whileTrue. + stream next: content size - lastIndex + 1 putAll: content startingAt: lastIndex]! Item was changed: ----- Method: MIMEDocument>>save (in category 'interactions') ----- save + + ^ self saveWithDefaultName: self name! - "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>>saveWithDefaultName: (in category 'interactions') ----- + saveWithDefaultName: name + "save the part to a file" + | fileName | + fileName := 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 , FileDirectory dot , e]]]. + + fileName := Project uiManager saveFilenameRequest: 'File name for save?' translated initialAnswer: fileName. + fileName ifNil: [^ nil]. + + FileStream newFileNamed: fileName + do: [:file | file nextPutAll: self asSendableBodyText]! Item was changed: ----- Method: MIMEDocument>>view (in category 'interactions') ----- view + + ^ self viewWithLabel: (self name ifNil: ['a message part' translated])! - - self containsViewableImage - ifTrue: [^ self viewImage]. - (StringHolder new contents: self bodyTextFormatted; - yourself) - openLabel: (self name ifNil: ['(a message part)'])! Item was changed: ----- Method: MIMEDocument>>viewImage (in category 'interactions') ----- viewImage + + ^ (Project current world drawingClass withForm: self image) openAsTool! - | stream image | - stream := self contentStream. - image := Form fromBinaryStream: stream. - (Project current world drawingClass withForm: image) openInWorld! Item was added: + ----- Method: MIMEDocument>>viewWithLabel: (in category 'interactions') ----- + viewWithLabel: aString + + self containsViewableImage ifTrue: [^ self viewImage]. + ^ self bodyTextFormattedRich editWithLabel: aString! Item was changed: ----- Method: MailMessage>>attachments (in category 'multipart') ----- attachments + ^ self body attachments! - ^ self body parts select: [:p | - (p fieldNamed: 'content-disposition' ifAbsent: [nil]) - ifNil: [false] - ifNotNil: [:headerValue | headerValue mainValue = 'attachment' ]]! Item was added: + ----- Method: MailMessage>>bodyTextFormatted: (in category 'printing/formatting') ----- + bodyTextFormatted: shouldPreferRichText + + ^ self body bodyTextFormatted: shouldPreferRichText! Item was added: + ----- Method: MailMessage>>bodyTextFormattedRich (in category 'printing/formatting') ----- + bodyTextFormattedRich + + ^ self body bodyTextFormattedRich! Item was changed: ----- Method: MailMessage>>containsViewableImage (in category 'testing') ----- containsViewableImage + ^self body containsViewableImage! - ^self body isJpeg | self body isGif | self body isPng! Item was changed: + ----- Method: MailMessage>>name (in category 'accessing') ----- - ----- Method: MailMessage>>name (in category 'access') ----- 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 changed: ----- Method: MailMessage>>save (in category 'multipart') ----- save - "save the part to a file" - | fileName | - fileName := self name ifNil: ['attachment' , Utilities dateTimeSuffix]. - (fileName includes: $.) - ifFalse: [#(#isJpeg 'jpg' #isGif 'gif' #isPng 'png' #isPnm 'pnm') - pairsDo: [:s :e | (self body perform: s) - ifTrue: [fileName := fileName , FileDirectory dot , e]]]. + ^ self body saveWithDefaultName: self name! - fileName := UIManager default saveFilenameRequest: 'File name for save?' initialAnswer: fileName. - fileName ifNil: [^ nil]. - - FileStream newFileNamed: fileName - do: [:file | file nextPutAll: self bodyText]! Item was changed: + ----- Method: MailMessage>>setText: (in category 'accessing') ----- - ----- Method: MailMessage>>setText: (in category 'access') ----- setText: aString text := aString withoutTrailingBlanks, String cr, String cr. self readFrom: text readStream. ! Item was added: + ----- Method: MailMessage>>view (in category 'interactions') ----- + view + + ^ self body viewWithLabel: 'a message' translated! Item was removed: - ----- Method: MailMessage>>viewBody (in category 'printing/formatting') ----- - viewBody - "open a viewer on the body of this message" - self containsViewableImage - ifTrue: [^ self viewImageInBody]. - (StringHolder new contents: self bodyTextFormatted; - yourself) - openLabel: (self name - ifNil: ['(a message part)'])! Item was added: + ----- Method: MailMessage>>viewImage (in category 'printing/formatting') ----- + viewImage + + ^ self body viewImage! Item was removed: - ----- Method: MailMessage>>viewImageInBody (in category 'printing/formatting') ----- - viewImageInBody - | stream image | - stream := self body contentStream. - image := Form fromBinaryStream: stream. - (Project current world drawingClass withForm: image) openInWorld! Item was changed: TextAttribute subclass: #TextMessageLink + instanceVariableNames: 'document' - instanceVariableNames: 'message' classVariableNames: '' poolDictionaries: '' category: 'Network-Url'! + !TextMessageLink commentStamp: 'ct 5/20/2023 20:05' prior: 0! + A link to a document of a mail message. Clicking on it allows the document to be viewed or saved to disk.! - !TextMessageLink commentStamp: '<historical>' prior: 0! - A link to a hidden mail message. Clicking on it allows the message to be viewed or saved to disk.! Item was removed: - ----- Method: TextMessageLink class>>message: (in category 'instance creation') ----- - message: aMessage - ^super new initialize: aMessage! Item was added: + ----- Method: TextMessageLink class>>toDocument: (in category 'instance creation') ----- + toDocument: aDocument + + ^ self new document: aDocument! Item was changed: ----- Method: TextMessageLink>>actOnClickFor: (in category 'acting') ----- + actOnClickFor: anEvent + + | action | + self flag: #forLater. "ct: connect with FileServices" + action := Project uiManager chooseOptionFromLabeledValues: + (OrderedDictionary new + at: (self document containsViewableImage + ifTrue: ['view this image attachment' translated] + ifFalse: ['view this attachment' translated]) + put: #view; + at: 'save this attachment' translated + put: #save; + yourself). + action ifNotNil: [self document perform: action]. - actOnClickFor: evt - | choice viewMsg | - viewMsg := message containsViewableImage - ifTrue: ['view this image attachment'] - ifFalse: ['view this attachment']. - choice := UIManager default chooseFrom: (Array with: viewMsg - with: 'save this attachment' ). - choice = 1 - ifTrue: ["open a new viewer" - message viewBody]. - choice = 2 - ifTrue: ["save the mesasge" - message save]. ^ true! Item was added: + ----- Method: TextMessageLink>>document (in category 'accessing') ----- + document + + ^ document! Item was added: + ----- Method: TextMessageLink>>document: (in category 'accessing') ----- + document: aDocument + + document := aDocument.! Item was changed: ----- Method: TextMessageLink>>emphasizeScanner: (in category 'appearance') ----- emphasizeScanner: scanner + self flag: #todo. "use UserInterfaceTheme" scanner textColor: Color brown! Item was removed: - ----- Method: TextMessageLink>>initialize: (in category 'initialization') ----- - initialize: message0 - message := message0!

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Packages May 2023