Packages June 2023

packages@lists.squeakfoundation.org

1 participants
65 discussions

The Trunk: NetworkTests-ct.74.mcz
by commits＠source.squeak.org 04 Jun '23

04 Jun '23

Christoph Thiede uploaded a new version of NetworkTests to project The Trunk: http://source.squeak.org/trunk/NetworkTests-ct.74.mcz ==================== Summary ==================== Name: NetworkTests-ct.74 Author: ct Time: 4 June 2023, 9:29:02.957452 pm UUID: 34628f03-5ba2-0b43-8092-4f66941415d0 Ancestors: NetworkTests-ct.73 Complements Network-ct.279 (robustness of serializing incomplete MIMEDocuments). =============== Diff against NetworkTests-ct.73 =============== Item was added: + ----- Method: MIMEDocumentTest>>testAsSendableBodyText (in category 'tests') ----- + testAsSendableBodyText + + | document | + document := self classToBeTested content: 'Can''t retrieve content: ''multipart/alternative'''. + document contentTypeHeaderValue: (MIMEHeaderValue fromMIMEHeader: document class contentTypeMultipartAlternative). + self assert: 'Can''t retrieve content: ''multipart/alternative''' equals: document asSendableBodyText.!

1 0

The Trunk: Network-ct.279.mcz
by commits＠source.squeak.org 04 Jun '23

04 Jun '23

Christoph Thiede uploaded a new version of Network to project The Trunk: http://source.squeak.org/trunk/Network-ct.279.mcz ==================== Summary ==================== Name: Network-ct.279 Author: ct Time: 4 June 2023, 9:26:03.835452 pm UUID: 118e49cc-c7a9-ea4c-9298-a6f428472730 Ancestors: Network-ct.278 Increases robustness of serializing incomplete MIMEDocuments. Some messages on squeak-dev contain incomplete multipart documents. =============== Diff against Network-ct.278 =============== Item was changed: ----- Method: MIMEDocument>>asSendableBodyText (in category 'serializing') ----- asSendableBodyText | sendableBodyText | + sendableBodyText := (self isMultipart and: [self attachmentSeparator notNil]) - sendableBodyText := self isMultipart ifTrue: [self sendableMultipartBodyText] ifFalse: [(self isPlaintext or: [self isHTML]) ifTrue: [self class tryToEncodeBody: self contents as: self charset] ifFalse: [self contents]]. ^ (self hasFieldNamed: 'content-transfer-encoding') ifFalse: [sendableBodyText] ifTrue: [ | transferEncoding | transferEncoding := self contentTransferEncoding. ((MimeConverter forEncoding: transferEncoding) mimeEncode: sendableBodyText readStream) contents ] !

1 0

The Trunk: ToolsTests-ct.121.mcz
by commits＠source.squeak.org 04 Jun '23

04 Jun '23

Christoph Thiede uploaded a new version of ToolsTests to project The Trunk: http://source.squeak.org/trunk/ToolsTests-ct.121.mcz ==================== Summary ==================== Name: ToolsTests-ct.121 Author: ct Time: 4 June 2023, 9:01:31.612452 pm UUID: 4bedb18c-54be-b54a-8257-1bad3b79cf3a Ancestors: ToolsTests-mt.120 Adds tests for InspectorField class>>#generateExpressionFrom:argumentNames:. Complements Tools-ct.1218. =============== Diff against ToolsTests-mt.120 =============== Item was added: + ClassTestCase subclass: #InspectorFieldTest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'ToolsTests-Inspector'! Item was added: + ----- Method: InspectorFieldTest>>testGenerateExpression (in category 'tests - support') ----- + testGenerateExpression + + | tempLit tempObj | + tempLit := #(42). + tempObj := Object new. + {#(). + {[]. 'nil'. + [1 + 2]. '1 + 2'. + [tempLit]. '#(42)'. + [tempObj]. nil}. + #('plonk'). + {[:object | object]. 'plonk'. + [:object | {object}]. '{plonk}'. + [:object | {object. object}]. '{plonk. plonk}'. + [:object | object griffle. object + object griffle]. 'plonk griffle. + plonk + plonk griffle'}. + #('plonk' 'griffle'). + {[:a :b | a + b; add: b]. 'plonk + griffle; + add: griffle'}} + pairsDo: [:argumentNames :pairs | + pairs pairsDo: [:block :expectedExpression | + self assert: expectedExpression equals: + (self classToBeTested + generateExpressionFrom: block + argumentNames: argumentNames)]].!

