Squeak-dev May 2023

squeak-dev@lists.squeakfoundation.org

16 participants
109 discussions

Review Request: cleanup-MailMessage-parts.3.cs
by christoph.thiede＠student.hpi.uni-potsdam.de 20 May '23

20 May '23

=============== Summary =============== Change Set: cleanup-MailMessage-parts Date: 20 May 2023 Author: Christoph Thiede Removes parts instvar and related methods from MailMessage. Handling of parts has already been delegated to the body MIMEDocument for years, and the instvar on MailMessage had no references (only assignments). The only senders of the referencing messages were already deprecated and not in use, and they could not work anyway more. =============== Postscript =============== MailMessage removeSelector: #parseParts. FancyMailComposition removeSelector: #breakLinesInMessage:. MailMessage removeSelector: #regenerateBodyFromParts. MailComposition removeSelector: #breakLinesInMessage:. =============== Diff =============== MailMessage (changed) Object subclass: #MailMessage - instanceVariableNames: 'text body fields parts' + instanceVariableNames: 'text body fields' classVariableNames: '' poolDictionaries: '' category: 'Network-Url' MailMessage class instanceVariableNames: '' "I represent an Internet mail or news message. text - the raw text of my message body - the body of my message, as a MIMEDocument fields - a dictionary mapping lowercased field names into collections of MIMEHeaderValue's - parts - if I am a multipart message, then this is a cache of my parts" --- Sent from Squeak Inbox Talk ["cleanup-MailMessage-parts.3.cs"]

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: '<b>bold</b> <img src="https://squeak.org/static/img/squeak.png" /> <img src="code://Form dotOfSize: 8" />') put: '<b>bold</b> <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: '<b>html</b> 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: '<b>html</b> 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: Collections-ct.1036.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.1036.mcz ==================== Summary ==================== Name: Collections-ct.1036 Author: ct Time: 20 May 2023, 5:43:49.498462 pm UUID: bc63a406-957f-2c48-b922-6b53fca0acc7 Ancestors: Collections-ct.1035, Collections-ct.944, Collections-ct.945, Collections-ct.946 Miscellaneous parsing improvements to HtmlReadWriter, aligning it further to the HTML5/XHTML standards. - Cleans up and improves robustness of parsing attributes. Spaces between names and values are allowed, quotes are optional, and values may contain escape sequences or be empty (revises Collections-ct.944). All tags may have attributes. - Ignore case in tag names, attribute names, and URI schemes for images. - Improves support for void elements that are manually closed as per XHTML (revises Collections-ct.945). - Adds support for excluded tags whose content is not added to the parsed text, such as <script> or <style>. - If #breakLines is enabled, treats any sequence of whitespace characters as a single space, and leading/trailing spaces are cut off. Tag names may no longer be interrupted by linebreaks. - Improves robustness of parsing invalid color names (revises Collections-ct.946). - Preserves #breakLines after parsing <pre> tags. - Improves line-breaking behavior of tags such as <div>, <p>, and <pre>. - Adds <hr> tag. =============== Diff against Collections-ct.1035 =============== Item was changed: TextReadWriter subclass: #HtmlReadWriter + instanceVariableNames: 'count offset runStack runArray string breakLines preformattingLevel exclusionLevel lastFixedWhitespace' - instanceVariableNames: 'count offset runStack runArray string breakLines' classVariableNames: '' poolDictionaries: '' category: 'Collections-Text'! !HtmlReadWriter commentStamp: 'pre 8/29/2017 16:14' prior: 0! A HtmlReadWriter is used to read a Text object from a string containing HTML or writing a Text object to a string with HTML tags representing the text attributes. It does two things currently: 1) Setting text attributes on the beginning of tags, e.g. setting a bold text attribute when seeing a <b> tag. 2) Changing the resulting string, e.g. replacing a <br> with a Character cr. The implementation works by pushing attributes on a stack on every opening tag. On the corresponding closing tag, the attribute is poped from the stack and stored in an array of attribute runs. From this array the final string is constructed. ## Notes on the implementation - The final run array is completely constructed while parsing so it has to be correct with regard to the length of the runs. There is no consolidation except for merging neighboring runs which include the same attributes. - The *count* variable is the position in the source string, the *offset* is the number of skipped characters, for example ones that denote a tag. - The stack contains elements which are of the form: {text attributes. current start index. original start}! Item was added: + ----- Method: HtmlReadWriter>>assureLinebreak (in category 'private') ----- + assureLinebreak + + (string notEmpty ==> [#(10 13) includes: string last asciiValue]) + ifFalse: [self addCharacter: Character cr]. ! Item was added: + ----- Method: HtmlReadWriter>>assureSeparator (in category 'private') ----- + assureSeparator + + (string notEmpty + and: [(#(32 13 10 9) includes: string last asciiValue "separators according to HTML") not]) + ifTrue: [string add: Character space] + ifFalse: [offset := offset + 1].! Item was changed: ----- Method: HtmlReadWriter>>breakLines (in category 'accessing') ----- breakLines + "If true, linebreaks must be represented through <br> tags in HTML. If false, simple return characters (String cr or String lf) are treated as linebreaks as well. According to the HTML standard, defaults to true. + During reading, if breakLines is enabled, all return characters in the HTML string are treated as whitespace, any sequence of whitespace characters is converted to a single space, and leading/trailing whitespace is ignored. Otherwise, whitespace characters are preserved. + During writing, if breakLines is enabled, all return characters in the text are translated to a <br> tag; otherwise, they are just copied to the HTML source." ^ breakLines! Item was changed: ----- Method: HtmlReadWriter>>breakLines: (in category 'accessing') ----- breakLines: aBoolean + "If true, linebreaks must be represented through <br> tags in HTML. If false, simple return characters (String cr or String lf) are treated as linebreaks as well. According to the HTML standard, defaults to true. + During reading, if breakLines is enabled, all return characters in the HTML string are treated as whitespace, any sequence of whitespace characters is converted to a single space, and leading/trailing whitespace is ignored. Otherwise, whitespace characters are preserved. + During writing, if breakLines is enabled, all return characters in the text are translated to a <br> tag; otherwise, they are just copied to the HTML source." + breakLines ifNotNil: [preformattingLevel := preformattingLevel - (aBoolean asBit - breakLines asBit)]. + breakLines := aBoolean.! - breakLines := aBoolean! Item was changed: ----- Method: HtmlReadWriter>>cr (in category 'stream emulation') ----- cr + preformattingLevel <= 0 ifTrue: [stream nextPutAll: '<br>']. - self breakLines ifTrue: [stream nextPutAll: '<br>']. ^ stream cr! Item was added: + ----- Method: HtmlReadWriter>>excludedTags (in category 'accessing') ----- + excludedTags + "Contents from these tags are not added to the parsed text" + + ^ #(script style)! Item was added: + ----- Method: HtmlReadWriter>>getImage: (in category 'private') ----- + getImage: uri + + (uri beginsWith: 'cid:' caseSensitive: false) ifTrue: [ + "Content-ID, used in nested MIMEDocuments, e.g., for emails with inline images" + (Smalltalk classNamed: #MIMEContentRequest) ifNotNil: [:class | + | cid | + cid := uri allButFirst: 4. + (class signal: cid) ifNotNil: [:document | + ^ [document image] ifError: [nil]]]. + ^ nil]. + + (uri beginsWith: 'code://' caseSensitive: false) ifTrue: [ + | expression | + "Same support for Smalltalk expressions as in TextURL >> #actOnClickFor:." + expression := uri allButFirst: 7. + ^ ([Compiler evaluate: expression] ifError: [nil]) + ifNotNil: [:object | object isForm ifTrue: [object] ifFalse: [nil]]]. + + (uri beginsWith: 'data:' caseSensitive: false) ifTrue: [ | data mediaType separator | + separator := uri indexOf: $, ifAbsent: [^ nil]. + mediaType := uri copyFrom: 6 to: separator - 1. + data := uri allButFirst: separator. + data := (mediaType endsWith: ';base64' caseSensitive: false) + ifTrue: [ + mediaType := mediaType allButLast: 7. + [Base64MimeConverter mimeDecodeToBytes: data readStream] ifError: [nil]] + ifFalse: [data asByteArray readStream]. + ^ [ImageReadWriter formFromStream: data] ifError: [nil]]. + + ^ (Smalltalk classNamed: #WebClient) ifNotNil: [:client | + "Maybe we can have this via an AppRegistry at some point. Maybe extend WebBrowser." + ([client httpGet: uri] ifError: [nil]) ifNotNil: [:response | + response code = 200 ifFalse: [nil] ifTrue: [ + [Form fromBinaryStream: response content asByteArray readStream] + ifError: [nil]]]]! Item was added: + ----- Method: HtmlReadWriter>>hasTag:name: (in category 'private') ----- + hasTag: aTag name: tagNameLt + + | after | + (aTag beginsWith: tagNameLt caseSensitive: false) ifFalse: [^ false]. + after := aTag at: tagNameLt size + 1 ifAbsent: [^ true]. + ^ after = $> or: [after isSeparator]! Item was added: + ----- Method: HtmlReadWriter>>htmlEscape: (in category 'reading') ----- + htmlEscape: aString + + | escapeSequence | + escapeSequence := aString copyFrom: 2 to: aString size - 1. + escapeSequence first = $# ifTrue: [^ self htmlEscapeNumber: escapeSequence allButFirst]. + (String htmlEntities at: (aString copyFrom: 2 to: aString size - 1) ifAbsent: []) + ifNotNil: [:char | ^ char]. + ^ nil! Item was added: + ----- Method: HtmlReadWriter>>htmlEscapeNumber: (in category 'private') ----- + htmlEscapeNumber: aString + + | number | + number := aString first = $x + ifTrue: ['16r', aString allButFirst] + ifFalse: [aString]. + ^ number asNumber asCharacter + ! Item was added: + ----- Method: HtmlReadWriter>>htmlEscapes: (in category 'reading') ----- + htmlEscapes: aString + + | lastIndex nextIndex | + nextIndex := aString indexOf: $& startingAt: (lastIndex := 1) ifAbsent: [^ aString]. + ^ String new: aString size * 11 // 10 "+10%" streamContents: [:stream | + [stream next: nextIndex - lastIndex putAll: aString startingAt: lastIndex. + nextIndex := aString indexOf: $; startingAt: (lastIndex := nextIndex) ifAbsent: [^ aString]. + stream nextPut: (self htmlEscape: (aString copyFrom: lastIndex to: nextIndex))] + doWhileTrue: [(nextIndex := aString indexOf: $& startingAt: (lastIndex := nextIndex + 1)) > 0]. + stream next: aString size - lastIndex + 1 putAll: aString startingAt: lastIndex]! Item was removed: - ----- Method: HtmlReadWriter>>httpGetImage: (in category 'private') ----- - httpGetImage: url - "To not add a direct dependency to WebClient, provide this hook for getting am image from an HTTP url. Maybe we can have this via an AppRegistry at some point. Maybe extend WebBrowser." - - (url beginsWith: 'code://') ifTrue: [ - "Same support for Smalltalk expressions as in TextURL >> #actOnClickFor:." - ^ ([Compiler evaluate: (url allButFirst: 7)] ifError: [nil]) - ifNotNil: [:object | object isForm ifTrue: [object] ifFalse: [nil]]]. - - (url beginsWith: 'data:') ifTrue: [ | data mediaType separator | - separator := url indexOf: $, ifAbsent: [^ nil]. - mediaType := url copyFrom: 6 to: separator - 1. - data := url allButFirst: separator. - data := (mediaType endsWith: ';base64') - ifTrue: [ - mediaType := mediaType allButLast: 7. - [Base64MimeConverter mimeDecodeToBytes: data readStream] ifError: [nil]] - ifFalse: [data asByteArray readStream]. - ^ [ImageReadWriter formFromStream: data] ifError: [nil]]. - - ^ (Smalltalk classNamed: 'WebClient') ifNotNil: [:client | - ([client httpGet: url] ifError: [nil]) ifNotNil: [:response | - response code = 200 ifFalse: [nil] ifTrue: [ - [Form fromBinaryStream: response content asByteArray readStream] - ifError: [nil]]]]! Item was changed: ----- Method: HtmlReadWriter>>ignoredTags (in category 'accessing') ----- ignoredTags "Because we cannot process all of them." + ^ #(body table tr td ul ol li form select option input)! - ^ #(body script table tr td ul ol li form select option input)! Item was added: + ----- Method: HtmlReadWriter>>imagePlaceholder (in category 'private') ----- + imagePlaceholder + + ^ Form dotOfSize: 12 color: Color veryLightGray! Item was changed: ----- Method: HtmlReadWriter>>initialize (in category 'initialize-release') ----- initialize super initialize. + + preformattingLevel := 0. + exclusionLevel := 0. + lastFixedWhitespace := 0. + self breakLines: true.! Item was added: + ----- Method: HtmlReadWriter>>isExcludedTag: (in category 'testing') ----- + isExcludedTag: aTag + + ^ self excludedTags includes: aTag! Item was added: + ----- Method: HtmlReadWriter>>isVoidTag: (in category 'testing') ----- + isVoidTag: aTag + + ^ self voidTags includes: aTag! Item was changed: ----- Method: HtmlReadWriter>>mapATag: (in category 'mapping') ----- mapATag: aTag + | result | - | result startIndex stopIndex attribute | result := OrderedCollection new. "<a href=""http://google.de"">" + (self searchTag: aTag forAttribute: #href) ifNotNil: [:url | + result add: (TextURL url: url)]. - attribute := 'href'. - startIndex := aTag findString: attribute. - startIndex > 0 ifTrue: [ - startIndex := aTag findString: '"' startingAt: startIndex+attribute size. - startIndex > 0 - ifTrue: [stopIndex := aTag findString: '"' startingAt: startIndex+1] - ifFalse: [ - "URLs without quotes..." - startIndex := aTag findString: '=' startingAt: startIndex+attribute size. - stopIndex := aTag findString: '>' startingAt: startIndex+1]. - result add: (TextURL new url: (aTag copyFrom: startIndex+1 to: stopIndex-1))]. ^ result! Item was changed: ----- Method: HtmlReadWriter>>mapAlignmentTag: (in category 'mapping') ----- mapAlignmentTag: aTag - | attributeStart | " special html case ". + (self hasTag: aTag name: '<center') ifTrue: [^ {TextAlignment centered}]. - aTag = '<center>' ifTrue: [^ {TextAlignment centered}]. "<div align=justify> or <div align=""right"">" + (self searchTag: aTag forAttribute: #align) ifNotNil: [:alignment | + ^ self mapAlignmentValue: alignment asLowercase]. - attributeStart := aTag findString: 'align='. - attributeStart > 0 ifTrue: [ - | attributeRest | - attributeRest := aTag copyAfter: $=. - attributeRest first = $" ifTrue: [attributeRest := attributeRest allButFirst]. " quoted case " - ^ self mapAlignmentValue: (attributeRest findTokens: ' ">') first]. ^ #()! Item was added: + ----- Method: HtmlReadWriter>>mapClosePreformattingTag (in category 'mapping') ----- + mapClosePreformattingTag + + preformattingLevel := preformattingLevel - 1.! Item was changed: ----- Method: HtmlReadWriter>>mapContainerTag: (in category 'mapping') ----- mapContainerTag: aTag + | styleAttributes result | + styleAttributes := ((self searchTag: aTag forAttribute: #style) ifNil: [^ #()]) asLowercase subStrings: $;. + - | result styleStart styleEnd styleAttributes | result := OrderedCollection new. + styleAttributes do: [:ea | + | keyValue key value | + keyValue := (ea subStrings: $:) collect: [:s | s withBlanksTrimmed]. - styleStart := (aTag findString: 'style="' ) + 7. - styleStart <= 7 ifTrue: [^#()]. - styleEnd := (aTag findString: '"' startingAt: styleStart) - 1. - styleAttributes := (aTag copyFrom: styleStart to: styleEnd) subStrings: ';'. - styleAttributes do: [:ea | |keyValue key value| - keyValue := (ea subStrings: ':') collect: [:s | s withBlanksTrimmed]. key := keyValue first asLowercase. - value := keyValue second. keyValue size = 2 ifTrue: [ + value := keyValue second. + key = 'color' ifTrue: [ | color | + color := [Color fromString: value] ifError: [nil]. + color ifNotNil: [result add: (TextColor color: color)]]. - key = 'color' ifTrue: [result add: (TextColor color: (Color fromString: value))]. (key beginsWith: 'font') ifTrue: [ (value includesSubstring: 'bold') ifTrue: [result add: TextEmphasis bold]. (value includesSubstring: 'italic') ifTrue: [result add: TextEmphasis italic]]]]. ^ result! Item was changed: ----- Method: HtmlReadWriter>>mapFontTag: (in category 'mapping') ----- mapFontTag: aTag + | result fontFace fontSize | - | result colorName fontFace fontSize | result := OrderedCollection new. "<font color=""#00FFCC""> or <font color=""green"">" + (self searchTag: aTag forAttribute: #color) ifNotNil: [:colorString | + | color | + color := [Color fromString: colorString] ifError: [nil]. + color ifNotNil: [ + result add: (TextColor color: color)]]. - "<font face=""Bitmap DejaVu Sans"" size=""12"">" - (#(color face size) collect: [:attribute | - | startIndex stopIndex | - startIndex := aTag findString: attribute. - startIndex > 0 ifTrue: [ - startIndex := aTag findString: '"' startingAt: startIndex+attribute size. - stopIndex := aTag findString: '"' startingAt: startIndex+1. - aTag copyFrom: startIndex+1 to: stopIndex-1]]) - in: [:values | - colorName := values first. - fontFace := values second. - fontSize := values third]. + "<font face=""Bitmap DejaVu Sans"" size=""12"">" + fontFace := self searchTag: aTag forAttribute: #face. + fontSize := self searchTag: aTag forAttribute: #size. - colorName ifNotNil: [ - result add: (TextColor color: (Color fromString: colorName))]. (fontFace notNil or: [fontSize notNil]) ifTrue: [ result add: (TextFontReference toFont: (StrikeFont familyName: (fontFace ifNil: [TextStyle defaultFont familyName]) pointSize: (fontSize ifNil: [TextStyle defaultFont pointSize])))]. ^ result! Item was changed: ----- Method: HtmlReadWriter>>mapImgTag: (in category 'mapping') ----- mapImgTag: aTag + | result src form scaleFactor | - | result startIndex stopIndex attribute src form scaleFactor | result := OrderedCollection new. "<img src=""https://squeak.org/img/downloads/image.png"">" + (src := self searchTag: aTag forAttribute: #src) ifNil: [^ #()]. + form := (self getImage: src) ifNil: [self imagePlaceholder]. + (scaleFactor := RealEstateAgent scaleFactor) = 1.0 + ifFalse: [form := form scaledToSize: form extent * scaleFactor]. + ^ {form asTextAnchor. TextColor color: Color transparent}! - attribute := 'src'. - startIndex := aTag findString: attribute. - startIndex > 0 ifTrue: [ - startIndex := aTag findString: '"' startingAt: startIndex+attribute size. - startIndex > 0 - ifTrue: [stopIndex := aTag findString: '"' startingAt: startIndex+1] - ifFalse: [ - "URLs without quotes..." - startIndex := aTag findString: '=' startingAt: startIndex+attribute size. - stopIndex := aTag findString: '>' startingAt: startIndex+1]. - src := aTag copyFrom: startIndex+1 to: stopIndex-1. - form := (self httpGetImage: src) ifNil: [(Form dotOfSize: 12 color: Color veryLightGray)]. - (scaleFactor := RealEstateAgent scaleFactor) = 1.0 - ifFalse: [form := form scaledToSize: form extent * scaleFactor]. - result - add: form asTextAnchor; - add: (TextColor color: Color transparent)]. - ^ result! Item was added: + ----- Method: HtmlReadWriter>>mapPreformattingTag (in category 'mapping') ----- + mapPreformattingTag + + preformattingLevel := preformattingLevel + 1. + ^ {}! Item was changed: ----- Method: HtmlReadWriter>>mapTagToAttribute: (in category 'mapping') ----- mapTagToAttribute: aTag + (#('<div' '<p' '<center' '<blockquote' '<pre') anySatisfy: [:ea | self hasTag: aTag name: ea]) + ifTrue: [self assureLinebreak]. + + (self hasTag: aTag name: '<b') ifTrue: [^ {TextEmphasis bold}]. + (self hasTag: aTag name: '<i') ifTrue: [^ {TextEmphasis italic}]. + (self hasTag: aTag name: '<u') ifTrue: [^ {TextEmphasis underlined}]. + (self hasTag: aTag name: '<s') ifTrue: [^ {TextEmphasis struckOut}]. + (self hasTag: aTag name: '<code') ifTrue: [^ self mapCodeTag]. + (self hasTag: aTag name: '<pre') ifTrue: [^ self mapPreformattingTag]. + (#('<div' '<span' '<p' '<center' '<blockquote') anySatisfy: [:ea | self hasTag: aTag name: ea]) + ifTrue: [^ (self mapAlignmentTag: aTag) union: (self mapContainerTag: aTag)]. + (self hasTag: aTag name: '<font') ifTrue: [^ self mapFontTag: aTag]. + (self hasTag: aTag name: '<a') ifTrue: [^ self mapATag: aTag]. + (self hasTag: aTag name: '<img') ifTrue: [^ self mapImgTag: aTag]. + - aTag = '<b>' ifTrue: [^ {TextEmphasis bold}]. - aTag = '<i>' ifTrue: [^ {TextEmphasis italic}]. - aTag = '<u>' ifTrue: [^ {TextEmphasis underlined}]. - aTag = '<s>' ifTrue: [^ {TextEmphasis struckOut}]. - aTag = '<code>' ifTrue: [^ self mapCodeTag]. - aTag = '<pre>' ifTrue: [self breakLines: false. ^ {}]. - (#('<div' '<span' '<center>' ) anySatisfy: [:ea | aTag beginsWith: ea]) - ifTrue: [^(self mapAlignmentTag: aTag) union: (self mapContainerTag: aTag)]. - (aTag beginsWith: '<font') ifTrue: [^ self mapFontTag: aTag]. - (aTag beginsWith: '<a') ifTrue: [^ self mapATag: aTag]. - (aTag beginsWith: '<img') ifTrue: [^ self mapImgTag: aTag]. - "h1, h2, h3, ..." + ((aTag second sameAs: $h) and: [aTag third isDigit]) - (aTag second = $h and: [aTag third isDigit]) ifTrue: [^ {TextEmphasis bold}]. + - ^ {}! 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 - ^ 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: [ + (string at: last) isSeparator ifFalse: [^ text first: last]]. + ^ text! - runs: runArray! Item was changed: ----- Method: HtmlReadWriter>>processEmptyTag: (in category 'reading') ----- processEmptyTag: aTag + (self hasTag: aTag name: '<br') ifTrue: [ + ^ self processLinebreak]. - (aTag beginsWith: '<br') ifTrue: [ - self addCharacter: Character cr. - ^ self]. + (self hasTag: aTag name: '<img') ifTrue:[ - (aTag beginsWith: '<img') ifTrue:[ ^ self processStartTag: aTag]. (self isTagIgnored: aTag) ifTrue: [^ self]. "TODO... what?"! Item was removed: - ----- Method: HtmlReadWriter>>processEndTag: (in category 'reading') ----- - processEndTag: aTag - - | index tagName | - index := count - offset. - tagName := aTag copyFrom: 3 to: aTag size - 1. - - (self isTagIgnored: tagName) ifTrue: [^ self]. - - tagName = 'code' ifTrue: [self mapCloseCodeTag]. - tagName = 'pre' ifTrue: [self breakLines: true]. - - self processRunStackTop. - - runStack pop. - runStack top at: 2 put: index + 1.! Item was added: + ----- Method: HtmlReadWriter>>processEndTag:eagerly: (in category 'reading') ----- + processEndTag: tagName eagerly: eagerly + + | index | + (self isTagIgnored: tagName) ifTrue: [^ self]. + (self isExcludedTag: tagName) ifTrue: [ + exclusionLevel := exclusionLevel - 1. + ^ self]. + + eagerly ifFalse: [ + "Void tags such as <img> have no closing tag in HTML5, thus we already simulate their end in #processStartTag:. If we reach here anyway for XHTML style tags, we must not process the end tag again." + (self isVoidTag: tagName) ifTrue: [^ self]]. + + (tagName = 'p' or: [tagName = 'div'] or: [tagName = 'pre']) ifTrue: [ + self assureLinebreak]. + tagName = 'hr' ifTrue: [self addCharacter: Character cr]. + tagName = 'code' ifTrue: [self mapCloseCodeTag]. + tagName = 'pre' ifTrue: [self mapClosePreformattingTag]. + + self processRunStackTop. + + index := count - offset. + runStack pop. + runStack top at: 2 put: index + 1.! Item was removed: - ----- Method: HtmlReadWriter>>processEndTagEagerly: (in category 'reading') ----- - processEndTagEagerly: aTag - "Not all tags need an end tag. Simulate that here." - - (aTag beginsWith: '<img') - ifTrue: [^ self processEndTag: '</img>'].! Item was changed: ----- Method: HtmlReadWriter>>processHtmlEscape: (in category 'reading') ----- processHtmlEscape: aString + + (self htmlEscape: aString) ifNotNil: [:char | self addCharacter: char].! - | escapeSequence | - escapeSequence := aString copyFrom: 2 to: aString size - 1. - escapeSequence first = $# ifTrue: [^ self processHtmlEscapeNumber: escapeSequence allButFirst]. - (String htmlEntities at: (aString copyFrom: 2 to: aString size - 1) ifAbsent: []) - ifNotNil: [:char | - self addCharacter: char].! Item was removed: - ----- Method: HtmlReadWriter>>processHtmlEscapeNumber: (in category 'private') ----- - processHtmlEscapeNumber: aString - | number | - number := aString first = $x - ifTrue: [ '16r', aString allButFirst ] - ifFalse: [ aString ]. - self addCharacter: number asNumber asCharacter. - ! Item was added: + ----- Method: HtmlReadWriter>>processLinebreak (in category 'reading') ----- + processLinebreak + + self addCharacter: Character cr. + lastFixedWhitespace := string size. + ! Item was changed: ----- Method: HtmlReadWriter>>processNextTag (in category 'reading') ----- processNextTag + | tag htmlEscape lookForNewTag lookForHtmlEscape tagFound inComment inTagString | - | tag htmlEscape lookForNewTag lookForHtmlEscape tagFound valid inComment inTagString | lookForNewTag := true. lookForHtmlEscape := false. tagFound := false. tag := OrderedCollection new. htmlEscape := OrderedCollection new. inComment := false. inTagString := false. [stream atEnd not and: [tagFound not]] whileTrue: [ | character | character := stream next. - valid := (#(10 13) includes: character asciiValue) not. count := count + 1. character = $< ifTrue: [lookForNewTag := false]. character = $& ifTrue: [inComment ifFalse: [lookForHtmlEscape := true]]. lookForNewTag ifTrue: [ lookForHtmlEscape ifFalse: [ + exclusionLevel <= 0 + ifTrue: [ + (preformattingLevel <= 0 ==> [character isSeparator not]) + ifTrue: [string add: character] + ifFalse: [self assureSeparator]] - (valid or: [self breakLines not]) - ifTrue: [string add: character] ifFalse: [offset := offset + 1]] + ifTrue: [ + htmlEscape add: character. + offset := offset + 1]] + ifFalse: [ + tag add: character. + offset := offset + 1]. - ifTrue: [valid ifTrue: [htmlEscape add: character]. offset := offset + 1]] - ifFalse: [valid ifTrue: [tag add: character]. offset := offset + 1]. "Toggle within tag string/text." (character = $" and: [lookForNewTag not]) ifTrue: [inTagString := inTagString not]. inComment := ((lookForNewTag not and: [tag size >= 4]) and: [tag beginsWith: '<!!--']) and: [(tag endsWith: '-->') not]. (((character = $> and: [inComment not]) and: [lookForNewTag not]) and: [inTagString not]) ifTrue: [ lookForNewTag := true. (tag beginsWith: '<!!--') ifTrue: [self processComment: (String withAll: tag)] ifFalse: [tag second ~= $/ ifTrue: [ (tag atLast: 2) == $/ ifTrue: [self processEmptyTag: (String withAll: tag)] ifFalse: [self processStartTag: (String withAll: tag)]] + ifFalse: [self processEndTag: ((String withAll: tag) copyFrom: 3 to: tag size - 1) asLowercase eagerly: false]]. - ifFalse: [self processEndTag: (String withAll: tag)]]. tagFound := true]. (((character = $; and: [lookForNewTag]) and: [htmlEscape notEmpty]) and: [htmlEscape first = $&]) ifTrue: [ lookForHtmlEscape := false. self processHtmlEscape: (String withAll: htmlEscape). + htmlEscape := OrderedCollection new]].! - htmlEscape := OrderedCollection new]]. - ! Item was changed: ----- Method: HtmlReadWriter>>processStartTag: (in category 'reading') ----- processStartTag: aTag + | tagName index | + tagName := ((aTag copyWithoutAll: '</>') copyUpTo: Character space) asLowercase. + + (self isTagIgnored: tagName) ifTrue: [^ self]. + (self isExcludedTag: tagName) ifTrue: [ + exclusionLevel := exclusionLevel + 1. - | index | - (self isTagIgnored: aTag) ifTrue: [^ self]. - - index := count - offset. - - aTag = '<br>' ifTrue: [ - self addCharacter: Character cr. ^ self]. + + index := count - offset. + + tagName = 'br' ifTrue: [ + ^ self processLinebreak]. + + tagName = 'img' ifTrue: [ - - (aTag beginsWith: '<img') ifTrue: [ self addString: Character startOfHeader asString. offset := offset + 1. index := index - 1]. + self processRunStackTop. + "To add all attributes before the next tag adds some." - self processRunStackTop. "To add all attributes before the next tag adds some." - "Copy attr list and add new attr." + runStack push: { + runStack top first copy + addAll: (self mapTagToAttribute: aTag); + yourself. + index + 1. + index + 1}. + + "For void tags such as <img>, we should simulate the end tag because in case of HTML5 there won't be any." + (self isVoidTag: tagName) ifTrue: [self processEndTag: tagName eagerly: true]! - runStack push: ({runStack top first copy addAll: (self mapTagToAttribute: aTag); yourself. index + 1 . index + 1}). - - "For tags such as <img>, we should simulate the closing tag because there won't be any." - self processEndTagEagerly: aTag.! Item was added: + ----- Method: HtmlReadWriter>>searchTag:forAttribute: (in category 'private') ----- + searchTag: aTag forAttribute: attributeName + + | startIndex stopIndex | + startIndex := aTag findString: attributeName startingAt: 1 caseSensitive: false. + startIndex = 0 ifTrue: [^ nil]. + + startIndex := startIndex + attributeName size - 1. + [(aTag at: (startIndex := startIndex + 1)) isSeparator] whileTrue. + (aTag at: startIndex) = $= ifFalse: [^ nil]. + + [(aTag at: (startIndex := startIndex + 1)) isSeparator] whileTrue. + (aTag at: startIndex) = $" + ifTrue: [ + startIndex := startIndex + 1. + stopIndex := aTag indexOf: $" startingAt: startIndex + 1] + ifFalse: [ + stopIndex := aTag indexOfAnyOf: ' >' startingAt: startIndex + 1]. + stopIndex = 0 ifTrue: [^ nil]. + ^ self htmlEscapes: (aTag copyFrom: startIndex to: stopIndex - 1)! Item was added: + ----- Method: HtmlReadWriter>>voidTags (in category 'accessing') ----- + voidTags + "Tags that are empty and won't be closed in HTML5." + + ^ #(img hr)! Item was changed: (PackageInfo named: 'Collections') postscript: '"Make sure the symbol table consists of immutable sets" #(SymbolTable NewSymbols) do: [ :variableName | + (Symbol classPool at: variableName) beReadOnlyObject ]. + + "Add new instvars to HtmlReadWriter" + HtmlReadWriter allSubInstancesDo: [:ea | + (ea instVarNamed: ''preformattingLevel'') ifNil: [ + ea instVarNamed: ''preformattingLevel'' put: + (ea breakLines ifTrue: [0] ifFalse: [1])]. + + (ea instVarNamed: ''exclusionLevel'') ifNil: [ + ea instVarNamed: ''exclusionLevel'' put: 0]. + + (ea instVarNamed: ''lastFixedWhitespace'') ifNil: [ + ea instVarNamed: ''lastFixedWhitespace'' put: 0]].'! - (Symbol classPool at: variableName) beReadOnlyObject ]'!

