Squeak-dev May 2023

squeak-dev@lists.squeakfoundation.org

16 participants
109 discussions

The Trunk: Collections-mt.1040.mcz
by commits＠source.squeak.org 22 May '23

22 May '23

Marcel Taeumel uploaded a new version of Collections to project The Trunk: http://source.squeak.org/trunk/Collections-mt.1040.mcz ==================== Summary ==================== Name: Collections-mt.1040 Author: mt Time: 22 May 2023, 11:09:12.610186 am UUID: 79d3b27e-3657-a141-8c98-2ed695e53980 Ancestors: Collections-ct.1039 Remove variable shadows. =============== Diff against Collections-ct.1039 =============== Item was changed: ----- 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: [:tmpStream | + [tmpStream next: nextIndex - lastIndex putAll: aString startingAt: lastIndex. - ^ 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]. + tmpStream nextPut: (self htmlEscape: (aString copyFrom: lastIndex to: nextIndex))] - stream nextPut: (self htmlEscape: (aString copyFrom: lastIndex to: nextIndex))] doWhileTrue: [(nextIndex := aString indexOf: $& startingAt: (lastIndex := nextIndex + 1)) > 0]. + tmpStream next: aString size - lastIndex + 1 putAll: aString startingAt: lastIndex]! - stream next: aString size - lastIndex + 1 putAll: aString startingAt: lastIndex]!

1 0

Review Request: mcSlips
by christoph.thiede＠student.hpi.uni-potsdam.de 21 May '23

21 May '23

