Squeak-dev November 2017

squeak-dev@lists.squeakfoundation.org

38 participants
198 discussions

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

02 Dec '17

Patrick Rein uploaded a new version of Network to project The Trunk: http://source.squeak.org/trunk/Network-pre.207.mcz ==================== Summary ==================== Name: Network-pre.207 Author: pre Time: 10 November 2017, 4:40:14.388812 pm UUID: 85f492c1-3470-bb43-afe5-bea036995824 Ancestors: Network-pre.206 A new MailComposition window allowing a more structured access to the underlying mail message. =============== Diff against Network-pre.206 =============== Item was changed: Model subclass: #MailComposition + instanceVariableNames: 'mailMessage' - instanceVariableNames: 'messageText textEditor morphicWindow mvcWindow' classVariableNames: '' poolDictionaries: '' category: 'Network-MailSending'! + !MailComposition commentStamp: 'pre 5/16/2017 20:00' prior: 0! + a message being composed in a fancy way. The mail is send via the registered MailSender by default. Fields do not have to be saved, they are saved automatically on send. ! - !MailComposition commentStamp: '<historical>' prior: 0! - a message being composed. When finished, it will be submitted via a Celeste.! Item was changed: + ----- Method: MailComposition class>>initialize (in category 'class initialization') ----- - ----- Method: MailComposition class>>initialize (in category 'instance creation') ----- initialize + + MailSender register: self ! - super initialize. - MailSender register: self.! Item was added: + ----- Method: MailComposition class>>open (in category 'opening') ----- + open + + ^ ToolBuilder default open: self! Item was added: + ----- Method: MailComposition class>>openOn: (in category 'opening') ----- + openOn: aMessage + + ^ ToolBuilder default open: (self new on: aMessage; yourself)! Item was changed: + ----- Method: MailComposition class>>sendMailMessage: (in category 'MailSender interface') ----- + sendMailMessage: aMessage + + self openOn: aMessage! - ----- Method: MailComposition class>>sendMailMessage: (in category 'instance creation') ----- - sendMailMessage: aMailMessage - | newComposition | - newComposition := self new. - newComposition messageText: aMailMessage text; open! Item was changed: + ----- Method: MailComposition class>>unload (in category 'initialize-release') ----- - ----- Method: MailComposition class>>unload (in category 'instance creation') ----- unload MailSender unregister: self ! Item was added: + ----- Method: MailComposition>>addAttachment (in category 'actions') ----- + addAttachment + | file fileResult fileName | + + self saveFields. + + (fileResult := StandardFileMenu oldFile) + ifNotNil: + [fileName := fileResult directory fullNameFor: fileResult name. + file := FileStream readOnlyFileNamed: fileName. + file ifNotNil: + [file binary. + mailMessage addAttachmentFrom: file withName: fileResult name. + file close. + self changed: #messageText]] ! Item was added: + ----- Method: MailComposition>>addAttachmentButtonLabel (in category 'ui constants') ----- + addAttachmentButtonLabel + + ^ 'add attachment' translated! Item was added: + ----- Method: MailComposition>>bccLabel (in category 'ui constants') ----- + bccLabel + + ^ 'BCC' translated! Item was added: + ----- Method: MailComposition>>buildButtonBarSpecWith: (in category 'toolbuilder') ----- + buildButtonBarSpecWith: aBuilder + + | buttonBarSpec | + buttonBarSpec := aBuilder pluggablePanelSpec new + children: OrderedCollection new; + layout: #horizontal; + frame: (LayoutFrame new + leftFraction: 0 offset: 0; + topFraction: 0 offset: 0; + rightFraction: 1 offset: 0; + bottomFraction: 0 offset: self buttonBarHeight); + yourself. + + buttonBarSpec children add: (aBuilder pluggableButtonSpec new + model: self; + action: #sendMail; + label: #sendMailButtonLabel; + yourself). + + buttonBarSpec children add: (aBuilder pluggableButtonSpec new + model: self; + action: #addAttachment; + label: #addAttachmentButtonLabel; + yourself). + + buttonBarSpec children add: (aBuilder pluggableButtonSpec new + model: self; + action: #removeAttachment; + label: #removeAttachmentButtonLabel; + yourself). + + ^ buttonBarSpec! Item was added: + ----- Method: MailComposition>>buildWith: (in category 'toolbuilder') ----- + buildWith: aBuilder + + | windowSpec detailsPanelSpec textSpec | + + windowSpec := aBuilder pluggableWindowSpec new + model: self; + label: self dialogTitle; + children: OrderedCollection new. + + windowSpec children add: (self buildButtonBarSpecWith: aBuilder). + + detailsPanelSpec := aBuilder pluggablePanelSpec new + children: OrderedCollection new; + layout: #vertical; + yourself. + windowSpec children add: detailsPanelSpec. + + self createDetailsFieldsIn: detailsPanelSpec by: aBuilder. + + detailsPanelSpec children: detailsPanelSpec children reversed. + detailsPanelSpec frame: (LayoutFrame new + leftFraction: 0 offset: 0; + topFraction: 0 offset: self buttonBarHeight; + rightFraction: 1 offset: 0; + bottomFraction: 0 offset: self buttonBarHeight + (detailsPanelSpec children size * self lineHeight)). + + textSpec := aBuilder pluggableTextSpec new + model: self; + indicateUnacceptedChanges: true; + getText: #messageText; + setText: #messageText:; + frame: (LayoutFrame new + leftFraction: 0 offset: 0; + topFraction: 0 offset: self buttonBarHeight + (detailsPanelSpec children size * self lineHeight); + rightFraction: 1 offset: 0; + bottomFraction: 1 offset: 0); + yourself. + windowSpec children add: textSpec. + + ^ aBuilder build: windowSpec! Item was added: + ----- Method: MailComposition>>buttonBarHeight (in category 'ui constants') ----- + buttonBarHeight + + ^ 25 "pixel"! Item was added: + ----- Method: MailComposition>>ccLabel (in category 'ui constants') ----- + ccLabel + + ^ 'CC' translated! Item was added: + ----- Method: MailComposition>>createDetailsFieldsIn:by: (in category 'toolbuilder') ----- + createDetailsFieldsIn: detailsPanelSpec by: aBuilder + + #((senderLabel messageSender messageSender:) + (recipientLabel messageRecipient messageRecipient:) + (ccLabel messageCC messageCC:) + (bccLabel messageBCC messageBCC:) + (subjectLabel messageSubject messageSubject:)) + do: [:config | detailsPanelSpec children add: + (self createFieldInputNamed: config first + getter: config second + setter: config third + with: aBuilder)] + ! Item was added: + ----- Method: MailComposition>>createFieldInputNamed:getter:setter:with: (in category 'toolbuilder') ----- + createFieldInputNamed: fieldLabelGetter getter: fieldGetter setter: fieldSetter with: aBuilder + + ^ aBuilder pluggableInputFieldSpec new + model: self; + indicateUnacceptedChanges: false; + getText: fieldGetter; + setText: fieldSetter; + frame: (LayoutFrame new + leftFraction: 0 offset: 0; + topFraction: 0 offset: 0; + rightFraction: 1 offset: 0; + bottomFraction: 0 offset: self lineHeight); + help: fieldLabelGetter; + yourself! Item was added: + ----- Method: MailComposition>>dialogTitle (in category 'toolbuilder') ----- + dialogTitle + + ^ 'mail editor' translated! Item was added: + ----- Method: MailComposition>>doSendMail (in category 'private') ----- + doSendMail + + (SMTPClient openOnHostNamed: self smtpServer port: self smtpServerPort) + user: self smtpUser; + password: self smtpPassword; + login; + mailFrom: mailMessage from to: (mailMessage to findTokens: ',') text: mailMessage asSendableText.! Item was added: + ----- Method: MailComposition>>initialize (in category 'initialize-release') ----- + initialize + + mailMessage := MailMessage empty! Item was added: + ----- Method: MailComposition>>lineHeight (in category 'ui constants') ----- + lineHeight + + ^ 25 "pixel"! Item was added: + ----- Method: MailComposition>>messageBCC (in category 'access to mail object') ----- + messageBCC + + ^ mailMessage bcc! Item was added: + ----- Method: MailComposition>>messageBCC: (in category 'access to mail object') ----- + messageBCC: emailAddresses + + self flag: #TODO. "add validation" + mailMessage bcc: emailAddresses asString. + ^ true! Item was added: + ----- Method: MailComposition>>messageCC (in category 'access to mail object') ----- + messageCC + + ^ mailMessage cc! Item was added: + ----- Method: MailComposition>>messageCC: (in category 'access to mail object') ----- + messageCC: emailAddresses + + self flag: #TODO. "add validation" + mailMessage cc: emailAddresses asString. + ^ true! Item was added: + ----- Method: MailComposition>>messageRecipient (in category 'access to mail object') ----- + messageRecipient + + ^ mailMessage to! Item was added: + ----- Method: MailComposition>>messageRecipient: (in category 'access to mail object') ----- + messageRecipient: emailAddresses + + self flag: #TODO. "add validation" + mailMessage to: emailAddresses asString. + ^ true! Item was added: + ----- Method: MailComposition>>messageSender (in category 'access to mail object') ----- + messageSender + + ^ mailMessage from! Item was added: + ----- Method: MailComposition>>messageSender: (in category 'access to mail object') ----- + messageSender: emailAddress + + self flag: #TODO. "add validation" + mailMessage from: emailAddress asString. + ^ true! Item was added: + ----- Method: MailComposition>>messageSubject (in category 'access to mail object') ----- + messageSubject + + ^ mailMessage subject! Item was added: + ----- Method: MailComposition>>messageSubject: (in category 'access to mail object') ----- + messageSubject: aSubject + + self flag: #TODO. "add validation" + mailMessage subject: aSubject asString. + ^ true! Item was changed: + ----- Method: MailComposition>>messageText (in category 'access to mail object') ----- - ----- Method: MailComposition>>messageText (in category 'access') ----- messageText + + ^ mailMessage bodyTextFormatted! - "return the current text" - ^messageText. - ! Item was changed: + ----- Method: MailComposition>>messageText: (in category 'access to mail object') ----- - ----- Method: MailComposition>>messageText: (in category 'access') ----- messageText: aText + + mailMessage body: ((MIMEDocument + contentType: MIMEDocument contentTypePlainText + content: aText asString) + charset: 'UTF-8'; + yourself). + ^ true! - "change the current text" - messageText := aText. - self changed: #messageText. - ^true! Item was added: + ----- Method: MailComposition>>on: (in category 'initialize-release') ----- + on: aMessage + + mailMessage := aMessage! Item was added: + ----- Method: MailComposition>>recipientLabel (in category 'ui constants') ----- + recipientLabel + + ^ 'Recipients' translated! Item was added: + ----- Method: MailComposition>>removeAttachment (in category 'actions') ----- + removeAttachment + + | attachmentToBeRemoved | + + self saveFields. + attachmentToBeRemoved := UIManager default + chooseFrom: (mailMessage attachments collect: [:m | m attachmentFileName ]) + values: mailMessage attachments + title: 'Choose attachment to be removed' translated. + mailMessage removeAttachment: attachmentToBeRemoved. + self changed: #messageText.! Item was added: + ----- Method: MailComposition>>removeAttachmentButtonLabel (in category 'ui constants') ----- + removeAttachmentButtonLabel + + ^ 'remove attachment' translated! Item was added: + ----- Method: MailComposition>>saveFields (in category 'private') ----- + saveFields + + (self dependents select: [:d | d hasUnacceptedEdits]) do: [:d | d accept].! Item was added: + ----- Method: MailComposition>>sendMail (in category 'actions') ----- + sendMail + + self saveFields. + + [self doSendMail. + Project current addDeferredUIMessage: [self changed: #close]] + forkAt: 30! Item was added: + ----- Method: MailComposition>>sendMailButtonLabel (in category 'ui constants') ----- + sendMailButtonLabel + + ^ 'send mail' translated! Item was added: + ----- Method: MailComposition>>senderLabel (in category 'ui constants') ----- + senderLabel + + ^ 'Sender' translated! Item was added: + ----- Method: MailComposition>>smtpPassword (in category 'MailSender interface') ----- + smtpPassword + + ^ MailSender userPassword! Item was changed: + ----- Method: MailComposition>>smtpServer (in category 'MailSender interface') ----- - ----- Method: MailComposition>>smtpServer (in category 'access') ----- smtpServer + + ^ MailSender smtpServer! - ^MailSender smtpServer! Item was added: + ----- Method: MailComposition>>smtpServerPort (in category 'MailSender interface') ----- + smtpServerPort + + ^ MailSender smtpServerPort! Item was added: + ----- Method: MailComposition>>smtpUser (in category 'MailSender interface') ----- + smtpUser + + ^ MailSender userName! Item was added: + ----- Method: MailComposition>>subjectLabel (in category 'ui constants') ----- + subjectLabel + + ^ 'Subject' translated!

