Packages October 2021

packages@lists.squeakfoundation.org

1 participants
36 discussions

The Trunk: MorphicExtras-ct.295.mcz
by commits＠source.squeak.org 07 Oct '21

07 Oct '21

Marcel Taeumel uploaded a new version of MorphicExtras to project The Trunk: http://source.squeak.org/trunk/MorphicExtras-ct.295.mcz ==================== Summary ==================== Name: MorphicExtras-ct.295 Author: ct Time: 17 April 2021, 7:09:30.182932 pm UUID: e1a46d30-9232-aa4e-a316-9aad80fa0978 Ancestors: MorphicExtras-eem.293 PianoKeyboardMorph: Don't play a sound when a menu is invoked. =============== Diff against MorphicExtras-eem.293 =============== Item was changed: ----- Method: PianoKeyboardMorph>>mouseDownPitch:event:noteMorph: (in category 'simple keyboard') ----- mouseDownPitch: midiKey event: event noteMorph: noteMorph | pitch | + event redButtonPressed ifFalse: [^ self]. event hand hasSubmorphs ifTrue: [^ self "no response if drag something over me"]. event hand mouseFocus ifNil: ["If dragged into me, then establish focus so I'll see moves" event hand newMouseFocus: noteMorph event: event]. noteMorph color: playingKeyColor. pitch := AbstractSound pitchForMIDIKey: midiKey + 23. soundPlaying ifNotNil: [soundPlaying stopGracefully]. soundPlaying := soundPrototype soundForPitch: pitch dur: 100.0 loudness: 0.3. SoundPlayer resumePlaying: soundPlaying quickStart: true. !

1 0

The Trunk: MorphicExtras-ct.299.mcz
by commits＠source.squeak.org 07 Oct '21

07 Oct '21

Marcel Taeumel uploaded a new version of MorphicExtras to project The Trunk: http://source.squeak.org/trunk/MorphicExtras-ct.299.mcz ==================== Summary ==================== Name: MorphicExtras-ct.299 Author: ct Time: 3 October 2021, 3:39:23.706874 pm UUID: 771933d3-7bec-9346-aa54-c4549fa6ae87 Ancestors: MorphicExtras-ul.298 Adds FrameRateMorph to the 'Tools' category of the parts bin. I seriously use this morph for performance measuring. =============== Diff against MorphicExtras-ul.298 =============== Item was changed: ----- Method: FrameRateMorph class>>descriptionForPartsBin (in category 'parts bin') ----- descriptionForPartsBin ^ self partName: 'FrameRate' translatedNoop + categories: {'Just for Fun' translatedNoop. 'Tools' translatedNoop} - categories: {'Just for Fun' translatedNoop} documentation: 'A readout that allows you to monitor the frame rate of your system' translatedNoop!

1 0

The Trunk: MorphicExtras-mt.300.mcz
by commits＠source.squeak.org 07 Oct '21

07 Oct '21