Any fundamental objections before I would merge this into the Trunk? :-) =============== Summary =============== Change Set: mcSlips Date: 16 January 2022 Author: Christoph Thiede This changeset integrates the slip detection mechanism, previously only known from the domain of changesets, into the Monticello system. When users save a new version, it will automatically notify them about any possible slips and let them decide whether to browse them first or proceed the saving. Users can also scan their patch for slips manually by invocating the item from the patch list menu. The value of the preference #checkForSlips is still honored for the automatic detection, and the description of that preference is updated to mention the new usage. =============== Postscript =============== "Postscript:" (Preferences preferenceAt: #checkForSlips) helpString: 'If true, then whenever you file out a change set or save a Monticello version, it is checked for ''slips'' and if any are found, you are so informed and given a chance to open a browser on them.'. =============== Diff =============== CompiledMethod>>hasReportableSlip {testing} · ct 1/15/2022 22:32 (changed) hasReportableSlip "Answer whether the receiver contains anything that should be brought to the attention of the author when filing out. Customize the lists here to suit your preferences. If slips do not get reported in spite of your best efforts here, make certain that the Preference 'checkForSlips' is set to true." - #(#doOnlyOnce: #halt #halt: #hottest #printDirectlyToDisplay #toRemove #personal #urgent #haltOnce #haltOnce: #haltIf: ) + #(#doOnlyOnce: #halt #halt: #hottest #printDirectlyToDisplay #toRemove #personal #urgent #haltOnce #haltOnce: #haltIf: #haltIfNil #haltOnCount: #halt:onCount: #break ) do: [:aLit | (self hasLiteral: aLit) ifTrue: [^ true]]. #(#Transcript #AA #BB #CC #DD #EE ) do: [:aSymbol | | assoc | (assoc := Smalltalk globals associationAt: aSymbol ifAbsent: []) ifNotNil: [(self hasLiteral: assoc) ifTrue: [^ true]]]. ^ false MCChangeSelector>>select {actions} · ct 1/15/2022 22:46 (changed) select + + (Preferences checkForSlips ==> [self lookForSlips]) ifFalse: [^ self]. + self answer: (MCPatch operations: kept) MCDefinition>>hasReportableSlip {testing} · ct 1/15/2022 22:49 + hasReportableSlip + + ^ false MCMethodDefinition (changed) MCDefinition subclass: #MCMethodDefinition - instanceVariableNames: 'classIsMeta source category selector className timeStamp' + instanceVariableNames: 'classIsMeta source category selector className timeStamp hasReportableSlip' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Modeling' MCMethodDefinition class instanceVariableNames: 'definitions' "" MCMethodDefinition class>>forMethodReference: {create} · ct 1/15/2022 22:53 (changed) forMethodReference: aMethodReference | definition | definition := self cachedDefinitions at: aMethodReference compiledMethod ifAbsent: []. (definition isNil or: [definition selector ~= aMethodReference methodSymbol or: [definition className ~= aMethodReference classSymbol or: [definition classIsMeta ~= aMethodReference classIsMeta or: [definition category ~= aMethodReference category]]]]) ifTrue: [definition := self className: aMethodReference classSymbol classIsMeta: aMethodReference classIsMeta selector: aMethodReference methodSymbol category: aMethodReference category timeStamp: aMethodReference timeStamp source: aMethodReference source. + definition hasReportableSlip: aMethodReference compiledMethod hasReportableSlip. self cachedDefinitions at: aMethodReference compiledMethod put: definition]. ^ definition MCMethodDefinition>>hasReportableSlip {accessing} · ct 1/15/2022 22:54 + hasReportableSlip + + ^ hasReportableSlip ifNil: [false] MCMethodDefinition>>hasReportableSlip: {accessing} · ct 1/15/2022 22:53 + hasReportableSlip: aBoolean + + hasReportableSlip := aBoolean. MCPatchBrowser>>checkForSlips {actions} · ct 1/15/2022 23:12 + checkForSlips + + ^ self checkForSlipsIn: self items MCPatchBrowser>>checkForSlipsIn: {actions} · ct 1/15/2022 23:07 + checkForSlipsIn: patchItems + + ^ patchItems select: [:ea | ea hasReportableSlip] MCPatchBrowser>>lookForSlips {actions} · ct 1/15/2022 23:11 + lookForSlips + "Look for slips in all changes. If there are any, ask the user how to treat them. Answer true if the operation should go on, or false if it should be canceled." + + | slips | + slips := self checkForSlips ifEmpty: [^ true]. + (Project uiManager + chooseFromLabeledValues: (OrderedDictionary new + at: 'Browse slips' translated put: [self systemNavigation + browseMessageList: (slips collect: [:ea | ea definition asMethodReference]) + name: 'Possible slips in new version' translated]; + at: 'Ignore slips and continue' translated put: [^ true]; + at: 'Cancel' translated put: [^ false]; + yourself) + title: ('This patch contains {1} halts, Transcript sends, or other possible slips.\\Save the new version anyway?' withCRs translated format: {slips size})) value. + ^ false MCPatchBrowser>>methodListMenu: {menus} · ct 1/15/2022 23:01 + methodListMenu: aMenu + + super methodListMenu: aMenu. + + aMenu add: 'check for slips' translated help: 'Check all changes for possible slips such as forgotten breakpoints or logging statements.' translated action: #reportSlips. + + ^ aMenu MCPatchBrowser>>reportSlips {actions} · ct 1/15/2022 23:05 + reportSlips + "Look for slips in all changes and report to the user what was found." + + | slips | + slips := self checkForSlips ifEmpty: [^ self inform: 'There were no obvious slips in this patch' translated]. + self systemNavigation + browseMessageList: (slips collect: [:ea | ea definition asMethodReference]) + name: 'Possible slips in new version' translated. MCPatchOperation>>hasReportableSlip {testing} · ct 1/15/2022 22:49 + hasReportableSlip + + ^ self targetDefinition + ifNil: [false] + ifNotNil: [:def | def hasReportableSlip] MCSaveVersionDialog>>accept {actions} · ct 1/15/2022 23:06 (changed) accept | logMessage logMessageWidget | self updateItems. + + (Preferences checkForSlips ==> [self lookForSlips]) ifFalse: [^ self]. + logMessage := (logMessageWidget := self findTextMorph: #logMessage) text asString. (logMessage isEmpty or: [logMessage beginsWith: 'empty log message']) ifTrue: - [(UIManager confirm: 'the log message is empty; are you sure you want to commit') ifFalse: [^ self]] + [(self confirm: 'The log message is empty; are you sure you want to commit?' translated) ifFalse: [^ self]] ifFalse: [logMessageWidget accept]. + self answer: { (self findTextMorph: #versionName) text asString. logMessage. ignore } MCSaveVersionDialog>>checkForSlips {actions} · ct 1/15/2022 23:12 + checkForSlips + + ^ super checkForSlipsIn: (self items copyWithoutAll: self ignore) Preference>>helpString: {menu} · ct 1/16/2022 01:31 + helpString: aString + + helpString := aString --- Sent from Squeak Inbox Talk ["mcSlips.1.cs"] ["mcSlips.png"]