2 2

The Trunk: CollectionsTests-nice.285.mcz
by commits＠source.squeak.org 01 Dec '17

01 Dec '17

Nicolas Cellier uploaded a new version of CollectionsTests to project The Trunk: http://source.squeak.org/trunk/CollectionsTests-nice.285.mcz ==================== Summary ==================== Name: CollectionsTests-nice.285 Author: nice Time: 30 November 2017, 9:25:14.59936 pm UUID: e50f181d-41a8-428f-ba63-b370998aac7d Ancestors: CollectionsTests-nice.284 Tests for (Wide)CharacterSet(Complement) - add tests for intersection: and union: - don't (ab)use should: when assert: could do it - add tests for awfully broken complement select:/reject: =============== Diff against CollectionsTests-nice.284 =============== Item was added: + ----- Method: CharacterSetComplementTest>>testIncludes (in category 'testing') ----- + testIncludes + | set complement | + set := 'abc' as: CharacterSet. + complement := set complement. + self assert: (set noneSatisfy: [:e | complement includes: e]). + self assert: (($d to: $z) allSatisfy: [:e | complement includes: e]).! Item was added: + ----- Method: CharacterSetComplementTest>>testReject (in category 'testing') ----- + testReject + | set complement subset | + set := 'abc' as: CharacterSet. + complement := set complement. + subset := complement reject: [:c | c isVowel]. + self assert: (subset includes: $z). "Not a vowel, it is in the subset" + self deny: (subset includes: $e). "a vowel should be rejected" + self deny: (subset includes: $b). "Not a vowel, but not in the original set"! Item was added: + ----- Method: CharacterSetComplementTest>>testSelect (in category 'testing') ----- + testSelect + | set complement digits | + set := 'abc012' as: CharacterSet. + complement := set complement. + digits := complement select: [:c | c isDigit]. + self assert: (digits includes: $9). + self deny: (digits includes: $1). + self deny: (digits includes: $z).! Item was added: + ----- Method: CharacterSetTest>>testComplement (in category 'testing') ----- + testComplement + | set complement | + set := 'abc' as: CharacterSet. + complement := set complement. + self assert: (set noneSatisfy: [:e | complement includes: e]). + self assert: (($d to: $z) allSatisfy: [:e | complement includes: e]).! Item was changed: ----- Method: CharacterSetTest>>testCopy (in category 'testing') ----- testCopy | theOriginal theCopy | theOriginal := CharacterSet newFrom: 'abc'. theCopy := theOriginal copy. theCopy remove: $a. + ^self assert: (theOriginal includes: $a) description: 'Changing the copy should not change the original'.! - ^self should: [theOriginal includes: $a] description: 'Changing the copy should not change the original'.! Item was added: + ----- Method: CharacterSetTest>>testIncludes (in category 'testing') ----- + testIncludes + | set | + set := 'abc' as: CharacterSet. + self assert: (($a to: $c) allSatisfy: [:e | set includes: e]). + self assert: (($d to: $z) noneSatisfy: [:e | set includes: e]).! Item was added: + ----- Method: CharacterSetTest>>testIntersection (in category 'testing') ----- + testIntersection + | intersection | + intersection := ('abc' as: CharacterSet) intersection: ('bcde' as: CharacterSet). + self assert: intersection = ('bc' as: CharacterSet)! Item was added: + ----- Method: CharacterSetTest>>testIntersectionWithComplement (in category 'testing') ----- + testIntersectionWithComplement + | intersection intersection2 | + intersection := ('abcd' as: CharacterSet) intersection: ('cdef' as: CharacterSet) complement. + self assert: intersection = ('ab' as: CharacterSet). + intersection2 := ('cdef' as: CharacterSet) complement intersection: ('abcd' as: CharacterSet). + self assert: intersection2 = intersection. "Intersection is symmetric"! Item was added: + ----- Method: CharacterSetTest>>testUnion (in category 'testing') ----- + testUnion + | union | + union := ('abc' as: CharacterSet) union: ('bcde' as: CharacterSet). + self assert: union = ('abcde' as: CharacterSet)! Item was added: + ----- Method: CharacterSetTest>>testUnionWithComplement (in category 'testing') ----- + testUnionWithComplement + | union union2 | + union := ('abc' as: CharacterSet) union: ('bcde' as: CharacterSet) complement. + self assert: union = ('de' as: CharacterSet) complement. + union2 := ('bcde' as: CharacterSet) complement union: ('abc' as: CharacterSet). + self assert: union2 = union. "union is symmetric"! Item was changed: ----- Method: WideCharacterSetTest>>testAddingToCharacterSet (in category 'testing') ----- testAddingToCharacterSet | cs wcs wc | cs := CharacterSet newFrom: 'aeiouy'. wcs := cs copy. wc := 4452 asCharacter. self shouldnt: [wcs add: wc] raise: Error description: 'adding a WideCharacter to an ordinary CharacterSet should turn it into a WideCharacterSet'. + self assert: (wcs size = (cs size + 1)) description: 'We just added a Character, size should be increased by one'. + self deny: (wcs = cs) description: 'We just added a Character, sets should not be equal'. + self deny: (cs = wcs) description: 'We just added a Character, sets should not be equal'. + self assert: (cs allSatisfy: [:char | wcs includes: char]) description: 'Each character of the original CharacterSet should be included in the WideCharacterSet'. + self assert: (wcs hasWideCharacters) description: 'We just added a WideCharacter, so this WideCharacterSet definitely has one'. + self assert: (wcs includes: wc) description: 'We just added this WideCharacter, so this WideCharacterSet should include it'. - self should: [wcs size = (cs size + 1)] description: 'We just added a Character, size should be increased by one'. - self shouldnt: [wcs = cs] description: 'We just added a Character, sets should not be equal'. - self shouldnt: [cs = wcs] description: 'We just added a Character, sets should not be equal'. - self should: [cs allSatisfy: [:char | wcs includes: char]] description: 'Each character of the original CharacterSet should be included in the WideCharacterSet'. - self should: [wcs hasWideCharacters] description: 'We just added a WideCharacter, so this WideCharacterSet definitely has one'. - self should: [wcs includes: wc] description: 'We just added this WideCharacter, so this WideCharacterSet should include it'. wcs add: wc. + self assert: (wcs size = (cs size + 1)) description: 'We just added a Character already included in the set, size should be unchanged'. - self should: [wcs size = (cs size + 1)] description: 'We just added a Character already included in the set, size should be unchanged'. wcs remove: wc. + self assert: (wcs size = cs size) description: 'We added then removed a Character, now size should be equal to original'. + self deny: (wcs hasWideCharacters) description: 'We just removed the only WideCharacter, so this WideCharacterSet definitely has no WideCharacter'. - self should: [wcs size = cs size] description: 'We added then removed a Character, now size should be equal to original'. - self shouldnt: [wcs hasWideCharacters] description: 'We just removed the only WideCharacter, so this WideCharacterSet definitely has no WideCharacter'. + self assert: (wcs = cs) description: 'A WideCharacterSet can be equal to an Ordinary CharacterSet'. + self assert: (cs = wcs) description: 'An ordinary CharacterSet can be equal to a WideCharacterSet'. + self assert: (cs hash = wcs hash) description: 'If some objects are equal, then they should have same hash code'. - self should: [wcs = cs] description: 'A WideCharacterSet can be equal to an Ordinary CharacterSet'. - self should: [cs = wcs] description: 'An ordinary CharacterSet can be equal to a WideCharacterSet'. - self should: [cs hash = wcs hash] description: 'If some objects are equal, then they should have same hash code'. ! Item was changed: ----- Method: WideCharacterSetTest>>testCreation (in category 'testing') ----- testCreation "By now, only creation method is newFrom:" | cs1 wcs1 cs2 wcs2 byteString wideString | byteString := 'aeiouy'. wideString := 'aeiouy' copyWith: 340 asCharacter. cs1 := CharacterSet newFrom: byteString. wcs1 := WideCharacterSet newFrom: byteString. + self assert: (wcs1 = cs1). + self assert: (wcs1 size = byteString "asSet" size). - self should: [wcs1 = cs1]. - self should: [wcs1 size = byteString "asSet" size]. cs2 := CharacterSet newFrom: wideString. wcs2 := WideCharacterSet newFrom: wideString. + self assert: (wcs2 = cs2). + self assert: (wcs2 size = wideString "asSet" size). - self should: [wcs2 = cs2]. - self should: [wcs2 size = wideString "asSet" size]. + self assert: ((byteString indexOfAnyOf: wcs1) = 1) description: 'This should used optimized byteArrayMap method'. + self assert: ((byteString indexOfAnyOf: wcs2) = 1) description: 'This should used optimized byteArrayMap method'. - self should: [(byteString indexOfAnyOf: wcs1) = 1] description: 'This should used optimized byteArrayMap method'. - self should: [(byteString indexOfAnyOf: wcs2) = 1] description: 'This should used optimized byteArrayMap method'. + self assert: (('bcd' indexOfAnyOf: wcs1) = 0) description: 'This should used optimized byteArrayMap method'. + self assert: (('bcd' indexOfAnyOf: wcs2) = 0) description: 'This should used optimized byteArrayMap method'.! - self should: [('bcd' indexOfAnyOf: wcs1) = 0] description: 'This should used optimized byteArrayMap method'. - self should: [('bcd' indexOfAnyOf: wcs2) = 0] description: 'This should used optimized byteArrayMap method'.!