1 0

The Trunk: Tools-ct.1218.mcz
by commits＠source.squeak.org 04 Jun '23

04 Jun '23

Christoph Thiede uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-ct.1218.mcz ==================== Summary ==================== Name: Tools-ct.1218 Author: ct Time: 4 June 2023, 8:57:23.493452 pm UUID: c68caf30-85c7-5a47-aa08-07f57ca13d30 Ancestors: Tools-ct.1216 Fixes regression in InspectorField class>>#generateExpressionFrom:argumentNames: from last version. Of course, we must first copy the argument before reusing it. Sorry for the noise. =============== Diff against Tools-ct.1216 =============== Item was changed: ----- Method: InspectorField class>>generateExpressionFrom:argumentNames: (in category 'support') ----- generateExpressionFrom: aBlock argumentNames: argumentNames | blockNode arguments variables context receiver | self flag: #experimental. blockNode := aBlock decompile veryDeepCopy. "some literals are singletons, see #becomeForward: below" arguments := blockNode arguments collect: #name. variables := Dictionary new. variables at: #true put: true; at: #false put: false; at: #nil put: nil. receiver := aBlock receiver. receiver class allInstVarNames withIndexDo: [:clsName :index | variables at: clsName put: (receiver instVarAt: index)]. context := aBlock outerContext. context tempNames withIndexDo: [:tmpName :index | variables at: tmpName put: (context namedTempAt: index)]. blockNode nodesDo: [:node | self flag: #ct. "Should we introduce #nodesCollect: instead of using dangerous #becomeForward:?" { [node isVariableNode not]. - [blockNode arguments includes: node]. "nodes that were already renamed" [| argumentIndex | argumentIndex := arguments indexOf: node name. argumentIndex isZero ifFalse: [node name: (argumentNames at: argumentIndex)]; not]. + [blockNode arguments includes: node]. "nodes that were already renamed" [variables at: node name ifPresent: [:value | value isLiteral ifTrue: [node becomeForward: (LiteralNode new key: value)]; yourself] ifAbsent: [^ nil]]. } detect: #value ifNone: [^ nil]]. ^ String streamContents: [:stream | blockNode printStatementsOn: stream indent: 0].!

1 0

The Trunk: NetworkTests-ct.73.mcz
by commits＠source.squeak.org 04 Jun '23

04 Jun '23

Christoph Thiede uploaded a new version of NetworkTests to project The Trunk: http://source.squeak.org/trunk/NetworkTests-ct.73.mcz ==================== Summary ==================== Name: NetworkTests-ct.73 Author: ct Time: 4 June 2023, 3:31:46.585153 pm UUID: 3c57fed3-b961-fb41-bd0b-bfcf41877dd3 Ancestors: NetworkTests-pre.72 Complements Network-ct.278 (#bodyTextFormatted:showAttachments:). Also improves coverage of #attachmentText. =============== Diff against NetworkTests-pre.72 =============== 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)" 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;filename=griffle.txt'; yourself); addPart: (MIMEDocument contentType: 'image/png' content: pngContent); yourself) put: ('plonk\' withCRs asText , ('[griffle.txt]' asText addAttribute: TextMessageLink new; yourself) , '\' withCRs , pngText); - 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])]. + + + "showAttachments" + OrderedDictionary new + 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); yourself) put: {'plonk'. 'plonk\[attachment]' withCRs}; + at: ((MIMEDocument contentType: 'multipart/alternative') addPart: ((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); yourself); yourself) put: {'plonk'. 'plonk\[attachment]' withCRs}; + + keysAndValuesDo: [:document :expectedTexts | + | expectedText actualText | + expectedText := expectedTexts isArray ifTrue: [expectedTexts first] ifFalse: [expectedTexts]. + actualText := document bodyTextFormatted: false showAttachments: false. + self assert: expectedText asString equals: actualText asString]; + + keysAndValuesDo: [:document :expectedTexts | + | expectedText actualText | + expectedText := expectedTexts isArray ifTrue: [expectedTexts second] ifFalse: [expectedTexts]. + actualText := document bodyTextFormatted: false showAttachments: true. + self assert: expectedText asString equals: actualText asString].! - equals: (actualText isText ifTrue: [actualText runs printString])].!