Marcel Taeumel uploaded a new version of MorphicExtras to project The Trunk: http://source.squeak.org/trunk/MorphicExtras-mt.300.mcz ==================== Summary ==================== Name: MorphicExtras-mt.300 Author: mt Time: 7 October 2021, 4:39:47.760277 pm UUID: 4bc12538-f6c7-3c40-af48-9d04c8993e16 Ancestors: MorphicExtras-ct.294, MorphicExtras-ct.295, MorphicExtras-ct.299 Merge. Merge. Merge. - Make proper use of DisplayScreen >>#restoreAfter: in SketchMorph examples. - PianoKeyboardMorph: Don't play a sound when a menu is invoked. - Adds FrameRateMorph to the 'Tools' category of the parts bin. I seriously use this morph for performance measuring. =============== Diff against MorphicExtras-eem.293 =============== Item was changed: ----- Method: FrameRateMorph class>>descriptionForPartsBin (in category 'parts bin') ----- descriptionForPartsBin ^ self partName: 'FrameRate' translatedNoop + categories: {'Just for Fun' translatedNoop. 'Tools' translatedNoop} - categories: {'Just for Fun' translatedNoop} documentation: 'A readout that allows you to monitor the frame rate of your system' translatedNoop! Item was added: + ----- Method: MovingEyeMorph class>>extraExampleSqueakGhostIsWatchingYou (in category 'examples') ----- + extraExampleSqueakGhostIsWatchingYou + "MovingEyeMorph extraExampleSqueakGhostIsWatchingYou openInHand" + + | logoMorph leftEye rightEye | + logoMorph := (Form squeakLogo collectColors: #negated) asMorph. + leftEye := (self color: Color white irisColor: Color black) + extent: logoMorph extent * (0.1 @ 0.15); + center: (logoMorph pointAtFraction: 0.39 @ 0.55); + yourself. + rightEye := (self color: Color white irisColor: Color black) + extent: logoMorph extent * (0.1 @ 0.15); + center: (logoMorph pointAtFraction: 0.59 @ 0.56); + yourself. + logoMorph addAllMorphs: {leftEye. rightEye}. + ^ logoMorph.! Item was changed: ----- Method: PianoKeyboardMorph>>mouseDownPitch:event:noteMorph: (in category 'simple keyboard') ----- mouseDownPitch: midiKey event: event noteMorph: noteMorph | pitch | + event redButtonPressed ifFalse: [^ self]. event hand hasSubmorphs ifTrue: [^ self "no response if drag something over me"]. event hand mouseFocus ifNil: ["If dragged into me, then establish focus so I'll see moves" event hand newMouseFocus: noteMorph event: event]. noteMorph color: playingKeyColor. pitch := AbstractSound pitchForMIDIKey: midiKey + 23. soundPlaying ifNotNil: [soundPlaying stopGracefully]. soundPlaying := soundPrototype soundForPitch: pitch dur: 100.0 loudness: 0.3. SoundPlayer resumePlaying: soundPlaying quickStart: true. ! Item was changed: ----- Method: PostscriptCanvas>>image:at:sourceRect:rule: (in category 'private') ----- image: form at: aPoint sourceRect: sourceRect rule: rule | aForm | self preserveStateDuring: [:inner | inner translate: aPoint + self origin. aForm := form depth <= 8 ifTrue: [form asFormOfDepth: 32] ifFalse: [form]. target write: ((aForm colorsUsed includes: Color transparent) ifTrue: [| top f2 c2 offset | "tfel: This was taken from SketchMorph, but is actually needed for all forms that use transparency" + offset := currentTransformation ifNil: [0@0] ifNotNil: [:t | t offset]. - offset := currentTransformation ifNil: [0@0] ifNotNilDo: [:t | t offset]. top := self topLevelMorph. f2 := Form extent: aForm extent depth: self depth. c2 := f2 getCanvas. c2 fillColor: Color white. c2 translateBy: offset - self origin - aPoint clippingTo: f2 boundingBox during: [:c | top fullDrawOn: c]. f2] ifFalse: [aForm])]. ! Item was changed: ----- Method: SketchMorph class>>extraExampleCook (in category '*MorphicExtras-examples') ----- extraExampleCook "SketchMorph extraExampleCook openInWorld" ^ (self withForm: Form extraCook) + addMouseUpActionWith: 'Display restoreAfter: [Form toothpaste: 30]'; - addMouseUpActionWith: 'Form toothpaste: 30'; balloonText: 'Click me and then drag the cursor over the screen'; yourself! Item was changed: ----- Method: SketchMorph class>>extraExampleWizard (in category '*MorphicExtras-examples') ----- extraExampleWizard "SketchMorph extraExampleWizard openInWorld" ^ (self withForm: Form extraWizard) addMouseUpActionWith: + (MessageSend receiver: Display selector: #restoreAfter: argument: [Pen new web]); - (MessageSend receiver: Pen new selector: #web); balloonText: 'Click me and then drag the cursor over the screen\(Trust me, I won''t turn you into a toad!!)' withCRs; yourself! Item was added: + ----- Method: StringButtonMorph>>isButton (in category 'classification') ----- + isButton + + ^ true! Item was changed: ----- Method: Workspace class>>extraExampleContents2 (in category '*MorphicExtras-examples') ----- extraExampleContents2 "This is example code for #extraExample2" "Inspect any (sub)expression result by pressing <cmd>i" (20 to: 40 by: 2) asOrderedCollection addFirst: 16; addLast: 42; sort: [:x | x \\ 3] descending; yourself. "Explore any (sub)expression result by pressing <cmd>I" Project current world. "Debug any (sub)expression using <cmd>D" (1 to: 9) join asNumber sqrt truncateTo: 1e-3. + (SystemWindow windowsIn: self currentWorld) - (SystemWindow windowsIn: ActiveWorld) select: [:window | window bounds isWide] thenDo: [:window | window color: window color negated].!