4 10

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

20 May '23

Christoph Thiede uploaded a new version of Morphic to project The Inbox: http://source.squeak.org/inbox/Morphic-ct.1641.mcz ==================== Summary ==================== Name: Morphic-ct.1641 Author: ct Time: 7 June 2020, 2:45:17.536284 pm UUID: b90e23e1-ce70-3d49-a8e4-f09af148ef97 Ancestors: Morphic-ct.1638 Refine #isHighFrequentEvent implementation for further event types. Fixes one possible cause of the "color depth = 0" bug. See http://forum.world.st/Image-not-startable-after-save-td5117084.html. Depends indeed on Morphic-ct.1638. =============== Diff against Morphic-ct.1638 =============== Item was added: + ----- Method: DropEvent>>isHighFrequentEvent (in category 'testing') ----- + isHighFrequentEvent + + ^ false! Item was added: + ----- Method: WindowEvent>>isHighFrequentEvent (in category 'testing') ----- + isHighFrequentEvent + + ^ (#(windowClose) includes: self type) not! Item was changed: ----- Method: WorldState>>doSafely:onErrorThat:setErrorFlag:ifFatal:afterErrorDo: (in category 'update cycle') ----- doSafely: aBlock onErrorThat: errorPredicate setErrorFlag: errorFlag ifFatal: fatalErrorBlock afterErrorDo: postErrorBlock "Evaluate aBlock and keep track of errors during morph invocations." | finished classesWithErrors | finished := false. classesWithErrors := IdentitySet new. [finished] whileFalse: [ [aBlock value. finished := true] on: Error, Halt, Warning do: [:ex | | err rcvr errCtxt errMorph | (errorPredicate cull: ex) ifFalse: [ex pass]. err := ex description. rcvr := ex receiver. errCtxt := thisContext. [ errCtxt := errCtxt sender. "Search the sender chain to find the morph causing the problem" [errCtxt notNil and: [(errCtxt receiver isMorph) not]] whileTrue: [errCtxt := errCtxt sender]. "If we're at the root of the context chain then we have a fatal problem" errCtxt ifNil: [^ fatalErrorBlock cull: err]. + errMorph := errCtxt receiver + ] doWhileTrue: [ - errMorph := errCtxt receiver. "If the morph causing the problem has already the error flag set, then search for the next morph above in the caller chain." errMorph hasProperty: errorFlag + ]. - ] whileTrue. errMorph setProperty: errorFlag toValue: true; changed. "Catch all errors, one for each receiver class." (classesWithErrors includes: rcvr class) ifFalse: [ classesWithErrors add: rcvr class. ToolSet debugException: ex]. postErrorBlock cull: err. ]].! Item was changed: ----- Method: WorldState>>processEventsSafely: (in category 'update cycle') ----- processEventsSafely: aHandMorph ^ self doSafely: [aHandMorph processEvents] + onErrorThat: [:error | self currentEvent ifNil: [true] ifNotNil: [:evt | evt isHighFrequentEvent]] - onErrorThat: [:error | ActiveEvent isNil or: [ActiveEvent isHighFrequentEvent]] setErrorFlag: #errorOnEvent ifFatal: [:error | Project current fatalEventHandlingError: error] afterErrorDo: []!

5 6

The Trunk: Network-ct.275.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.275.mcz ==================== Summary ==================== Name: Network-ct.275 Author: ct Time: 20 May 2023, 10:01:24.95456 pm UUID: 4c8b3eb6-9258-dc4d-9ae6-b85bb578816f Ancestors: Network-ct.274 Fixes sending/saving of base64-encoded documents. Unlike all other MimeConverters, Base64MimeConverter/RFC4648MimeConverter answers a Stream instead of a String. Unfortunately, expectations of senders are inconsistent as well... =============== Diff against Network-ct.274 =============== Item was changed: ----- Method: MIMEDocument>>asSendableBodyText (in category 'serializing') ----- asSendableBodyText | sendableBodyText | sendableBodyText := self isMultipart ifTrue: [self sendableMultipartBodyText] ifFalse: [(self isPlaintext or: [self isHTML]) ifTrue: [self class tryToEncodeBody: self contents as: self charset] ifFalse: [self contents]]. ^ (self hasFieldNamed: 'content-transfer-encoding') ifFalse: [sendableBodyText] ifTrue: [ | transferEncoding | transferEncoding := self contentTransferEncoding. + ((MimeConverter forEncoding: transferEncoding) mimeEncode: sendableBodyText readStream) contents ] ! - (MimeConverter forEncoding: transferEncoding) mimeEncode: sendableBodyText readStream ] !