1 0

The Trunk: Network-ct.278.mcz
by commits＠source.squeak.org 04 Jun '23

04 Jun '23

Christoph Thiede uploaded a new version of Network to project The Trunk: http://source.squeak.org/trunk/Network-ct.278.mcz ==================== Summary ==================== Name: Network-ct.278 Author: ct Time: 4 June 2023, 3:30:53.972153 pm UUID: 066c2a4c-ab52-2a4d-8025-45fbc1de561a Ancestors: Network-pre.277 Adds #bodyTextFormatted:showAttachments: on MIMEDocument and MailMessage for hiding non-inline parts. =============== Diff against Network-pre.277 =============== Item was changed: ----- Method: MIMEDocument>>bodyTextFormatted: (in category 'serializing') ----- bodyTextFormatted: shouldPreferRichText + "Answer a string or text representing the content of the receiver." + ^ self bodyTextFormatted: shouldPreferRichText showAttachments: true! - 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 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>>bodyTextFormatted:showAttachments: (in category 'serializing') ----- + bodyTextFormatted: shouldPreferRichText showAttachments: shouldShowAttachments + "Answer a string or text representing the content of the receiver." + + 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 bodyTextFormatted: shouldPreferRichText showAttachments: shouldShowAttachments]]]. + + "fallback" + ^ self parts first bodyTextFormatted: shouldPreferRichText showAttachments: shouldShowAttachments]. + + self subType = 'related' ifTrue: [ + "RFC2387" + ^ [self parts first bodyTextFormatted: shouldPreferRichText showAttachments: shouldShowAttachments] + on: MIMEContentRequest do: [:request | + (self partWithContentID: request cid) ifNotNil: [:part | + request resume: part]. + request pass]]. + + ^ Text streamContents: [:stream | + | sep | + sep := false. + self parts do: [:part | + sep := (part contentDisposition = 'inline' + ifTrue: [ + sep ifTrue: [stream cr]. + stream nextPutAll: (part bodyTextFormatted: shouldPreferRichText showAttachments: shouldShowAttachments)] + ifFalse: [ + shouldShowAttachments + ifTrue: [ + sep ifTrue: [stream cr]. + stream nextPutAll: part attachmentText]]) notNil]]]. + + self contentType = 'message/rfc822' ifTrue: [ + "embedded message" + ^ (MailMessage from: self content) bodyTextFormatted: shouldPreferRichText showAttachments: shouldShowAttachments]. + + 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 asString! Item was added: + ----- Method: MailMessage>>bodyTextFormatted:showAttachments: (in category 'printing/formatting') ----- + bodyTextFormatted: shouldPreferRichText showAttachments: shouldShowAttachments + + ^ self body bodyTextFormatted: shouldPreferRichText showAttachments: shouldShowAttachments!

1 0

The Trunk: Tools-ct.1216.mcz
by commits＠source.squeak.org 03 Jun '23

03 Jun '23