1 0

The Treated Inbox: System-ct.1240.mcz
by commits＠source.squeak.org 07 Oct '21

07 Oct '21

Marcel Taeumel uploaded a new version of System to project The Treated Inbox: http://source.squeak.org/treated/System-ct.1240.mcz ==================== Summary ==================== Name: System-ct.1240 Author: ct Time: 15 July 2021, 12:04:53.78757 am UUID: 624f6c2a-2072-d94c-8dd0-90beb93b74d4 Ancestors: System-mt.1239 MailSender: Allows for empty passwords. Also improves multilingual support. Thanks to David Stes for the pointer! =============== Diff against System-mt.1239 =============== Item was changed: ----- Method: MailSender class>>setSmtpServer (in category 'settings') ----- setSmtpServer "Set the SMTP server used to send outgoing messages via" SmtpServer ifNil: [SmtpServer := '']. SmtpServer := UIManager default + request: 'What is your mail server for outgoing mail?' translated - request: 'What is your mail server for outgoing mail?' initialAnswer: SmtpServer. ! Item was changed: ----- Method: MailSender class>>setSmtpServerPort (in category 'settings') ----- setSmtpServerPort "Set the SMTP server port used to send outgoing messages via" SmtpServerPort ifNil: [SmtpServerPort := 25]. SmtpServerPort := (UIManager default + request: 'What is your mail server port for outgoing mail?' translated - request: 'What is your mail server port for outgoing mail?' initialAnswer: SmtpServerPort asString) asNumber. ! Item was changed: ----- Method: MailSender class>>setUserEmail (in category 'settings') ----- setUserEmail "Change the user's email for use in composing messages." (UIManager default + request: 'What is your email address?\(This is the address other people will reply to you)' withCRs translated - request: 'What is your email address?\(This is the address other people will reply to you)' withCRs initialAnswer: (UserEmail ifNil: [UserEmail := ''])) ifNotNil: [:answer | UserEmail := answer]! Item was changed: ----- Method: MailSender class>>setUserName (in category 'settings') ----- setUserName (UIManager default + request: 'What is your user name on the SMTP server?' translated - request: 'What is your user name on the SMTP server?' withCRs initialAnswer: (UserName ifNil: [UserName := ''])) ifNotNil: [:answer | UserName := answer]! Item was changed: ----- Method: MailSender class>>setUserPassword (in category 'settings') ----- setUserPassword UserPassword ifNil: [UserPassword := '']. (UIManager default + requestPassword: 'What is your server password?' translated) - requestPassword: 'What is your server passwort?' withCRs) ifNotNil: [:answer | UserPassword := answer]! Item was changed: ----- Method: MailSender class>>smtpServer (in category 'accessing') ----- smtpServer "Answer the server for sending email" self isSmtpServerSet ifFalse: [self setSmtpServer]. + SmtpServer isEmpty ifTrue: [self error: 'no SMTP server specified' translated]. - SmtpServer isEmpty ifTrue: [ self error: 'no SMTP server specified' ]. ^SmtpServer! Item was changed: ----- Method: MailSender class>>smtpServerPort (in category 'accessing') ----- smtpServerPort "Answer the server for sending email" self isSmtpServerPortSet ifFalse: [self setSmtpServerPort]. + SmtpServerPort isNil ifTrue: [self error: 'no SMTP server port specified' translated]. - SmtpServerPort isNil ifTrue: [ self error: 'no SMTP server port specified' ]. ^SmtpServerPort! Item was changed: ----- Method: MailSender class>>userEmail (in category 'accessing') ----- userEmail "Answer the user name to be used for sending out messages." self isUserEmailSet ifFalse: [self setUserEmail]. + UserEmail isEmpty ifTrue: [self error: 'no user email specified' translated]. - UserEmail isEmpty ifTrue: [ self error: 'no user email specified' ]. ^UserEmail! Item was changed: ----- Method: MailSender class>>userName (in category 'accessing') ----- userName "Answer the user name to be used for sending out messages." self isUserNameSet ifFalse: [self setUserName]. + UserName isEmpty ifTrue: [self error: 'no user name specified' translated]. - UserName isEmpty ifTrue: [ self error: 'no user name specified' ]. ^UserName! Item was changed: ----- Method: MailSender class>>userPassword (in category 'accessing') ----- userPassword self isUserPasswordSet ifFalse: [self setUserPassword]. + "UserPassword isEmpty ifTrue: [self error: 'no user name specified' translated]." - UserPassword isEmpty ifTrue: [ self error: 'no user name specified' ]. ^ UserPassword! Item was added: + ----- Method: Preferences class>>allowEtoyUserCustomEvents (in category 'standard queries') ----- + allowEtoyUserCustomEvents + ^ self + valueOfFlag: #allowEtoyUserCustomEvents + ifAbsent: [false]!