3 3

Is SyntaxMorph important?
by David T. Lewis 01 Dec '17

01 Dec '17

SyntaxMorph is in the Etoys package, but is missing the asMorphicSyntaxIn: methods that are needed in the ParseNode hierarchy. I tried importing the missing methods from an Etoys development image, which is sufficient to make SyntaxMorph class>>test work. But SyntaxMorph class>>testAll runs into problems, so I am expecting that the various compiler and Spur enhancements in recent years mean that some work would need to be done in this area. I am inclined to commit the current (old) version the missing methods to the Etoys package, but I do not want to do that if they were intentionally removed or if someone has a plan to provide a fully working update. Dave

4 7

The Trunk: MorphicExtras-nice.218.mcz
by commits＠source.squeak.org 30 Nov '17

30 Nov '17

Nicolas Cellier uploaded a new version of MorphicExtras to project The Trunk: http://source.squeak.org/trunk/MorphicExtras-nice.218.mcz ==================== Summary ==================== Name: MorphicExtras-nice.218 Author: nice Time: 26 November 2017, 11:17:28.596315 pm UUID: c781b24f-85b2-4fca-941a-dd8c2852a640 Ancestors: MorphicExtras-dtl.217 Change fancy categorization of FancyMailComposition methods. My arbitrary categorization might be less than perfect, but at least this makes testNoSpecialCategories pass. =============== Diff against MorphicExtras-dtl.217 =============== Item was changed: + ----- Method: FancyMailComposition>>addAttachment (in category 'actions') ----- - ----- Method: FancyMailComposition>>addAttachment (in category '-- all --') ----- addAttachment | file fileResult fileName | textEditor ifNotNil: [self hasUnacceptedEdits ifTrue: [textEditor accept]]. (fileResult := StandardFileMenu oldFile) ifNotNil: [fileName := fileResult directory fullNameFor: fileResult name. file := FileStream readOnlyFileNamed: fileName. file ifNotNil: [file binary. self messageText: ((MailMessage from: self messageText asString) addAttachmentFrom: file withName: fileResult name; text). file close]] ! Item was changed: + ----- Method: FancyMailComposition>>breakLines:atWidth: (in category 'private') ----- - ----- Method: FancyMailComposition>>breakLines:atWidth: (in category '-- all --') ----- breakLines: aString atWidth: width "break lines in the given string into shorter lines" | result atAttachment | result := WriteStream on: (String new: (aString size * 50 // 49)). atAttachment := false. aString asString linesDo: [ :line | | start end | (line beginsWith: '====') ifTrue: [ atAttachment := true ]. atAttachment ifTrue: [ "at or after an attachment line; no more wrapping for the rest of the message" result nextPutAll: line. result cr ] ifFalse: [ (line beginsWith: '>') ifTrue: [ "it's quoted text; don't wrap it" result nextPutAll: line. result cr. ] ifFalse: [ "regular old line. Wrap it to multiple lines" start := 1. "output one shorter line each time through this loop" [ start + width <= line size ] whileTrue: [ "find the end of the line" end := start + width - 1. [end >= start and: [ (line at: (end+1)) isSeparator not ]] whileTrue: [ end := end - 1 ]. end < start ifTrue: [ "a word spans the entire width!!" end := start + width - 1 ]. "copy the line to the output" result nextPutAll: (line copyFrom: start to: end). result cr. "get ready for next iteration" start := end+1. (line at: start) isSeparator ifTrue: [ start := start + 1 ]. ]. "write out the final part of the line" result nextPutAll: (line copyFrom: start to: line size). result cr. ]. ]. ]. ^result contents! Item was changed: + ----- Method: FancyMailComposition>>breakLinesInMessage: (in category 'private') ----- - ----- Method: FancyMailComposition>>breakLinesInMessage: (in category '-- all --') ----- breakLinesInMessage: message "reformat long lines in the specified message into shorter ones" self flag: #TODO. "Maybe deprecated" message body mainType = 'text' ifTrue: [ "it's a single-part text message. reformat the text" | newBodyText | newBodyText := self breakLines: message bodyText atWidth: 72. message body: (MIMEDocument contentType: message body contentType content: newBodyText). ^self ]. message body isMultipart ifTrue: [ "multipart message; process the top-level parts. HACK: the parts are modified in place" message parts do: [ :part | part body mainType = 'text' ifTrue: [ | newBodyText | newBodyText := self breakLines: part bodyText atWidth: 72. part body: (MIMEDocument contentType: part body contentType content: newBodyText) ] ]. message regenerateBodyFromParts. ].! Item was changed: + ----- Method: FancyMailComposition>>menuGet:shifted: (in category 'interface') ----- - ----- Method: FancyMailComposition>>menuGet:shifted: (in category '-- all --') ----- menuGet: aMenu shifted: shifted aMenu addList: { {'find...(f)' translated. #find}. {'find selection again (g)' translated. #findAgain}. #-. {'accept (s)' translated. #accept}. {'send message' translated. #submit}}. ^aMenu.! Item was changed: + ----- Method: FancyMailComposition>>messageText (in category 'accessing') ----- - ----- Method: FancyMailComposition>>messageText (in category '-- all --') ----- messageText "return the current text" ^messageText. ! Item was changed: + ----- Method: FancyMailComposition>>messageText: (in category 'accessing') ----- - ----- Method: FancyMailComposition>>messageText: (in category '-- all --') ----- messageText: aText "change the current text" messageText := aText. self changed: #messageText. ^true! Item was changed: + ----- Method: FancyMailComposition>>morphicOpen (in category 'user interface') ----- - ----- Method: FancyMailComposition>>morphicOpen (in category '-- all --') ----- morphicOpen "open an interface for sending a mail message with the given initial text " | textMorph buttonsList sendButton attachmentButton | morphicWindow := SystemWindow labelled: 'Mister Postman'. morphicWindow model: self. textEditor := textMorph := PluggableTextMorph on: self text: #messageText accept: #messageText: readSelection: nil menu: #menuGet:shifted:. morphicWindow addMorph: textMorph frame: (0 @ 0.1 corner: 1 @ 1). buttonsList := AlignmentMorph newRow. sendButton := PluggableButtonMorph on: self getState: nil action: #submit. sendButton hResizing: #spaceFill; vResizing: #spaceFill; label: 'send message'; setBalloonText: 'Accept any unaccepted edits and add this to the queue of messages to be sent'; onColor: Color white offColor: Color white. buttonsList addMorphBack: sendButton. attachmentButton := PluggableButtonMorph on: self getState: nil action: #addAttachment. attachmentButton hResizing: #spaceFill; vResizing: #spaceFill; label: 'add attachment'; setBalloonText: 'Send a file with the message'; onColor: Color white offColor: Color white. buttonsList addMorphBack: attachmentButton. morphicWindow addMorph: buttonsList frame: (0 @ 0 extent: 1 @ 0.1). morphicWindow openInWorld! Item was changed: + ----- Method: FancyMailComposition>>mvcOpen (in category 'user interface') ----- - ----- Method: FancyMailComposition>>mvcOpen (in category '-- all --') ----- mvcOpen | textView sendButton | mvcWindow := StandardSystemView new label: 'Mister Postman'; minimumSize: 400@250; model: self. textView := PluggableTextView on: self text: #messageText accept: #messageText:. textEditor := textView controller. sendButton := PluggableButtonView on: self getState: nil action: #submit. sendButton label: 'Send'. sendButton borderWidth: 1. sendButton window: (1@1 extent: 398@38). mvcWindow addSubView: sendButton. textView window: (0@40 corner: 400@250). mvcWindow addSubView: textView below: sendButton. mvcWindow controller open. ! Item was changed: + ----- Method: FancyMailComposition>>open (in category 'user interface') ----- - ----- Method: FancyMailComposition>>open (in category '-- all --') ----- open "open an interface" ^ Project current dispatchTo: self addPrefixAndSend: #Open withArguments: {} ! Item was changed: + ----- Method: FancyMailComposition>>perform:orSendTo: (in category 'private') ----- - ----- Method: FancyMailComposition>>perform:orSendTo: (in category '-- all --') ----- perform: selector orSendTo: otherTarget (self respondsTo: selector) ifTrue: [^self perform: selector] ifFalse: [^otherTarget perform: selector] ! Item was changed: + ----- Method: FancyMailComposition>>sendMailMessage: (in category 'MailSender interface') ----- - ----- Method: FancyMailComposition>>sendMailMessage: (in category '-- all --') ----- sendMailMessage: aMailMessage self messageText: aMailMessage text! Item was changed: + ----- Method: FancyMailComposition>>smtpServer (in category 'MailSender interface') ----- - ----- Method: FancyMailComposition>>smtpServer (in category '-- all --') ----- smtpServer ^MailSender smtpServer! Item was changed: + ----- Method: FancyMailComposition>>subject (in category 'accessing') ----- - ----- Method: FancyMailComposition>>subject (in category 'access') ----- subject ^ subject ! Item was changed: + ----- Method: FancyMailComposition>>subject: (in category 'accessing') ----- - ----- Method: FancyMailComposition>>subject: (in category 'access') ----- subject: x subject := x. self changed: #subject. ^true! Item was changed: + ----- Method: FancyMailComposition>>to (in category 'accessing') ----- - ----- Method: FancyMailComposition>>to (in category 'access') ----- to ^to! Item was changed: + ----- Method: FancyMailComposition>>to: (in category 'accessing') ----- - ----- Method: FancyMailComposition>>to: (in category 'access') ----- to: x to := x. self changed: #to. ^true !