2 1

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: 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

The Trunk: Collections-ct.1038.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.1038.mcz ==================== Summary ==================== Name: Collections-ct.1038 Author: ct Time: 20 May 2023, 6:14:31.154984 pm UUID: 94300876-0004-ba4a-8787-ba1d7419c776 Ancestors: Collections-ct.1037 Makes HtmlReadWriter capable of rejecting downloadable or executable resources during parsing, such as URLs or code:// URIs in <img> tags. By default, a HtmlReadWriter has full permissions. May be useful for performance or security concerns. Squeak Inbox Talk needs this. :-) =============== Diff against Collections-ct.1037 =============== Item was changed: TextReadWriter subclass: #HtmlReadWriter + instanceVariableNames: 'count offset runStack runArray string breakLines permissions indent preformattingLevel exclusionLevel lastFixedWhitespace' - instanceVariableNames: 'count offset runStack runArray string breakLines indent preformattingLevel exclusionLevel lastFixedWhitespace' classVariableNames: '' poolDictionaries: '' category: 'Collections-Text'! !HtmlReadWriter commentStamp: 'pre 8/29/2017 16:14' prior: 0! A HtmlReadWriter is used to read a Text object from a string containing HTML or writing a Text object to a string with HTML tags representing the text attributes. It does two things currently: 1) Setting text attributes on the beginning of tags, e.g. setting a bold text attribute when seeing a <b> tag. 2) Changing the resulting string, e.g. replacing a <br> with a Character cr. The implementation works by pushing attributes on a stack on every opening tag. On the corresponding closing tag, the attribute is poped from the stack and stored in an array of attribute runs. From this array the final string is constructed. ## Notes on the implementation - The final run array is completely constructed while parsing so it has to be correct with regard to the length of the runs. There is no consolidation except for merging neighboring runs which include the same attributes. - The *count* variable is the position in the source string, the *offset* is the number of skipped characters, for example ones that denote a tag. - The stack contains elements which are of the form: {text attributes. current start index. original start}! Item was added: + ----- Method: HtmlReadWriter>>defaultPermissions (in category 'initialize-release') ----- + defaultPermissions + + ^ Set with: #downloadResources with: #evaluateResources! Item was changed: ----- Method: HtmlReadWriter>>getImage: (in category 'private') ----- getImage: uri (uri beginsWith: 'cid:' caseSensitive: false) ifTrue: [ "Content-ID, used in nested MIMEDocuments, e.g., for emails with inline images" (Smalltalk classNamed: #MIMEContentRequest) ifNotNil: [:class | | cid | cid := uri allButFirst: 4. (class signal: cid) ifNotNil: [:document | ^ [document image] ifError: [nil]]]. ^ nil]. (uri beginsWith: 'code://' caseSensitive: false) ifTrue: [ | expression | "Same support for Smalltalk expressions as in TextURL >> #actOnClickFor:." + self shallEvaluateResources ifFalse: [^ nil]. expression := uri allButFirst: 7. ^ ([Compiler evaluate: expression] ifError: [nil]) ifNotNil: [:object | object isForm ifTrue: [object] ifFalse: [nil]]]. (uri beginsWith: 'data:' caseSensitive: false) ifTrue: [ | data mediaType separator | separator := uri indexOf: $, ifAbsent: [^ nil]. mediaType := uri copyFrom: 6 to: separator - 1. data := uri allButFirst: separator. data := (mediaType endsWith: ';base64' caseSensitive: false) ifTrue: [ mediaType := mediaType allButLast: 7. [Base64MimeConverter mimeDecodeToBytes: data readStream] ifError: [nil]] ifFalse: [data asByteArray readStream]. ^ [ImageReadWriter formFromStream: data] ifError: [nil]]. + self shallDownloadResources ifFalse: [^ nil]. ^ (Smalltalk classNamed: #WebClient) ifNotNil: [:client | "Maybe we can have this via an AppRegistry at some point. Maybe extend WebBrowser." ([client httpGet: uri] ifError: [nil]) ifNotNil: [:response | response code = 200 ifFalse: [nil] ifTrue: [ [Form fromBinaryStream: response content asByteArray readStream] ifError: [nil]]]]! Item was added: + ----- Method: HtmlReadWriter>>hasPermission: (in category 'accessing - private') ----- + hasPermission: aSymbol + + ^ permissions includes: aSymbol! Item was changed: ----- Method: HtmlReadWriter>>initialize (in category 'initialize-release') ----- initialize super initialize. preformattingLevel := 0. exclusionLevel := 0. lastFixedWhitespace := 0. + permissions := self defaultPermissions. self indent: 0. self breakLines: true.! Item was added: + ----- Method: HtmlReadWriter>>setPermission:to: (in category 'accessing - private') ----- + setPermission: aSymbol to: aBoolean + + aBoolean + ifTrue: [permissions add: aSymbol] + ifFalse: [permissions remove: aSymbol ifAbsent: []].! Item was added: + ----- Method: HtmlReadWriter>>shallDownloadResources (in category 'accessing') ----- + shallDownloadResources + "Indicate whether the receiver shall download resources during parsing, such as an image URL in "'<img src="https://squeak.org/static/img/squeak.png">'." May be useful for performance or security concerns." + + ^ self hasPermission: #downloadResources! Item was added: + ----- Method: HtmlReadWriter>>shallDownloadResources: (in category 'accessing') ----- + shallDownloadResources: aBoolean + "Set whether the receiver shall download resources during parsing, such as an image URL in "'<img src="https://squeak.org/static/img/squeak.png">'." May be useful for performance or security concerns." + + ^ self setPermission: #downloadResources to: aBoolean! Item was added: + ----- 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: #downloadResources! Item was added: + ----- 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: #downloadResources to: aBoolean! Item was changed: (PackageInfo named: 'Collections') postscript: '"Make sure the symbol table consists of immutable sets" #(SymbolTable NewSymbols) do: [ :variableName | (Symbol classPool at: variableName) beReadOnlyObject ]. "Add new instvars to HtmlReadWriter" HtmlReadWriter allSubInstancesDo: [:ea | + (ea instVarNamed: ''permissions'') ifNil: [ + ea instVarNamed: ''permissions'' put: ea defaultPermissions]. + (ea instVarNamed: ''indent'') ifNil: [ ea instVarNamed: ''indent'' put: 0]. (ea instVarNamed: ''preformattingLevel'') ifNil: [ ea instVarNamed: ''preformattingLevel'' put: (ea breakLines ifTrue: [0] ifFalse: [1])]. (ea instVarNamed: ''exclusionLevel'') ifNil: [ ea instVarNamed: ''exclusionLevel'' put: 0]. (ea instVarNamed: ''lastFixedWhitespace'') ifNil: [ ea instVarNamed: ''lastFixedWhitespace'' put: 0]].'!