1 0

The Treated Inbox: Regex-Core-ct.61.mcz
by commits＠source.squeak.org 07 Oct '21

07 Oct '21

Marcel Taeumel uploaded a new version of Regex-Core to project The Treated Inbox: http://source.squeak.org/treated/Regex-Core-ct.61.mcz ==================== Summary ==================== Name: Regex-Core-ct.61 Author: ct Time: 8 July 2021, 1:30:44.09436 am UUID: 63655b8f-ad42-0946-b6fe-4dc3100995f1 Ancestors: Regex-Core-ct.59 Adds String >> #escapeRegex to escape special characters in a string before composing it into another regex. Usage: ':-)' matchesRegex: ':-)' escapeRegex =============== Diff against Regex-Core-ct.59 =============== Item was added: + ----- Method: RxParser class>>escapeString: (in category 'utilities') ----- + escapeString: aString + "Answer a copy of aString which does not contain any unescaped characters. This is the inverse function of String >> #matchesRegex:. + NB: Basically, we could simply escape every single character in the string, but this would not produce human-readable outputs." + + ^ aString + copyWithRegex: ('[{1}]' format: {self specialCharacters collect: [:character | '\', character]}) + matchesTranslatedUsing: [:match | '\', match]! Item was added: + ----- Method: RxParser class>>specialCharacters (in category 'utilities') ----- + specialCharacters + + ^ #($( $) $[ $] $* $+ $? ${ $} $. $^ $$ $: $\)! Item was added: + ----- Method: String>>escapeRegex (in category '*Regex-Core') ----- + escapeRegex + + ^ RxParser escapeString: self!

1 0

The Treated Inbox: System-ct.1236.mcz
by commits＠source.squeak.org 07 Oct '21

07 Oct '21