2 1

The Trunk: Collections-nice.774.mcz
by commits＠source.squeak.org 30 Nov '17

30 Nov '17

Nicolas Cellier uploaded a new version of Collections to project The Trunk: http://source.squeak.org/trunk/Collections-nice.774.mcz ==================== Summary ==================== Name: Collections-nice.774 Author: nice Time: 1 December 2017, 12:08:06.998278 am UUID: d8c8b26f-2bca-438d-9b75-b929e5290df3 Ancestors: Collections-nice.773 Fulfill gratuitous ANSI expectation about (1 to: 2) readStream contents class This will fix ReadStreamTest>>#testContents2 that I broke with my implementation of Interval>>copyFrom:to:. The expectation: either contents answers the interval itself (please tell me why a shallow copy would not be acceptable???) or it answers same class as select: (that would be the interval species). =============== Diff against Collections-nice.773 =============== Item was changed: ----- Method: Interval>>copyFrom:to: (in category 'copying') ----- copyFrom: startIndex to: stopIndex + (startIndex = 1 and: [stopIndex = self size]) ifTrue: [^self]. stopIndex < startIndex ifTrue: [^self copyEmpty]. ^(self at: startIndex) to: (self at: stopIndex) by: step!

1 0

The Trunk: Kernel-nice.1127.mcz
by commits＠source.squeak.org 30 Nov '17