Christoph Thiede uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-ct.1216.mcz ==================== Summary ==================== Name: Tools-ct.1216 Author: ct Time: 3 June 2023, 10:24:27.601136 pm UUID: becae6c8-c841-024d-9f96-2b6a30d75def Ancestors: Tools-ct.1213 Fixes InspectorField class>>#generateExpressionFrom:argumentNames: for blocks with multiple references to an argument. InspectorField generateExpressionFrom: [:obj | {obj. obj}] argumentNames: #('myObject'). =============== Diff against Tools-ct.1213 =============== Item was changed: ----- Method: InspectorField class>>generateExpressionFrom:argumentNames: (in category 'support') ----- generateExpressionFrom: aBlock argumentNames: argumentNames | blockNode arguments variables context receiver | self flag: #experimental. blockNode := aBlock decompile veryDeepCopy. "some literals are singletons, see #becomeForward: below" arguments := blockNode arguments collect: #name. variables := Dictionary new. variables at: #true put: true; at: #false put: false; at: #nil put: nil. receiver := aBlock receiver. receiver class allInstVarNames withIndexDo: [:clsName :index | variables at: clsName put: (receiver instVarAt: index)]. context := aBlock outerContext. context tempNames withIndexDo: [:tmpName :index | variables at: tmpName put: (context namedTempAt: index)]. blockNode nodesDo: [:node | self flag: #ct. "Should we introduce #nodesCollect: instead of using dangerous #becomeForward:?" { [node isVariableNode not]. + [blockNode arguments includes: node]. "nodes that were already renamed" [| argumentIndex | argumentIndex := arguments indexOf: node name. argumentIndex isZero ifFalse: [node name: (argumentNames at: argumentIndex)]; not]. [variables at: node name ifPresent: [:value | value isLiteral ifTrue: [node becomeForward: (LiteralNode new key: value)]; yourself] ifAbsent: [^ nil]]. } detect: #value ifNone: [^ nil]]. ^ String streamContents: [:stream | blockNode printStatementsOn: stream indent: 0].!

1 0

The Trunk: Tools-ct.1211.mcz
by commits＠source.squeak.org 02 Jun '23

02 Jun '23