Marcel Taeumel uploaded a new version of System to project The Treated Inbox: http://source.squeak.org/treated/System-ct.1236.mcz ==================== Summary ==================== Name: System-ct.1236 Author: ct Time: 15 June 2021, 4:00:40.522222 pm UUID: f7bb410f-d6de-b242-b769-a558aa5a4254 Ancestors: System-dtl.1235 Fixes RealEstateAgent intolerance with a nil world which must be handled according to senders. Document the fact that world can be nil in all relevant senders. I struggled about this when I encountered a recursive project error. See StandardSystemView >> #initialFrame. =============== Diff against System-dtl.1235 =============== Item was changed: ----- Method: RealEstateAgent class>>initialFrameAtPointerFor:initialExtent:world: (in category 'framing - private') ----- + initialFrameAtPointerFor: aView initialExtent: scaledExtent world: aWorldOrNil + ^((aWorldOrNil ifNil: [0 @ 0] ifNotNil: [aWorldOrNil cursorPoint - (50@10) "puts use with the mouse ptr just to the right of the menu button"]) - initialFrameAtPointerFor: aView initialExtent: scaledExtent world: aWorld - ^(aWorld cursorPoint - (50@10) "puts use with the mouse ptr just to the right of the menu button" extent: scaledExtent) + translatedAndSquishedToBeWithin: (self maximumUsableAreaInWorld: aWorldOrNil)! - translatedAndSquishedToBeWithin: (self maximumUsableAreaInWorld: aWorld)! Item was changed: ----- Method: RealEstateAgent class>>initialFrameFor:initialExtent:world: (in category 'framing') ----- + initialFrameFor: aView initialExtent: initialExtent world: aWorldOrNil - initialFrameFor: aView initialExtent: initialExtent world: aWorld | scaledExtent | scaledExtent := (initialExtent * self scaleFactor) rounded. self placeWindowsAtPointer ifTrue: + [^self initialFrameAtPointerFor: aView initialExtent: scaledExtent world: aWorldOrNil]. - [^self initialFrameAtPointerFor: aView initialExtent: scaledExtent world: aWorld]. ^ Preferences reverseWindowStagger + ifTrue: [self strictlyStaggeredInitialFrameFor: aView initialExtent: scaledExtent world: aWorldOrNil] + ifFalse: [self normalInitialFrameFor: aView initialExtent: scaledExtent world: aWorldOrNil]! - ifTrue: [self strictlyStaggeredInitialFrameFor: aView initialExtent: scaledExtent world: aWorld] - ifFalse: [self normalInitialFrameFor: aView initialExtent: scaledExtent world: aWorld]! Item was changed: ----- Method: RealEstateAgent class>>initialFrameFor:world: (in category 'framing') ----- + initialFrameFor: aView world: aWorldOrNil - initialFrameFor: aView world: aWorld "Find a plausible initial screen area for the supplied view. See called method." + ^ self initialFrameFor: aView initialExtent: aView initialExtent world: aWorldOrNil! - ^ self initialFrameFor: aView initialExtent: aView initialExtent world: aWorld! Item was changed: ----- Method: RealEstateAgent class>>normalInitialFrameFor:initialExtent:world: (in category 'framing - private') ----- + normalInitialFrameFor: aView initialExtent: initialExtent world: aWorldOrNil - normalInitialFrameFor: aView initialExtent: initialExtent world: aWorld "Find a plausible initial screen area for the supplied view, which should be a StandardSystemView, taking into account the 'reverseWindowStagger' Preference, the size needed, and other windows currently on the screen." | allOrigins screenRight screenBottom putativeOrigin putativeFrame allowedArea staggerOrigin otherFrames | + allowedArea := self maximumUsableAreaInWorld: aWorldOrNil. - allowedArea := self maximumUsableAreaInWorld: aWorld. screenRight := allowedArea right. screenBottom := allowedArea bottom. otherFrames := Smalltalk isMorphic + ifTrue: [(SystemWindow windowsIn: aWorldOrNil satisfying: [:w | w isCollapsed not]) - ifTrue: [(SystemWindow windowsIn: aWorld satisfying: [:w | w isCollapsed not]) collect: [:w | w bounds]] ifFalse: [ScheduledControllers scheduledWindowControllers select: [:aController | aController view ~~ nil] thenCollect: [:aController | aController view isCollapsed ifTrue: [aController view expandedFrame] ifFalse: [aController view displayBox]]]. allOrigins := otherFrames collect: [:f | f origin]. + (self standardPositionsInWorld: aWorldOrNil) do: "First see if one of the standard positions is free" - (self standardPositionsInWorld: aWorld) do: "First see if one of the standard positions is free" [:aPosition | (allOrigins includes: aPosition) ifFalse: [^ (aPosition extent: initialExtent) translatedAndSquishedToBeWithin: allowedArea]]. + staggerOrigin := (self standardPositionsInWorld: aWorldOrNil) first. "Fallback: try offsetting from top left" - staggerOrigin := (self standardPositionsInWorld: aWorld) first. "Fallback: try offsetting from top left" putativeOrigin := staggerOrigin. [putativeOrigin := putativeOrigin + StaggerOffset. putativeFrame := putativeOrigin extent: initialExtent. (putativeFrame bottom < screenBottom) and: [putativeFrame right < screenRight]] whileTrue: [(allOrigins includes: putativeOrigin) ifFalse: [^ (putativeOrigin extent: initialExtent) translatedAndSquishedToBeWithin: allowedArea]]. ^ (self scrollBarSetback @ self screenTopSetback extent: initialExtent) translatedAndSquishedToBeWithin: allowedArea! Item was changed: ----- Method: RealEstateAgent class>>strictlyStaggeredInitialFrameFor:initialExtent:world: (in category 'framing - private') ----- + strictlyStaggeredInitialFrameFor: aStandardSystemView initialExtent: initialExtent world: aWorldOrNil - strictlyStaggeredInitialFrameFor: aStandardSystemView initialExtent: initialExtent world: aWorld "This method implements a staggered window placement policy that I (di) like. Basically it provides for up to 4 windows, staggered from each of the 4 corners. The windows are staggered so that there will always be a corner visible." | allowedArea grid initialFrame otherFrames cornerSel corner delta putativeCorner free maxLevel | + allowedArea :=(self maximumUsableAreaInWorld: aWorldOrNil) - allowedArea :=(self maximumUsableAreaInWorld: aWorld) insetBy: (self scrollBarSetback @ self screenTopSetback extent: 0@0). "Number to be staggered at each corner (less on small screens)" maxLevel := allowedArea area > 300000 ifTrue: [3] ifFalse: [2]. "Amount by which to stagger (less on small screens)" grid := allowedArea area > 500000 ifTrue: [40] ifFalse: [20]. initialFrame := 0@0 extent: ((initialExtent "min: (allowedArea extent - (grid*(maxLevel+1*2) + (grid//2)))) min: 600@400")). otherFrames := Smalltalk isMorphic + ifTrue: [(SystemWindow windowsIn: aWorldOrNil satisfying: [:w | w isCollapsed not]) - ifTrue: [(SystemWindow windowsIn: aWorld satisfying: [:w | w isCollapsed not]) collect: [:w | w bounds]] ifFalse: [ScheduledControllers scheduledWindowControllers select: [:aController | aController view ~~ nil] thenCollect: [:aController | aController view isCollapsed ifTrue: [aController view expandedFrame] ifFalse: [aController view displayBox]]]. 0 to: maxLevel do: [:level | 1 to: 4 do: [:ci | cornerSel := #(topLeft topRight bottomRight bottomLeft) at: ci. corner := allowedArea perform: cornerSel. "The extra grid//2 in delta helps to keep title tabs distinct" delta := (maxLevel-level*grid+(grid//2)) @ (level*grid). 1 to: ci-1 do: [:i | delta := delta rotateBy: #right centerAt: 0@0]. "slow way" putativeCorner := corner + delta. free := true. otherFrames do: [:w | free := free & ((w perform: cornerSel) ~= putativeCorner)]. free ifTrue: [^ (initialFrame align: (initialFrame perform: cornerSel) with: putativeCorner) translatedAndSquishedToBeWithin: allowedArea]]]. "If all else fails..." ^ (self scrollBarSetback @ self screenTopSetback extent: initialFrame extent) translatedAndSquishedToBeWithin: allowedArea!