30 Nov '17

Nicolas Cellier uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-nice.1127.mcz ==================== Summary ==================== Name: Kernel-nice.1127 Author: nice Time: 30 November 2017, 11:45:52.543057 pm UUID: 90232bfa-3c54-41a3-a2cc-bb18baf40ede Ancestors: Kernel-nice.1126 Object class initializedInstance shall not bark at me. =============== Diff against Kernel-nice.1126 =============== Item was added: + ----- Method: Metaclass>>initializedInstance (in category 'instance creation') ----- + initializedInstance + thisClass class == self ifFalse: [^self new]. + ^thisClass!

1 0

The Trunk: Balloon-nice.31.mcz
by commits＠source.squeak.org 30 Nov '17

30 Nov '17

Nicolas Cellier uploaded a new version of Balloon to project The Trunk: http://source.squeak.org/trunk/Balloon-nice.31.mcz ==================== Summary ==================== Name: Balloon-nice.31 Author: nice Time: 30 November 2017, 11:42:45.358651 pm UUID: 41218742-19bf-46c7-aa04-25c4775e4549 Ancestors: Balloon-ul.30 Fix ShortRunArray initializedInstance =============== Diff against Balloon-ul.30 =============== Item was changed: + ----- Method: InterpolatedGradientFillStyle>>computePixelRampOfSize: (in category 'private') ----- - ----- Method: InterpolatedGradientFillStyle>>computePixelRampOfSize: (in category 'as yet unclassified') ----- computePixelRampOfSize: length "Compute the pixel ramp in the receiver." | bits ramp lastColor lastIndex lastWord | ramp := colorRamp sorted:[:a1 :a2| a1 key < a2 key]. bits := Bitmap new: length. lastColor := ramp first value. lastWord := lastColor pixelWord32. lastIndex := 0. ramp do:[:assoc| | distance nextColor theta nextWord nextIndex step | nextIndex := (assoc key * length) rounded. nextColor := assoc value. nextWord := nextColor pixelWord32. distance := nextIndex - lastIndex. distance = 0 ifTrue: [distance := 1]. step := 1.0 / distance. theta := 0.0. lastIndex+1 to: nextIndex do: [:i| theta := theta + step. bits at: i put: (self interpolatedAlphaMix: theta of: lastWord and: nextWord)]. lastIndex := nextIndex. lastColor := nextColor. lastWord := nextWord]. lastIndex+1 to: length do: [:i| bits at: i put: lastWord]. ^bits! Item was changed: + ----- Method: InterpolatedGradientFillStyle>>interpolatedAlphaMix:of:and: (in category 'private') ----- - ----- Method: InterpolatedGradientFillStyle>>interpolatedAlphaMix:of:and: (in category 'as yet unclassified') ----- interpolatedAlphaMix: ratio of: rgba1 and: rgba2 "Answer a proper interpolated value between two RGBA color words. Theta is 0..1.." | a1 a2 ra ira rgb1 rgb2 alpha br1 br2 bg1 bg2 bb1 bb2 result | a1 := rgba1 bitShift: -24. a2 := rgba2 bitShift: -24. alpha := ratio * (a2 - a1) + a1. ra := ratio * alpha. ira := (1.0 - ratio) * alpha. rgb1 := rgba1 bitAnd: 16rFFFFFF. rgb2 := rgba2 bitAnd: 16rFFFFFF. br1 := (rgb1 bitAnd: 255). br2 := (rgb2 bitAnd: 255). bg1 := ((rgb1 bitShift: -8) bitAnd: 255). bg2 := ((rgb2 bitShift: -8) bitAnd: 255). bb1 := ((rgb1 bitShift: -16) bitAnd: 255). bb2 := ((rgb2 bitShift: -16) bitAnd: 255). result := (ra * br2 + (ira * br1)) rounded // 255. result := result bitOr: ((ra * bg2 + (ira * bg1)) rounded // 255 bitShift: 8). result := result bitOr: ((ra * bb2 + (ira * bb1)) rounded // 255 bitShift: 16). ^result bitOr: (alpha rounded bitShift: 24)! Item was added: + ----- Method: ShortRunArray class>>new (in category 'instance creation') ----- + new + ^self newFrom: #()!