1 0

The Trunk: CollectionsTests-ct.392.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.392.mcz ==================== Summary ==================== Name: CollectionsTests-ct.392 Author: ct Time: 20 May 2023, 6:14:26.941984 pm UUID: 01a2fb63-64dc-1e4c-9c58-42a38ec58898 Ancestors: CollectionsTests-ct.391 Complements Collections-ct.1038 (HtmlReadWriter permissions). =============== Diff against CollectionsTests-ct.391 =============== 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}]) , ({ '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. '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. } 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.1037.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.1037.mcz ==================== Summary ==================== Name: Collections-ct.1037 Author: ct Time: 20 May 2023, 5:55:52.664861 pm UUID: 46ac344d-db85-cc46-892f-a4829536c23e Ancestors: Collections-ct.1036 Adds <blockquote> tag to HtmlReadWriter and maps it to TextIndent. Also implements #= on TextIndent. =============== Diff against Collections-ct.1036 =============== Item was changed: TextReadWriter subclass: #HtmlReadWriter + instanceVariableNames: 'count offset runStack runArray string breakLines indent preformattingLevel exclusionLevel lastFixedWhitespace' - instanceVariableNames: 'count offset runStack runArray string breakLines preformattingLevel exclusionLevel lastFixedWhitespace' classVariableNames: '' poolDictionaries: '' category: 'Collections-Text'! !HtmlReadWriter commentStamp: 'pre 8/29/2017 16:14' prior: 0! A HtmlReadWriter is used to read a Text object from a string containing HTML or writing a Text object to a string with HTML tags representing the text attributes. It does two things currently: 1) Setting text attributes on the beginning of tags, e.g. setting a bold text attribute when seeing a <b> tag. 2) Changing the resulting string, e.g. replacing a <br> with a Character cr. The implementation works by pushing attributes on a stack on every opening tag. On the corresponding closing tag, the attribute is poped from the stack and stored in an array of attribute runs. From this array the final string is constructed. ## Notes on the implementation - The final run array is completely constructed while parsing so it has to be correct with regard to the length of the runs. There is no consolidation except for merging neighboring runs which include the same attributes. - The *count* variable is the position in the source string, the *offset* is the number of skipped characters, for example ones that denote a tag. - The stack contains elements which are of the form: {text attributes. current start index. original start}! Item was added: + ----- Method: HtmlReadWriter>>indent (in category 'accessing') ----- + indent + + ^ indent! Item was added: + ----- Method: HtmlReadWriter>>indent: (in category 'accessing') ----- + indent: anInteger + + indent := anInteger.! Item was changed: ----- Method: HtmlReadWriter>>initialize (in category 'initialize-release') ----- initialize super initialize. preformattingLevel := 0. exclusionLevel := 0. lastFixedWhitespace := 0. + self indent: 0. - self breakLines: true.! Item was changed: ----- Method: HtmlReadWriter>>mapAlignmentTag: (in category 'mapping') ----- mapAlignmentTag: aTag " special html case ". (self hasTag: aTag name: '<center') ifTrue: [^ {TextAlignment centered}]. + (self hasTag: aTag name: '<blockquote') ifTrue: [^ self mapBlockquoteTag]. "<div align=justify> or <div align=""right"">" (self searchTag: aTag forAttribute: #align) ifNotNil: [:alignment | ^ self mapAlignmentValue: alignment asLowercase]. ^ #()! Item was added: + ----- Method: HtmlReadWriter>>mapBlockquoteTag (in category 'mapping') ----- + mapBlockquoteTag + + ^ {TextIndent tabs: (indent := indent + 1)}! Item was added: + ----- Method: HtmlReadWriter>>mapCloseBlockquoteTag (in category 'mapping') ----- + mapCloseBlockquoteTag + + indent := indent - 1.! Item was changed: ----- Method: HtmlReadWriter>>processEndTag:eagerly: (in category 'reading') ----- processEndTag: tagName eagerly: eagerly | index | (self isTagIgnored: tagName) ifTrue: [^ self]. (self isExcludedTag: tagName) ifTrue: [ exclusionLevel := exclusionLevel - 1. ^ self]. eagerly ifFalse: [ "Void tags such as <img> have no closing tag in HTML5, thus we already simulate their end in #processStartTag:. If we reach here anyway for XHTML style tags, we must not process the end tag again." (self isVoidTag: tagName) ifTrue: [^ self]]. (tagName = 'p' or: [tagName = 'div'] or: [tagName = 'pre']) ifTrue: [ self assureLinebreak]. tagName = 'hr' ifTrue: [self addCharacter: Character cr]. + tagName = 'blockquote' ifTrue: [self mapCloseBlockquoteTag]. tagName = 'code' ifTrue: [self mapCloseCodeTag]. tagName = 'pre' ifTrue: [self mapClosePreformattingTag]. self processRunStackTop. index := count - offset. runStack pop. runStack top at: 2 put: index + 1.! Item was added: + ----- Method: TextIndent>>= (in category 'comparing') ----- + = other + + ^ (other class == self class) + and: [other amount = self amount]! Item was added: + ----- Method: TextIndent>>closeHtmlOn: (in category 'html') ----- + closeHtmlOn: aStream + + aStream nextPutAll: '</blockquote>'.! Item was added: + ----- Method: TextIndent>>openHtmlOn: (in category 'html') ----- + openHtmlOn: aStream + + aStream nextPutAll: '<blockquote>'.! Item was changed: (PackageInfo named: 'Collections') postscript: '"Make sure the symbol table consists of immutable sets" #(SymbolTable NewSymbols) do: [ :variableName | (Symbol classPool at: variableName) beReadOnlyObject ]. "Add new instvars to HtmlReadWriter" HtmlReadWriter allSubInstancesDo: [:ea | + (ea instVarNamed: ''indent'') ifNil: [ + ea instVarNamed: ''indent'' put: 0]. + (ea instVarNamed: ''preformattingLevel'') ifNil: [ ea instVarNamed: ''preformattingLevel'' put: (ea breakLines ifTrue: [0] ifFalse: [1])]. (ea instVarNamed: ''exclusionLevel'') ifNil: [ ea instVarNamed: ''exclusionLevel'' put: 0]. (ea instVarNamed: ''lastFixedWhitespace'') ifNil: [ ea instVarNamed: ''lastFixedWhitespace'' put: 0]].'!

1 0

← Newer
1
...
4
5
6
7
8
9
10
11
Older →