1 0

The Treated Inbox: Collections-ct.947.mcz
by commits＠source.squeak.org 07 Oct '21

07 Oct '21

Marcel Taeumel uploaded a new version of Collections to project The Treated Inbox: http://source.squeak.org/treated/Collections-ct.947.mcz ==================== Summary ==================== Name: Collections-ct.947 Author: ct Time: 10 June 2021, 8:40:58.780588 pm UUID: cb2cdf00-2a3a-5d46-bf15-60255480c1fa Ancestors: Collections-eem.944 Proposal: Adds sort function that uses a boolean compare block such as [:a :b | a <= b]. Usage examples: squotVersions sorted: [:a :b | historyWalker shouldVisit: a before: b] asCompareSortFunction. #(true nil 42) sorted: #compareSafely: asCompareSortFunction. =============== Diff against Collections-eem.944 =============== Item was added: + ----- Method: BlockClosure>>asCompareSortFunction (in category '*Collections-SortFunctions-converting') ----- + asCompareSortFunction + + ^ CompareBlockFunction usingBlock: self! Item was changed: SortFunction subclass: #CollatorBlockFunction instanceVariableNames: 'collatorBlock' classVariableNames: '' poolDictionaries: '' category: 'Collections-SortFunctions'! + !CollatorBlockFunction commentStamp: 'ct 6/10/2021 20:38' prior: 0! - !CollatorBlockFunction commentStamp: 'nice 11/5/2017 22:57' prior: 0! A CollatorBlockFunction is a special SortFunction using a dyadic block to collate objects. Instance Variables + collatorBlock <Block> a dyadic block that must return a -1, 0, or 1.! - collator <Block> a dyadic block that must return a -1, 0, or 1.! Item was added: + SortFunction subclass: #CompareBlockFunction + instanceVariableNames: 'compareBlock' + classVariableNames: '' + poolDictionaries: '' + category: 'Collections-SortFunctions'! + + !CompareBlockFunction commentStamp: 'ct 6/10/2021 20:38' prior: 0! + A CompareBlockFunction is a special SortFunction using a dyadic block to compare objects. The default compare logic is the lower-equals function (#<=). + + Instance Variables + + compareBlock <Block> a dyadic block that must return true iff the first argument should not appear after the second , otherwise false.! Item was added: + ----- Method: CompareBlockFunction class>>usingBlock: (in category 'instance creation') ----- + usingBlock: twoArgsBlock + + ^ self new compareBlock: twoArgsBlock! Item was added: + ----- Method: CompareBlockFunction>>collate:with: (in category 'evaluating') ----- + collate: anObject with: anotherObject + + ^ (compareBlock value: anObject value: anotherObject) + ifTrue: [-1] + ifFalse: [1]! Item was added: + ----- Method: CompareBlockFunction>>compareBlock (in category 'accessing') ----- + compareBlock + + ^ compareBlock! Item was added: + ----- Method: CompareBlockFunction>>compareBlock: (in category 'accessing') ----- + compareBlock: aBlock + + compareBlock := aBlock.! Item was added: + ----- Method: Symbol>>asCompareSortFunction (in category '*Collections-SortFunctions-converting') ----- + asCompareSortFunction + + ^ CompareBlockFunction usingBlock: self!