1 0

The Trunk: Collections-nice.773.mcz
by commits＠source.squeak.org 30 Nov '17

30 Nov '17

Nicolas Cellier uploaded a new version of Collections to project The Trunk: http://source.squeak.org/trunk/Collections-nice.773.mcz ==================== Summary ==================== Name: Collections-nice.773 Author: nice Time: 30 November 2017, 11:32:28.759622 pm UUID: ada0362a-409d-4c86-8929-52acda17d6f8 Ancestors: Collections-nice.772 Let Collection withAllSubclasses someSatisfy: #isAbstract. That may help some initializedInstance. Provide a well behaved Interval initializedInstance. =============== Diff against Collections-nice.772 =============== Item was added: + ----- Method: AbstractCharacterSet class>>isAbstract (in category 'testing') ----- + isAbstract + ^self = AbstractCharacterSet! Item was added: + ----- Method: ArrayedCollection class>>isAbstract (in category 'testing') ----- + isAbstract + ^self = ArrayedCollection! Item was added: + ----- Method: Collection class>>isAbstract (in category 'testing') ----- + isAbstract + ^self = Collection! Item was added: + ----- Method: HashedCollection class>>isAbstract (in category 'testing') ----- + isAbstract + ^self = HashedCollection! Item was added: + ----- Method: Interval class>>initializedInstance (in category 'instance creation') ----- + initializedInstance + ^self newFrom: #()! Item was removed: - ----- Method: NonPointersOrderedCollection class>>initializedInstance (in category 'instance creation') ----- - initializedInstance - " There are no instances of me, just my subclasses " - ^ self ~~ NonPointersOrderedCollection ifTrue: [super initializedInstance] - ! Item was added: + ----- Method: NonPointersOrderedCollection class>>isAbstract (in category 'testing') ----- + isAbstract + ^self = NonPointersOrderedCollection! Item was added: + ----- Method: SequenceableCollection class>>isAbstract (in category 'testing') ----- + isAbstract + ^self = SequenceableCollection!