1 0

The Trunk: Network-ct.274.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.274.mcz ==================== Summary ==================== Name: Network-ct.274 Author: ct Time: 20 May 2023, 9:57:37.37056 pm UUID: ec1f495a-41ef-af4c-bc0b-6d00e533396e Ancestors: Network-ct.273 Removes obsolete instvars from MIMEDocument. =============== Diff against Network-ct.273 =============== Item was changed: Object subclass: #MIMEDocument + instanceVariableNames: 'content fields url parts' - instanceVariableNames: 'mainType subType content fields url parts' classVariableNames: 'MIMEdatabase' poolDictionaries: '' category: 'Network-MIME'! !MIMEDocument commentStamp: 'pre 7/6/2017 13:58' prior: 0! a MIME object, along with its type and the URL it was found at (if any) Design decisions: - The API for using the content of the MIME object inside Squeak returns Strings in Squeak encoding. The serializing methods return the content serialized according to the content-type and content-transfer-encoding --pre!

1 0

The Trunk: Network-ct.273.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.273.mcz ==================== Summary ==================== Name: Network-ct.273 Author: ct Time: 20 May 2023, 9:40:56.35156 pm UUID: 3dd4f9f6-a5d8-7741-a80b-0e502def6970 Ancestors: Network-ct.272 Adds file services for viewing and exploring mail messages from EML files. =============== Diff against Network-ct.272 =============== Item was added: + ----- Method: MailMessage class>>exploreFromFileNamed: (in category 'file services') ----- + exploreFromFileNamed: fileName + + ^ (self fromFileNamed: fileName) explore! Item was added: + ----- Method: MailMessage class>>fileReaderServicesForFile:suffix: (in category 'file services') ----- + fileReaderServicesForFile: fullName suffix: suffix + + ^ suffix = 'eml' + ifTrue: [self services] + ifFalse: [#()]! Item was added: + ----- Method: MailMessage class>>fromFileNamed: (in category 'instance creation') ----- + fromFileNamed: fileName + + | contents | + contents := FileStream readOnlyFileNamed: fileName do: [:stream | + stream contents]. + ^ self from: contents! Item was added: + ----- Method: MailMessage class>>initialize (in category 'class initialization') ----- + initialize + + FileServices registerFileReader: self.! Item was added: + ----- Method: MailMessage class>>readFromFileNamed: (in category 'file services') ----- + readFromFileNamed: fileName + + ^ (self fromFileNamed: fileName) formattedText edit! Item was added: + ----- Method: MailMessage class>>serviceExploreMessage (in category 'file services') ----- + serviceExploreMessage + + ^ SimpleServiceEntry + provider: self + label: 'explore mail message' translated + selector: #exploreFromFileNamed: + description: 'open a mail message in an explorer' translated + buttonLabel: 'explore mail message' translated! Item was added: + ----- Method: MailMessage class>>serviceViewMessage (in category 'file services') ----- + serviceViewMessage + + ^ SimpleServiceEntry + provider: self + label: 'view mail message' translated + selector: #viewFromFileNamed: + description: 'view contents of the mail message' translated + buttonLabel: 'view mail message' translated! Item was added: + ----- Method: MailMessage class>>services (in category 'file services') ----- + services + + ^ {self serviceViewMessage. self serviceExploreMessage}! Item was added: + ----- Method: MailMessage class>>unload (in category 'class initialization') ----- + unload + + FileServices unregisterFileReader: self.! Item was added: + ----- Method: MailMessage class>>viewFromFileNamed: (in category 'file services') ----- + viewFromFileNamed: fileName + + ^ (self fromFileNamed: fileName) view!

2 1

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

20 May '23

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

1 0

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

20 May '23

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

1 0

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

20 May '23

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

1 0

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

20 May '23

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

1 0

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