1 0

The Treated Inbox: CollectionsTests-ct.358.mcz
by commits＠source.squeak.org 07 Oct '21

07 Oct '21

Marcel Taeumel uploaded a new version of CollectionsTests to project The Treated Inbox: http://source.squeak.org/treated/CollectionsTests-ct.358.mcz ==================== Summary ==================== Name: CollectionsTests-ct.358 Author: ct Time: 10 June 2021, 8:46:05.348588 pm UUID: 38a6fe79-5645-2b44-bc79-952cd4cac3e3 Ancestors: CollectionsTests-nice.354 Tests Collections-ct.947. =============== Diff against CollectionsTests-nice.354 =============== Item was added: + ----- Method: SortFunctionTest>>testCompareSortBlock (in category 'tests') ----- + testCompareSortBlock + + | function block | + block := [:a :b | a x <= b x and: [a y >= b y]]. + function := block asCompareSortFunction. + + self assert: (function value: 1 @ 1 value: 1 @ 1). + self assert: (function value: 0 @ 1 value: 1 @ 1). + self assert: (function value: 1 @ 2 value: 1 @ 1). + self deny: (function value: 2 @ 1 value: 1 @ 1). + self deny: (function value: 1 @ 2 value: 0 @ 1).! Item was added: + ----- Method: SortFunctionTest>>testCompareSortSymbol (in category 'tests') ----- + testCompareSortSymbol + + | function symbol | + symbol := #compareSafely:. + function := symbol asCompareSortFunction. + + self assert: (function value: true value: nil). + self deny: (function value: nil value: true). + self assert: (function value: Object new value: true). + self deny: (function value: true value: Object new). + self assert: (function value: Object new value: nil). + self deny: (function value: nil value: Object new).!

1 0

The Treated Inbox: Tools-ct.930.mcz
by commits＠source.squeak.org 07 Oct '21

07 Oct '21