1 0

The Trunk: Kernel-nice.1126.mcz
by commits＠source.squeak.org 30 Nov '17

30 Nov '17

Nicolas Cellier uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-nice.1126.mcz ==================== Summary ==================== Name: Kernel-nice.1126 Author: nice Time: 30 November 2017, 11:19:00.113675 pm UUID: f617f2e1-6bc6-4db5-b53e-a6136a180c63 Ancestors: Kernel-pre.1125 Introduce Class>>isAbstract for use with initializedInstance. Abstract classes are not expected to have any initializedInstance and will answer nil instead. It is subclassResponsibility to declare if isAbstract, default is false, most classes are concrete. We do not try to be clever and scan all methods sending subclassResponsibility, because failing to fullfill some responsibility does not make a class abstract, it just makes it imperfect! Note that isAbstract may have other smart usage (maybe special presentation in the browser etc...) =============== Diff against Kernel-pre.1125 =============== Item was added: + ----- Method: Boolean class>>isAbstract (in category 'testing') ----- + isAbstract + ^self = Boolean! Item was added: + ----- Method: Class>>isAbstract (in category 'testing') ----- + isAbstract + "Answer true if I am to be considered an abstract class. + An abstract class shall better not be instantiated. + Or its instances may miss some important behavior. + Typically, a class with methods sending #subclassResponsibility might be considered abstract. + But we can't erect this as a general rule, it might be that the message is never sent. + By default, all classes are concrete, up to each one to declare itself abstract." + + ^false! Item was added: + ----- Method: CompiledCode class>>initializedInstance (in category 'instance creation') ----- + initializedInstance + "Don't even think of it. + This low level machinery is not for general use." + + ^nil! Item was changed: ----- Method: Object class>>initializedInstance (in category 'instance creation') ----- initializedInstance + self isAbstract ifTrue: [^nil]. ^ self new!