Christoph Thiede uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-ct.1211.mcz ==================== Summary ==================== Name: Tools-ct.1211 Author: ct Time: 1 June 2023, 8:26:54.735263 pm UUID: 0b71a9d8-b26d-854e-83ae-89d560db27a4 Ancestors: Tools-ct.1210 Proposal: In truncated file lists, inserts a link for reading the entire file. More observable than the context menu. Uses color and emphasis for highlighting the truncation message. =============== Diff against Tools-ct.1210 =============== Item was added: + ----- Method: FileList>>decorateTruncatedText:size:limit: (in category 'private') ----- + decorateTruncatedText: truncatedText size: size limit: limit + + | args | + args := { + fileName. size. limit. + 'Click here' translated asText + addAttribute: (PluggableTextAttribute evalBlock: [self get]); + addAttribute: TextEmphasis bold; + yourself }. + ^ Text streamContents: [:stream | + stream withAttributes: {TextColor red. TextEmphasis italic} do: [ + stream nextPutAll: ('File ''{1}'' is {2} bytes long. + {4} to read the entire file. + + Here are the first {3} characters... + ------------------------------------------ + ' translated + asText format: args)]. + stream nextPutAll: truncatedText. + stream withAttributes: {TextColor red. TextEmphasis italic} do: [ + stream nextPutAll: (' + ------------------------------------------ + ... end of the first {3} characters. + {4} to read the entire file.' translated + asText format: args)]]! Item was changed: ----- Method: FileList>>readContentsBrief: (in category 'private') ----- readContentsBrief: brevityFlag "Read the contents of the receiver's selected file, unless it is too long, in which case show just the first 5000 characters. Don't create a file if it doesn't already exist." | f fileSize first5000 | brevityFlag ifTrue: [ directory isRemoteDirectory ifTrue: [^ self readServerBrief]]. f := directory oldFileOrNoneNamed: self fullName. f ifNil: [^ 'For some reason, this file cannot be read' translated]. self setDefaultEncoderFor: f. (brevityFlag not or: [(fileSize := f size) <= 100000]) ifTrue: + [brevityState := #fullFile. "don't change till actually read" + ^ contents := f contentsOfEntireFile]. - [contents := f contentsOfEntireFile. - brevityState := #fullFile. "don't change till actually read" - ^ contents]. "if brevityFlag is true, don't display long files when first selected" first5000 := f next: 5000. f close. - contents := 'File ''{1}'' is {2} bytes long. - You may use the ''get'' command to read the entire file. - - Here are the first 5000 characters... - ------------------------------------------ - {3} - ------------------------------------------ - ... end of the first 5000 characters.' translated format: {fileName. fileSize. first5000}. brevityState := #briefFile. "don't change till actually read" + ^ contents := self decorateTruncatedText: first5000 size: fileSize limit: 5000! - ^ contents. - ! Item was changed: ----- Method: FileList>>readContentsHex: (in category 'private') ----- readContentsHex: brevity "retrieve the contents from the external file unless it is too long. Don't create a file here. Check if exists." | f size data hexData s | f := directory oldFileOrNoneNamed: self fullName. f == nil ifTrue: [^ 'For some reason, this file cannot be read' translated]. f binary. ((size := f size)) > 5000 & brevity ifTrue: [data := f next: 10000. f close. brevityState := #briefHex] ifFalse: [data := f contentsOfEntireFile. brevityState := #fullHex]. s := WriteStream on: (String new: data size*4). 0 to: data size-1 by: 16 do: [:loc | s nextPutAll: loc printStringHex; space; nextPut: $(; print: loc; nextPut: $); space; tab. loc+1 to: (loc+16 min: data size) do: [:i | s nextPutAll: (data at: i) printStringHex; space]. s cr]. hexData := s contents. + (brevity not or: [size <= 5000]) ifTrue: [ + ^ contents := hexData]. + + ^ contents := self decorateTruncatedText: hexData size: size limit: 5000! - ^ contents := ((size > 5000) & brevity - ifTrue: ['File ''{1}'' is {2} bytes long. - You may use the ''get'' command to read the entire file. - - Here are the first 5000 characters... - ------------------------------------------ - {3} - ------------------------------------------ - ... end of the first 5000 characters.' translated format: {fileName. size. hexData}] - ifFalse: [hexData]). - ! Item was changed: ----- Method: FileList>>readServerBrief (in category 'private') ----- readServerBrief + | lString sizeStr fsize ff first3500 parts | - | lString sizeStr fsize ff first5000 parts | "If file on server is known to be long, just read the beginning. Cheat badly by reading the fileList string." listIndex = 0 ifTrue: [^ self]. "Get size from file list entry" lString := list at: listIndex. parts := lString findTokens: '()'. sortMode = #name ifTrue: [sizeStr := (parts second findTokens: ' ') third]. sortMode = #date ifTrue: [sizeStr := (parts first findTokens: ' ') third]. sortMode = #size ifTrue: [sizeStr := (parts first findTokens: ' ') first]. fsize := (sizeStr copyWithout: $,) asNumber. fsize <= 50000 ifTrue: [ff := directory oldFileOrNoneNamed: self fullName. ff ifNil: [^ 'For some reason, this file cannot be read' translated]. contents := ff contentsOfEntireFile. brevityState := #fullFile. "don't change till actually read" ^ contents]. "if brevityFlag is true, don't display long files when first selected" + first3500 := directory getOnly: 3500 from: fileName. - first5000 := directory getOnly: 3500 from: fileName. - contents := 'File ''{1}'' is {2} bytes long. - You may use the ''get'' command to read the entire file. - - Here are the first 3500 characters... - ------------------------------------------ - {3} - ------------------------------------------ - ... end of the first 3500 characters.' translated format: {fileName. sizeStr. first5000}. brevityState := #briefFile. "don't change till actually read" + ^ contents := self decorateTruncatedText: first3500 size: sizeStr limit: 3500! - ^ contents. - - !

1 0

The Trunk: Tools-ct.1213.mcz
by commits＠source.squeak.org 02 Jun '23

02 Jun '23

Christoph Thiede uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-ct.1213.mcz ==================== Summary ==================== Name: Tools-ct.1213 Author: ct Time: 2 June 2023, 6:27:04.95093 pm UUID: 69d99752-1b0c-144f-96ed-57336ae8b8bd Ancestors: Tools-mt.1211, Tools-ct.1211 Merges Tools-ct.1211 (FileList link and emphasis for truncation). Revision: Reuses the style from code comments for the truncation message. =============== Diff against Tools-mt.1211 =============== Item was added: + ----- Method: FileList>>decorateTruncatedText:size:limit: (in category 'private') ----- + decorateTruncatedText: truncatedText size: size limit: limit + + | attribs args | + attribs := ((((self userInterfaceTheme get: #comment for: #SHTextStylerST80) ifNil: [#()]) + collect: [:ea | ea isColor ifTrue: [TextColor color: ea] ifFalse: [ea]]) + ifEmpty: [{TextColor color: Color cyan muchDarker}]) + copyWith: TextEmphasis italic. + args := { + fileName. size. limit. + 'Click here' translated asText + addAttribute: (PluggableTextAttribute evalBlock: [self get]); + addAttribute: TextEmphasis bold; + yourself }. + ^ Text streamContents: [:stream | + stream withAttributes: attribs do: [ + stream nextPutAll: ('File ''{1}'' is {2} bytes long. + {4} to read the entire file. + + Here are the first {3} characters... + ------------------------------------------ + ' translated + asText format: args)]. + stream nextPutAll: truncatedText. + stream withAttributes: attribs do: [ + stream nextPutAll: (' + ------------------------------------------ + ... end of the first {3} characters. + {4} to read the entire file.' translated + asText format: args)]]! Item was changed: ----- Method: FileList>>readContentsBrief: (in category 'private') ----- readContentsBrief: brevityFlag "Read the contents of the receiver's selected file, unless it is too long, in which case show just the first 5000 characters. Don't create a file if it doesn't already exist." | f fileSize first5000 | brevityFlag ifTrue: [ directory isRemoteDirectory ifTrue: [^ self readServerBrief]]. f := directory oldFileOrNoneNamed: self fullName. f ifNil: [^ 'For some reason, this file cannot be read' translated]. self setDefaultEncoderFor: f. (brevityFlag not or: [(fileSize := f size) <= 100000]) ifTrue: + [brevityState := #fullFile. "don't change till actually read" + ^ contents := f contentsOfEntireFile]. - [contents := f contentsOfEntireFile. - brevityState := #fullFile. "don't change till actually read" - ^ contents]. "if brevityFlag is true, don't display long files when first selected" first5000 := f next: 5000. f close. - contents := 'File ''{1}'' is {2} bytes long. - You may use the ''get'' command to read the entire file. - - Here are the first 5000 characters... - ------------------------------------------ - {3} - ------------------------------------------ - ... end of the first 5000 characters.' translated format: {fileName. fileSize. first5000}. brevityState := #briefFile. "don't change till actually read" + ^ contents := self decorateTruncatedText: first5000 size: fileSize limit: 5000! - ^ contents. - ! Item was changed: ----- Method: FileList>>readContentsHex: (in category 'private') ----- readContentsHex: brevity "retrieve the contents from the external file unless it is too long. Don't create a file here. Check if exists." | f size data hexData s | f := directory oldFileOrNoneNamed: self fullName. f == nil ifTrue: [^ 'For some reason, this file cannot be read' translated]. f binary. ((size := f size)) > 5000 & brevity ifTrue: [data := f next: 10000. f close. brevityState := #briefHex] ifFalse: [data := f contentsOfEntireFile. brevityState := #fullHex]. s := WriteStream on: (String new: data size*4). 0 to: data size-1 by: 16 do: [:loc | s nextPutAll: loc printStringHex; space; nextPut: $(; print: loc; nextPut: $); space; tab. loc+1 to: (loc+16 min: data size) do: [:i | s nextPutAll: (data at: i) printStringHex; space]. s cr]. hexData := s contents. + (brevity not or: [size <= 5000]) ifTrue: [ + ^ contents := hexData]. + + ^ contents := self decorateTruncatedText: hexData size: size limit: 5000! - ^ contents := ((size > 5000) & brevity - ifTrue: ['File ''{1}'' is {2} bytes long. - You may use the ''get'' command to read the entire file. - - Here are the first 5000 characters... - ------------------------------------------ - {3} - ------------------------------------------ - ... end of the first 5000 characters.' translated format: {fileName. size. hexData}] - ifFalse: [hexData]). - ! Item was changed: ----- Method: FileList>>readServerBrief (in category 'private') ----- readServerBrief + | lString sizeStr fsize ff first3500 parts | - | lString sizeStr fsize ff first5000 parts | "If file on server is known to be long, just read the beginning. Cheat badly by reading the fileList string." listIndex = 0 ifTrue: [^ self]. "Get size from file list entry" lString := list at: listIndex. parts := lString findTokens: '()'. sortMode = #name ifTrue: [sizeStr := (parts second findTokens: ' ') third]. sortMode = #date ifTrue: [sizeStr := (parts first findTokens: ' ') third]. sortMode = #size ifTrue: [sizeStr := (parts first findTokens: ' ') first]. fsize := (sizeStr copyWithout: $,) asNumber. fsize <= 50000 ifTrue: [ff := directory oldFileOrNoneNamed: self fullName. ff ifNil: [^ 'For some reason, this file cannot be read' translated]. contents := ff contentsOfEntireFile. brevityState := #fullFile. "don't change till actually read" ^ contents]. "if brevityFlag is true, don't display long files when first selected" + first3500 := directory getOnly: 3500 from: fileName. - first5000 := directory getOnly: 3500 from: fileName. - contents := 'File ''{1}'' is {2} bytes long. - You may use the ''get'' command to read the entire file. - - Here are the first 3500 characters... - ------------------------------------------ - {3} - ------------------------------------------ - ... end of the first 3500 characters.' translated format: {fileName. sizeStr. first5000}. brevityState := #briefFile. "don't change till actually read" + ^ contents := self decorateTruncatedText: first3500 size: sizeStr limit: 3500! - ^ contents. - - !

1 0

The Trunk: Morphic-mt.2110.mcz
by commits＠source.squeak.org 02 Jun '23

02 Jun '23

Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.2110.mcz ==================== Summary ==================== Name: Morphic-mt.2110 Author: mt Time: 2 June 2023, 6:24:12.90677 pm UUID: 8824e135-e624-624a-93eb-e9f77ed10748 Ancestors: Morphic-ct.2109 In tree widgets, speed up #itemFromPoint:, which is used for clicking and hovering, to not create extra arrays. =============== Diff against Morphic-ct.2109 =============== Item was changed: ----- Method: SimpleHierarchicalListMorph>>adjustSubmorphPositions (in category 'private') ----- adjustSubmorphPositions | p | p := 0@0. scroller submorphsDo: [ :each | | h | + h := each height. + each privateBounds: (p extent: self preferredSubmorphWidth@h). + each visible ifTrue: [p := p + (0@h)]]. - each visible ifTrue: [ - h := each height. - each privateBounds: (p extent: self preferredSubmorphWidth@h). - p := p + (0@h) ]]. scroller layoutChanged. selectedMorphIndex := nil. "to catch all collapse/expand events" self clearColumnsCache; changed; layoutChanged; setScrollDeltas. ! Item was changed: ----- Method: SimpleHierarchicalListMorph>>itemFromPoint: (in category 'event handling') ----- itemFromPoint: aPoint "Return the list element (morph) at the given point or nil if outside" + | items ptY firstVisibleRow lastVisibleRow row itemTop result | + items := scroller submorphs. + items ifEmpty: [^nil]. - | ptY visibleRows | - scroller hasSubmorphs ifFalse:[^nil]. (scroller fullBounds containsPoint: aPoint) ifFalse:[^nil]. + firstVisibleRow := items at: (items findFirst: [:m | m visible]). + lastVisibleRow := items at: (items findLast: [:m | m visible]). - visibleRows := scroller submorphs select: [:m | m visible]. + ptY := (firstVisibleRow point: aPoint from: self) y. - ptY := (visibleRows first point: aPoint from: self) y. "note: following assumes that submorphs are vertical, non-overlapping, and ordered" + firstVisibleRow top > ptY ifTrue:[^nil]. + lastVisibleRow bottom <= ptY ifTrue:[^lastVisibleRow]. - visibleRows first top > ptY ifTrue:[^nil]. - visibleRows last bottom < ptY ifTrue:[^visibleRows last]. "now use binary search" + row := items + findBinaryIndex:[:item| + (item top <= ptY and: [item bottom >= ptY]) - ^visibleRows - findBinary:[:item| - (item top <= ptY and:[item bottom >= ptY]) ifTrue:[0] "found" ifFalse:[ (item top + item bottom // 2) > ptY ifTrue:[-1] ifFalse:[1]]] + ifNone: [^nil]. + "ignore invisible rows, find first visible at #top; see #adjustSubmorphPositions." + itemTop := (items at: row) top. row := row - 1. + [row > 1 and: [(items at: row) top = itemTop]] whileTrue: [row := row-1] . + row := row + 1. + [(result := items at: row) visible] whileFalse: [row := row+1]. + ^ result! - ifNone: [nil]!

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Packages June 2023