Marcel Taeumel uploaded a new version of Tools to project The Treated Inbox: http://source.squeak.org/treated/Tools-ct.930.mcz ==================== Summary ==================== Name: Tools-ct.930 Author: ct Time: 13 January 2020, 12:25:17.41557 pm UUID: 46d52269-9d40-c946-b341-651b03bd9b2e Ancestors: Tools-mt.929 Adds support for browsing extension methods to Browser. Complements System-ct.1131. =============== Diff against Tools-mt.929 =============== Item was added: + ----- Method: Browser>>browseExtensions (in category 'system category functions') ----- + browseExtensions + + ^ self systemNavigation browseAllExtensionsOf: self selectedPackage! Item was changed: ----- Method: Browser>>mainSystemCategoryMenu: (in category 'system category functions') ----- mainSystemCategoryMenu: aMenu <systemCategoryMenu> ^ aMenu addList: #( ('find class... (f)' findClass) ('back... (b)' recent) - + ('browse all' browseAllClasses) + ('browse' buildSystemCategoryBrowser) + ('browse extensions' browseExtensions) - ('browse all' browseAllClasses) - ('browse' buildSystemCategoryBrowser) - ('printOut' printOutSystemCategory) ('fileOut' fileOutSystemCategory) - ('reorganize' editSystemCategories) ('alphabetize' alphabetizeSystemCategories) - ('update' updateSystemCategories) ('add item...' addSystemCategory) ('rename...' renameSystemCategory) ('remove (x)' removeSystemCategory)); yourself ! Item was added: + ----- Method: Browser>>selectedPackage (in category 'system category list') ----- + selectedPackage + + ^ self environment info packages packageOfSystemCategory: self selectedSystemCategory!

1 0

The Treated Inbox: Kernel-eem.1415.mcz
by commits＠source.squeak.org 07 Oct '21

07 Oct '21

Marcel Taeumel uploaded a new version of Kernel to project The Treated Inbox: http://source.squeak.org/treated/Kernel-eem.1415.mcz ==================== Summary ==================== Name: Kernel-eem.1415 Author: eem Time: 20 September 2021, 3:40:41.04035 pm UUID: b3b62e4b-49b1-4463-93de-6c69109de02d Ancestors: Kernel-eem.1414 An alternative fix to http://lists.squeakfoundation.org/pipermail/squeak-dev/2021-September/21652… c.f. Kernel-ul.1415 =============== Diff against Kernel-eem.1414 =============== Item was added: + ----- Method: MethodDictionary>>add: (in category 'adding') ----- + add: anAssociation + + | index | + index := self scanFor: anAssociation key. + (array at: index) + ifNil: [ self atNewIndex: index put: anAssociation ] + ifNotNil: [ array at: index put: anAssociation value ]. + ^anAssociation! Item was changed: ----- Method: MethodDictionary>>at:put: (in category 'accessing') ----- at: key put: value "Set the value at key to be value." | index | index := self scanFor: key. (self basicAt: index) ifNil: [ self basicAt: index put: key; + atNewIndex: index putValue: value ] - atNewIndex: index put: value ] ifNotNil: [ (array at: index) flushCache. array at: index put: value ]. ^value! Item was added: + ----- Method: MethodDictionary>>atNewIndex:put: (in category 'private') ----- + atNewIndex: index put: anAssociation + "Override to deal with the internal organization of MethodDIctionaries + which, to suit the VM, do not use Associations." + self assert: anAssociation isVariableBinding. + self basicAt: index put: anAssociation key. + array at: index put: anAssociation value. + tally := tally + 1. + "Keep array at least 1/4 free for decent hash behavior" + array size * 3 < (tally * 4) ifTrue: [ self grow ]! Item was added: + ----- Method: MethodDictionary>>atNewIndex:putValue: (in category 'private') ----- + atNewIndex: index putValue: anObject + "Override to deal with the internal organization of MethodDIctionaries + which, to suit the VM, do not use Associations." + array at: index put: anObject. + tally := tally + 1. + "Keep array at least 1/4 free for decent hash behavior" + array size * 3 < (tally * 4) ifTrue: [ self grow ]!

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Packages October 2021