1 0

The Trunk: Collections-nice.772.mcz
by commits＠source.squeak.org 30 Nov '17

30 Nov '17

Nicolas Cellier uploaded a new version of Collections to project The Trunk: http://source.squeak.org/trunk/Collections-nice.772.mcz ==================== Summary ==================== Name: Collections-nice.772 Author: nice Time: 30 November 2017, 10:30:07.12046 pm UUID: e43714c3-3e4c-4502-bb00-75852da33184 Ancestors: Collections-nice.771 Fix the CharacterSet failures that I just created I would have sweared that I ran the tests... Not all the tests? Embarassing... =============== Diff against Collections-nice.771 =============== Item was changed: ----- Method: CharacterSet>>union: (in category 'enumerating') ----- union: aCollection - (self species = aCollection species or: [aCollection isString]) ifFalse: [^super union: aCollection]. aCollection class = CharacterSetComplement ifTrue: [^aCollection union: self]. + (self species = aCollection species or: [aCollection isString]) ifFalse: [^super union: aCollection]. ^self copy addAll: aCollection; yourself! Item was changed: ----- Method: LazyCharacterSet class>>including: (in category 'instance creation') ----- including: aBlock "Create the set of Character for which aBlock evaluates to true" + ^self new block: aBlock! - ^self class new block: aBlock! Item was changed: ----- Method: LazyCharacterSet>>block: (in category 'accessing') ----- block: aValuable "Set the block used to determine if I include a Character or not. aValuable is an object that shoud answer true or false when sent value:" byteArrayMapCache := nil. + block := aValuable! - ^block := aValuable!

1 0

Jump to page: