Packages September 2020

packages@lists.squeakfoundation.org

1 participants
56 discussions

The Trunk: Sound-eem.75.mcz
by commits＠source.squeak.org 22 Sep '20

22 Sep '20

Eliot Miranda uploaded a new version of Sound to project The Trunk: http://source.squeak.org/trunk/Sound-eem.75.mcz ==================== Summary ==================== Name: Sound-eem.75 Author: eem Time: 22 September 2020, 11:47:06.322437 am UUID: a4d7e0e8-269c-432f-ac18-25d2d7d1ff44 Ancestors: Sound-eem.74 In deference to strong opinions voice on squeak-dev reimplement teh 64-bit alternative for SampledSound>>mixSampleCount:into:startingAt:leftVol:rightVol:, and consequently fix a non-obvious regression in the 64-bit alternative. =============== Diff against Sound-eem.74 =============== Item was changed: ----- Method: AbstractSound class>>translatedPrimitives (in category 'primitive generation') ----- translatedPrimitives ^#( (FMSound mixSampleCount:into:startingAt:leftVol:rightVol:) (PluckedSound mixSampleCount:into:startingAt:leftVol:rightVol:) (LoopedSampledSound mixSampleCount:into:startingAt:leftVol:rightVol:) (SampledSound mixSampleCount:into:startingAt:leftVol:rightVol:) - (SampledSound _64bitMixSampleCount:into:startingAt:leftVol:rightVol:) (ReverbSound applyReverbTo:startingAt:count:) ). ! Item was removed: - ----- Method: SampledSound>>_64bitMixSampleCount:into:startingAt:leftVol:rightVol: (in category 'playing') ----- - _64bitMixSampleCount: n into: aSoundBuffer startingAt: startIndex leftVol: leftVol rightVol: rightVol - "Mix the given number of samples with the samples already in the given buffer starting at the given index. - Assume that the buffer size is at least (index + count) - 1." - - | lastIndex outIndex sampleIndex sample i s | - <inline: #always> - <var: #aSoundBuffer type: #'short int *'> - <var: #samples type: #'short int *'> - - lastIndex := (startIndex + n) - 1. - outIndex := startIndex. "index of next stereo output sample pair" - sampleIndex := indexHighBits + (scaledIndex >> IncrementFractionBits). - [(sampleIndex <= samplesSize) and: [outIndex <= lastIndex]] whileTrue: - [sample := ((samples at: sampleIndex) * scaledVol) // ScaleFactor. - leftVol > 0 ifTrue: - [i := (2 * outIndex) - 1. - s := (aSoundBuffer at: i) + ((sample * leftVol) // ScaleFactor). - s > 32767 ifTrue: [s := 32767]. "clipping!!" - s < -32767 ifTrue: [s := -32767]. "clipping!!" - aSoundBuffer at: i put: s]. - rightVol > 0 ifTrue: - [i := 2 * outIndex. - s := (aSoundBuffer at: i) + ((sample * rightVol) // ScaleFactor). - s > 32767 ifTrue: [s := 32767]. "clipping!!" - s < -32767 ifTrue: [s := -32767]. "clipping!!" - aSoundBuffer at: i put: s]. - - scaledVolIncr ~= 0 ifTrue: - [scaledVol := scaledVol + scaledVolIncr. - ((scaledVolIncr > 0 and: [scaledVol >= scaledVolLimit]) or: - [scaledVolIncr < 0 and: [scaledVol <= scaledVolLimit]]) - ifTrue: "reached the limit; stop incrementing" - [scaledVol := scaledVolLimit. - scaledVolIncr := 0]]. - - scaledIndex := scaledIndex + scaledIncrement. - - sampleIndex := indexHighBits + (scaledIndex >> IncrementFractionBits). - outIndex := outIndex + 1]. - count := count - n - ! Item was changed: ----- Method: SampledSound>>mixSampleCount:into:startingAt:leftVol:rightVol: (in category 'playing') ----- mixSampleCount: n into: aSoundBuffer startingAt: startIndex leftVol: leftVol rightVol: rightVol "Mix the given number of samples with the samples already in the given buffer starting at the given index. Assume that the buffer size is at least (index + count) - 1." | lastIndex outIndex sampleIndex sample i s overflow | <primitive:'primitiveMixSampledSound' module: 'SoundGenerationPlugin'> <var: #aSoundBuffer type: #'short int *'> <var: #samples type: #'short int *'> + lastIndex := startIndex + n - 1. - SmallInteger maxVal > 16r3FFFFFFF ifTrue: "In 64-bits we don't have to worry about 2^15 * 2^15 overflow" - [^self _64bitMixSampleCount: n into: aSoundBuffer startingAt: startIndex leftVol: leftVol rightVol: rightVol]. - lastIndex := (startIndex + n) - 1. outIndex := startIndex. "index of next stereo output sample pair" sampleIndex := indexHighBits + (scaledIndex >> IncrementFractionBits). + [sampleIndex <= samplesSize and: [outIndex <= lastIndex]] whileTrue: + [sample := (samples at: sampleIndex) * scaledVol // ScaleFactor. + leftVol > 0 ifTrue: + [i := 2 * outIndex - 1. + s := (aSoundBuffer at: i) + (sample * leftVol // ScaleFactor). + "clip the result!!!!" + aSoundBuffer at: i put: (s > 32767 ifTrue: [32767] ifFalse: [s < -32767 ifTrue: [-32767] ifFalse: [s]])]. + rightVol > 0 ifTrue: + [i := 2 * outIndex. + s := (aSoundBuffer at: i) + (sample * rightVol // ScaleFactor). + "clip the result!!!!" + aSoundBuffer at: i put: (s > 32767 ifTrue: [32767] ifFalse: [s < -32767 ifTrue: [-32767] ifFalse: [s]])]. - [(sampleIndex <= samplesSize) and: [outIndex <= lastIndex]] whileTrue: [ - sample := ((samples at: sampleIndex) * scaledVol) // ScaleFactor. - leftVol > 0 ifTrue: [ - i := (2 * outIndex) - 1. - s := (aSoundBuffer at: i) + ((sample * leftVol) // ScaleFactor). - s > 32767 ifTrue: [s := 32767]. "clipping!!" - s < -32767 ifTrue: [s := -32767]. "clipping!!" - aSoundBuffer at: i put: s]. - rightVol > 0 ifTrue: [ - i := 2 * outIndex. - s := (aSoundBuffer at: i) + ((sample * rightVol) // ScaleFactor). - s > 32767 ifTrue: [s := 32767]. "clipping!!" - s < -32767 ifTrue: [s := -32767]. "clipping!!" - aSoundBuffer at: i put: s]. + scaledVolIncr ~= 0 ifTrue: + [scaledVol := scaledVol + scaledVolIncr. + (scaledVolIncr > 0 + ifTrue: [scaledVol >= scaledVolLimit] + ifFalse: [scaledVol <= scaledVolLimit]) + ifTrue: "reached the limit; stop incrementing" + [scaledVol := scaledVolLimit. - scaledVolIncr ~= 0 ifTrue: [ - scaledVol := scaledVol + scaledVolIncr. - ((scaledVolIncr > 0 and: [scaledVol >= scaledVolLimit]) or: - [scaledVolIncr < 0 and: [scaledVol <= scaledVolLimit]]) - ifTrue: [ "reached the limit; stop incrementing" - scaledVol := scaledVolLimit. scaledVolIncr := 0]]. scaledIndex := scaledIndex + scaledIncrement. + "In 64-bits we don't have to worry about scaled indexes overflowing, + and in the primitive this is guard evaluated at compile time." + (SmallInteger maxVal <= 16r3FFFFFFF + and: [scaledIndex >= ScaledIndexOverflow]) ifTrue: + [overflow := scaledIndex >> IncrementFractionBits. - scaledIndex >= ScaledIndexOverflow ifTrue: [ - overflow := scaledIndex >> IncrementFractionBits. indexHighBits := indexHighBits + overflow. scaledIndex := scaledIndex - (overflow << IncrementFractionBits)]. sampleIndex := indexHighBits + (scaledIndex >> IncrementFractionBits). outIndex := outIndex + 1]. + "But we still have to update indexHighBits and scaledIndex correctly outside the loop..." + SmallInteger maxVal > 16r3FFFFFFF ifTrue: + [overflow := scaledIndex >> IncrementFractionBits. + indexHighBits := indexHighBits + overflow. + scaledIndex := scaledIndex - (overflow << IncrementFractionBits)]. count := count - n!

1 0

The Trunk: Tools-ct.987.mcz
by commits＠source.squeak.org 22 Sep '20

22 Sep '20

Eliot Miranda uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-ct.987.mcz ==================== Summary ==================== Name: Tools-ct.987 Author: ct Time: 3 September 2020, 2:45:32.786083 pm UUID: e07c870e-186e-f54a-9dbc-b766b1cb2bbb Ancestors: Tools-ct.985 Fixes several issues with accepting source in debuggers. Applies overall refactoring to Debugger>>#contents:notifying:. With this version, two concrete regressions are fixed that were introduced with the SistaV1 bytecode set (see [1]): - When compiling a method from a block context and answering subsequent parser notifications, make sure the source code is not lost. A variant of this issue was filed by Eliot (emm) in [2]. - When removing a method from a block context, make sure the stack is unwinded correctly. Further adjustments: - Don't restart the current context if a different selector is changed. - Update contentsSelection correctly without morphic hack. Works now in MVC, again. [1] http://forum.world.st/The-Inbox-Kernel-dtl-1310-mcz-td5113032.html [2] http://forum.world.st/tedious-programming-in-the-debugger-error-needs-fixin… =============== Diff against Tools-ct.985 =============== Item was changed: ----- Method: Debugger>>contents:notifying: (in category 'accessing') ----- contents: aText notifying: aController + "Accept new method source of the selected context." - "The retrieved information has changed and its source must now be updated. - In this case, the retrieved information is the method of the selected context." - | result selector classOfMethod category h ctxt newMethod | - contextStackIndex = 0 ifTrue: - [^false]. - self selectedContext isExecutingBlock ifTrue: - [h := self selectedContext activeHome. - h ifNil: - [self inform: 'Method for block not found on stack, can''t edit and continue'. - ^false]. - (self confirm: 'I will have to revert to the method from\which this block originated. Is that OK?' withCRs) ifFalse: - [^false]. - self resetContext: h changeContents: false. - "N.B. Only reset the contents if the compilation succeeds. If contents are reset - when compilation fails both compiler error message and modifications are lost." - (result := self contents: aText notifying: aController) ifTrue: - [self contentsChanged]. - ^result]. + | selector classOfMethod category ctxt newMethod | + contextStackIndex = 0 ifTrue: [^ false]. + + "First, handle some edge cases" + selector := self selectedClass newParser parseSelector: aText. + "selector isDoIt ifTrue: [ + currentCompiledMethod := self compileDoIt: aText]." + self flag: #todo. "ct: Recompile doIt method *without* creating method litters!! See Compiler>>#evaluateCue:ifFail:." + selector = self selectedMessageName ifFalse: [ + "Different message compiled, delegating to super" + ^ super contents: aText notifying: aController]. + + self selectedContext isExecutingBlock ifTrue: [ + "If we are in a block context, we need to rewind the stack before ." + | home | + home := self selectedContext activeHome. + home ifNil: [ + self inform: 'Method for block not found on stack, can''t edit and continue' translated. + ^ false]. + (self confirm: 'I will have to revert to the method from\which this block originated. Is that OK?' withCRs translated) ifFalse: [ + ^ false]. + + self resetContext: home changeContents: false. + "N.B. Only reset the contents if the compilation succeeds. If contents would be reset when compilation fails, both compiler error message and modifications were lost." + ^ (self contents: aText notifying: aController) + ifTrue: [self contentsChanged]; + yourself]. + classOfMethod := self selectedClass. category := self selectedMessageCategoryName. + + "Do the actual compilation" - selector := self selectedClass newParser parseSelector: aText. - (selector == self selectedMessageName - or: [(self selectedMessageName beginsWith: 'DoIt') - and: [selector numArgs = self selectedMessageName numArgs]]) ifFalse: - [self inform: 'can''t change selector'. - ^false]. selector := classOfMethod + compile: aText + classified: category + notifying: aController. + selector ifNil: [^ false]. "compilation cancelled" + + "Update views" - compile: aText - classified: category - notifying: aController. - selector ifNil: [^false]. "compile cancelled" contents := aText. newMethod := classOfMethod compiledMethodAt: selector. + newMethod isQuick ifTrue: [ + self cutBackExecutionToSenderContext]. - newMethod isQuick ifTrue: - [self cutBackExecutionToSenderContext]. ctxt := interruptedProcess popTo: self selectedContext. ctxt == self selectedContext + ifFalse: [self inform: 'Method saved, but current context unchanged\because of unwind error. Click OK to see error' withCRs translated] + ifTrue: [ + newMethod isQuick ifFalse: [ + interruptedProcess restartTopWith: newMethod. + self stepToStatement]. - ifFalse: - [self inform: 'Method saved, but current context unchanged\because of unwind error. Click OK to see error' withCRs] - ifTrue: - [newMethod isQuick ifFalse: - [interruptedProcess - restartTopWith: newMethod; - stepToSendOrReturn]. contextVariablesInspector object: nil]. self resetContext: ctxt. + + Project current addDeferredUIMessage: [ + self changed: #contentsSelection]. + ^ true! - Smalltalk isMorphic ifTrue: - [Project current world - addAlarm: #changed: - withArguments: #(contentsSelection) - for: self - at: (Time millisecondClockValue + 200)]. - ^true! Item was changed: ----- Method: Debugger>>contextStackIndex:oldContextWas: (in category 'private') ----- contextStackIndex: anInteger oldContextWas: oldContext "Change the context stack index to anInteger, perhaps in response to user selection." | isNewMethod | self saveReceiverInspectorState. self saveContextVariablesInspectorState. contextStackIndex := anInteger. anInteger = 0 ifTrue: [currentCompiledMethod := contents := nil. self changed: #contextStackIndex. self decorateButtons. self contentsChanged. contextVariablesInspector object: nil. receiverInspector context: nil; inspect: self receiver. ^self]. isNewMethod := oldContext isNil + or: [oldContext home method ~= (currentCompiledMethod := self selectedContext home method)]. - or: [oldContext method ~~ (currentCompiledMethod := self selectedContext method)]. isNewMethod ifTrue: [contents := self selectedMessage. self contentsChanged. self pcRange]. self changed: #contextStackIndex. self decorateButtons. contextVariablesInspector object: self selectedContext. self restoreContextVariablesInspectorState. receiverInspector context: self selectedContext; inspect: self receiver. self restoreReceiverInspectorState. isNewMethod ifFalse: [self changed: #contentsSelection]! Item was changed: ----- Method: Debugger>>findCleanHomeBelow: (in category 'context stack (message list)') ----- findCleanHomeBelow: method | dirtyIndex | dirtyIndex := contextStack size + 1. contextStack reverse detect: [:context | dirtyIndex := dirtyIndex - 1. + context home method = method homeMethod]. - context method = method]. ^ dirtyIndex + 1! Item was added: + ----- Method: Debugger>>tallyMenu: (in category 'controls') ----- + tallyMenu: aMenu + + ^ aMenu + "title: 'Tally' translated;" flag: #todo; "ct: Implement on PluggableMenuSpec" + addTranslatedList: #( + ('Tally selection' tallyIt 'evaluate current selection and measure the time') + ('Record send' doRecord 'record next message send')); + yourself!

1 0

The Trunk: Monticello-ul.726.mcz
by commits＠source.squeak.org 20 Sep '20

20 Sep '20

Levente Uzonyi uploaded a new version of Monticello to project The Trunk: http://source.squeak.org/trunk/Monticello-ul.726.mcz ==================== Summary ==================== Name: Monticello-ul.726 Author: ul Time: 29 June 2020, 1:39:36.986367 am UUID: b64f6b16-96de-40ed-aa9a-2c0f625bfcb1 Ancestors: Monticello-mt.725 - potentially speed up MCDirectoryRepository >> #includesVersionNamed: when the repository doesn't have version names cached - cache self size in MCVersionName >> #versionName =============== Diff against Monticello-mt.725 =============== Item was added: + ----- Method: MCDirectoryRepository>>includesVersionNamed: (in category 'versions') ----- + includesVersionNamed: aString + + | comparable | + comparable := ((aString endsWith: '.mcz') and: [ aString size > 4 ]) + ifTrue: [ aString allButLast: 4 ] + ifFalse: [ aString ]. + allVersionNamesCache ifNil: [ + "Instead of reading the contents of the entire directory in #allVersionNames, look up a single .mcz file. + This is just an optimization. If the file does not exist, the version may still be there as an mcd." + (directory fileExists: comparable, '.mcz') ifTrue: [ ^true ] ]. + ^ self allVersionNames includes: comparable! Item was changed: ----- Method: MCVersionName>>versionName (in category 'accessing') ----- versionName "Answer my version name as a ByteString, without the file suffix or any ancestor-attributes." | end | self isEmpty ifTrue: [^ String empty]. end := self indexOf: $( ifAbsent: [ + | size | + size := self size. + (size > 4 + and: [ (self at: size - 3) == $. + and: [ (self at: size - 2) == $m + and: [ (self at: size - 1) == $c ] ] ]) + ifTrue: [size - 3] + ifFalse: [size + 1]]. - (self size > 4 - and: [ (self at: self size - 3) == $. - and: [ (self at: self size - 2) == $m - and: [ (self at: self size - 1) == $c ] ] ]) - ifTrue: [self size - 3] - ifFalse: [self size + 1]]. ^self first: end - 1!

1 0

The Trunk: Monticello-ct.727.mcz
by commits＠source.squeak.org 20 Sep '20

20 Sep '20

Levente Uzonyi uploaded a new version of Monticello to project The Trunk: http://source.squeak.org/trunk/Monticello-ct.727.mcz ==================== Summary ==================== Name: Monticello-ct.727 Author: ct Time: 20 August 2020, 2:38:27.66964 pm UUID: b81a07b6-cb93-6f48-847e-dbe86460d69f Ancestors: Monticello-cmm.726 Complements 60Deprecated-ct.80 (deprecation #doWithIndex: & Co.). =============== Diff against Monticello-cmm.726 =============== Item was changed: ----- Method: MCTool>>buildWith: (in category 'toolbuilder') ----- buildWith: builder | windowBuilder | windowBuilder := MCToolWindowBuilder builder: builder tool: self. self widgetSpecs do: [:spec | | send fractions offsets | send := spec first. fractions := (spec at: 2 ifAbsent: [#(0 0 1 1)]) copy. offsets := (spec at: 3 ifAbsent: [#(0 0 0 0)]) copy. + fractions withIndexDo: [:numberOrSymbol :index | - fractions doWithIndex: [:numberOrSymbol :index | numberOrSymbol isSymbol ifTrue: [fractions at: index put: (self perform: numberOrSymbol)]]. + offsets withIndexDo: [:numberOrSymbol :index | - offsets doWithIndex: [:numberOrSymbol :index | numberOrSymbol isSymbol ifTrue: [offsets at: index put: (self perform: numberOrSymbol)]]. windowBuilder frame: (LayoutFrame fractions: (fractions first @ fractions second corner: fractions third @ fractions fourth) offsets: (offsets first @ offsets second corner: offsets third @ offsets fourth)). windowBuilder perform: send first withArguments: send allButFirst]. ^ windowBuilder build !

1 0

The Trunk: Monticello-ul.727.mcz
by commits＠source.squeak.org 20 Sep '20

20 Sep '20

Levente Uzonyi uploaded a new version of Monticello to project The Trunk: http://source.squeak.org/trunk/Monticello-ul.727.mcz ==================== Summary ==================== Name: Monticello-ul.727 Author: ul Time: 17 September 2020, 1:54:51.056164 am UUID: ad776836-42eb-4aa2-b788-f10dd9e07da2 Ancestors: Monticello-cmm.726 MCHttpRepository changes: - before up- or downloading files, transform the urls using #rewriteUrl:forDownload:. The default rules (see #urlRewriteRules) switch from http to https for source.squeak.org and squeaksource.com, and switch to the the static smalltalkhub site for downloads. The url rewriting is Eliot's idea, but this implementation uses a list of rewrite rules instead of a dictionary-based mapping. - use WebClient (and the shared webclient instance) for uploads too - retry down/uploading with WebClient at most 3 times. This should work around the case where the underlying socket was closed but the state of the socket has not been updated in Squeak. - use https in #creationTemplate =============== Diff against Monticello-cmm.726 =============== Item was changed: MCFileBasedRepository subclass: #MCHttpRepository instanceVariableNames: 'location user password readerCache indexed webClient' + classVariableNames: 'URLRewriteRules UseSharedWebClientInstance' - classVariableNames: 'UseSharedWebClientInstance' poolDictionaries: '' category: 'Monticello-Repositories'! Item was changed: ----- Method: MCHttpRepository class>>creationTemplate (in category 'ui-support') ----- creationTemplate + ^self creationTemplateLocation: 'https://www.squeaksource.com/ProjectName' - ^self creationTemplateLocation: 'http://www.squeaksource.com/ProjectName' user: 'squeak' password: 'squeak' ! Item was added: + ----- Method: MCHttpRepository class>>rewriteUrl:forDownload: (in category 'url rewrite') ----- + rewriteUrl: aString forDownload: forDownload + + | result | + result := aString. + self urlRewriteRules groupsDo: [ :regexString :replacement :downloadOnly | + (forDownload or: [ downloadOnly not ]) ifTrue: [ + result := result copyWithRegex: regexString matchesReplacedWith: replacement ] ]. + ^result + + " + self assert: 'https://squeaksource.com/foo/bar?baz=1' = (self rewriteUrl: 'http://squeaksource.com/foo/bar?baz=1' forDownload: true). + self assert: 'https://squeaksource.com/foo/bar?baz=1' = (self rewriteUrl: 'https://squeaksource.com/foo/bar?baz=1' forDownload: true). + self assert: 'https://source.squeak.org/foo/bar?baz=1' = (self rewriteUrl: 'http://source.squeak.org/foo/bar?baz=1' forDownload: true). + self assert: 'https://source.squeak.org/foo/bar?baz=1' = (self rewriteUrl: 'https://source.squeak.org/foo/bar?baz=1' forDownload: true). + self assert: 'http://static.smalltalkhub.com/foo/bar?baz=1' = (self rewriteUrl: 'http://smalltalkhub.com/foo/bar?baz=1' forDownload: true). + self assert: 'http://smalltalkhub.com/foo/bar?baz=1' = (self rewriteUrl: 'http://smalltalkhub.com/foo/bar?baz=1' forDownload: false). + "! Item was added: + ----- Method: MCHttpRepository class>>urlRewriteRules (in category 'url rewrite') ----- + urlRewriteRules + + ^URLRewriteRules ifNil: [ + URLRewriteRules := #( + "Regex to be replaced" "static replacement string" "download only" + '^http\://source\.squeak\.org/' 'https://source.squeak.org/' false + '^http\://squeaksource\.com/' 'https://squeaksource.com/' false + '^http\://www.squeaksource\.com/' 'https://www.squeaksource.com/' false + '^http\://smalltalkhub.com/' 'http://static.smalltalkhub.com/' true + ) asOrderedCollection ]! Item was changed: ----- Method: MCHttpRepository>>httpGet:arguments: (in category 'private') ----- httpGet: url arguments: arguments + | urlString | - | progress urlString client response result | - progress := [ :total :amount | - HTTPProgress new - total: total; - amount: amount; - signal: 'Downloading...' ]. urlString := arguments ifNil: [ url ] ifNotNil: [ | queryString | queryString := WebUtils encodeUrlEncodedForm: arguments. (url includes: $?) ifTrue: [ url, '&', queryString ] ifFalse: [ url, '?', queryString ] ]. + urlString := self class rewriteUrl: urlString forDownload: true. + ^self webClientDo: [ :client | + client + username: self user; + password: self password; + httpGet: urlString do: [ :request | + request + headerAt: 'Authorization' put: 'Basic ', (self user, ':', self password) base64Encoded; + headerAt: 'Connection' put: 'Keep-Alive'; + headerAt: 'Accept' put: '*/*' ] ]! - self class useSharedWebClientInstance ifTrue: [ - "Acquire webClient by atomically storing it in the client variable and setting its value to nil." - client := webClient. - webClient := nil ]. - client - ifNil: [ client := WebClient new ] - ifNotNil: [ - "Attempt to avoid an error on windows by recreating the underlying stream." - client isConnected ifFalse: [ client close ] ]. - response := client - username: self user; - password: self password; - httpGet: urlString do: [ :request | - request - headerAt: 'Authorization' put: 'Basic ', (self user, ':', self password) base64Encoded; - headerAt: 'Connection' put: 'Keep-Alive'; - headerAt: 'Accept' put: '*/*' ]. - result := (response code between: 200 and: 299) - ifFalse: [ - response content. "Make sure content is read." - nil ] - ifTrue: [ (RWBinaryOrTextStream with: (response contentWithProgress: progress)) reset ]. - self class useSharedWebClientInstance - ifTrue: [ - "Save the WebClient instance for reuse, but only if there is no client cached." - webClient - ifNil: [ webClient := client ] - ifNotNil: [ client close ] ] - ifFalse: [ client close ]. - result ifNil: [ NetworkError signal: 'Could not access ', location ]. - ^result! Item was added: + ----- Method: MCHttpRepository>>webClientDo: (in category 'private') ----- + webClientDo: aBlock + + | client attemptsLeft response result | + self class useSharedWebClientInstance ifTrue: [ + "Acquire webClient by atomically storing it in the client variable and setting its value to nil." + client := webClient. + webClient := nil ]. + + client + ifNil: [ client := WebClient new ] + ifNotNil: [ + "Attempt to avoid an error by recreating the underlying stream." + client isConnected ifFalse: [ client close ] ]. + + attemptsLeft := 3. + response := nil. + [ response isNil and: [ attemptsLeft > 0 ] ] whileTrue: [ + response := [ aBlock value: client ] + on: NetworkError + do: [ :error | + attemptsLeft = 0 ifTrue: [ error pass ]. + (3 - attemptsLeft) seconds asDelay wait. + attemptsLeft := attemptsLeft - 1. + nil "The response" ] ]. + + result := (response code between: 200 and: 299) + ifFalse: [ + response content. "Make sure content is read." + nil ] + ifTrue: [ + (RWBinaryOrTextStream with: ( + response contentWithProgress: [ :total :amount | + HTTPProgress new + total: total; + amount: amount; + signal ])) reset ]. + + self class useSharedWebClientInstance + ifTrue: [ + "Save the WebClient instance for reuse, but only if there is no client cached." + webClient + ifNil: [ webClient := client ] + ifNotNil: [ client close ] ] + ifFalse: [ client close ]. + + result ifNil: [ NetworkError signal: 'Could not access ', location ]. + ^result! Item was changed: ----- Method: MCHttpRepository>>writeStreamForFileNamed:replace:do: (in category 'private') ----- writeStreamForFileNamed: aString replace: ignoreBoolean do: aBlock + + | stream urlString | - | stream response statusLine code | stream := RWBinaryOrTextStream on: String new. aBlock value: stream. + urlString := self urlForFileNamed: aString. + urlString := self class rewriteUrl: urlString forDownload: false. + ^self displayProgress: 'Uploading ', aString during: [ + self webClientDo: [ :client | + client + username: self user; + password: self password; + httpPut: urlString + content: stream contents + type: nil + do: [ :request | + request + headerAt: 'Authorization' put: 'Basic ', (self user, ':', self password) base64Encoded; + headerAt: 'Connection' put: 'Keep-Alive'; + headerAt: 'Accept' put: '*/*' ] ] ]! - self displayProgress: 'Uploading ', aString during:[ - response := HTTPSocket - httpPut: stream contents - to: (self urlForFileNamed: aString) - user: self user - passwd: self password. - ]. - "More robust handling of HTTP responses. Instead of enumerating - all possible return codes and http versions, do a quick parse" - (response beginsWith: 'HTTP/') ifTrue:[ - "Looks like an HTTP header, not some error message" - statusLine := response copyUpTo: Character cr. - code := [(statusLine findTokens: ' ') second asInteger] on: Error do:[]. - ]. - (code isInteger and:[code between: 200 and: 299]) - ifFalse:[self error: response].!

1 0

The Trunk: Monticello-ul.728.mcz
by commits＠source.squeak.org 20 Sep '20

20 Sep '20

Levente Uzonyi uploaded a new version of Monticello to project The Trunk: http://source.squeak.org/trunk/Monticello-ul.728.mcz ==================== Summary ==================== Name: Monticello-ul.728 Author: ul Time: 20 September 2020, 9:32:46.305579 pm UUID: 8e7d9744-9b5a-4868-b645-2f817295ad7b Ancestors: Monticello-ul.727, Monticello-eem.727, Monticello-ct.727, Monticello-ul.726 Merged Monticello-ul.727, Monticello-ct.727, Monticello-ul.726. =============== Diff against Monticello-eem.727 =============== Item was added: + ----- Method: MCDirectoryRepository>>includesVersionNamed: (in category 'versions') ----- + includesVersionNamed: aString + + | comparable | + comparable := ((aString endsWith: '.mcz') and: [ aString size > 4 ]) + ifTrue: [ aString allButLast: 4 ] + ifFalse: [ aString ]. + allVersionNamesCache ifNil: [ + "Instead of reading the contents of the entire directory in #allVersionNames, look up a single .mcz file. + This is just an optimization. If the file does not exist, the version may still be there as an mcd." + (directory fileExists: comparable, '.mcz') ifTrue: [ ^true ] ]. + ^ self allVersionNames includes: comparable! Item was changed: MCFileBasedRepository subclass: #MCHttpRepository instanceVariableNames: 'location user password readerCache indexed webClient' + classVariableNames: 'URLRewriteRules UseSharedWebClientInstance' - classVariableNames: 'UseSharedWebClientInstance' poolDictionaries: '' category: 'Monticello-Repositories'! Item was changed: ----- Method: MCHttpRepository class>>creationTemplate (in category 'ui-support') ----- creationTemplate + ^self creationTemplateLocation: 'https://www.squeaksource.com/ProjectName' - ^self creationTemplateLocation: 'http://www.squeaksource.com/ProjectName' user: 'squeak' password: 'squeak' ! Item was added: + ----- Method: MCHttpRepository class>>rewriteUrl:forDownload: (in category 'url rewrite') ----- + rewriteUrl: aString forDownload: forDownload + + | result | + result := aString. + self urlRewriteRules groupsDo: [ :regexString :replacement :downloadOnly | + (forDownload or: [ downloadOnly not ]) ifTrue: [ + result := result copyWithRegex: regexString matchesReplacedWith: replacement ] ]. + ^result + + " + self assert: 'https://squeaksource.com/foo/bar?baz=1' = (self rewriteUrl: 'http://squeaksource.com/foo/bar?baz=1' forDownload: true). + self assert: 'https://squeaksource.com/foo/bar?baz=1' = (self rewriteUrl: 'https://squeaksource.com/foo/bar?baz=1' forDownload: true). + self assert: 'https://source.squeak.org/foo/bar?baz=1' = (self rewriteUrl: 'http://source.squeak.org/foo/bar?baz=1' forDownload: true). + self assert: 'https://source.squeak.org/foo/bar?baz=1' = (self rewriteUrl: 'https://source.squeak.org/foo/bar?baz=1' forDownload: true). + self assert: 'http://static.smalltalkhub.com/foo/bar?baz=1' = (self rewriteUrl: 'http://smalltalkhub.com/foo/bar?baz=1' forDownload: true). + self assert: 'http://smalltalkhub.com/foo/bar?baz=1' = (self rewriteUrl: 'http://smalltalkhub.com/foo/bar?baz=1' forDownload: false). + "! Item was added: + ----- Method: MCHttpRepository class>>urlRewriteRules (in category 'url rewrite') ----- + urlRewriteRules + + ^URLRewriteRules ifNil: [ + URLRewriteRules := #( + "Regex to be replaced" "static replacement string" "download only" + '^http\://source\.squeak\.org/' 'https://source.squeak.org/' false + '^http\://squeaksource\.com/' 'https://squeaksource.com/' false + '^http\://www.squeaksource\.com/' 'https://www.squeaksource.com/' false + '^http\://smalltalkhub.com/' 'http://static.smalltalkhub.com/' true + ) asOrderedCollection ]! Item was changed: ----- Method: MCHttpRepository>>httpGet:arguments: (in category 'private') ----- httpGet: url arguments: arguments + | urlString | - | progress urlString client response result | - progress := [ :total :amount | - HTTPProgress new - total: total; - amount: amount; - signal: 'Downloading...' ]. urlString := arguments ifNil: [ url ] ifNotNil: [ | queryString | queryString := WebUtils encodeUrlEncodedForm: arguments. (url includes: $?) ifTrue: [ url, '&', queryString ] ifFalse: [ url, '?', queryString ] ]. + urlString := self class rewriteUrl: urlString forDownload: true. + ^self webClientDo: [ :client | + client + username: self user; + password: self password; + httpGet: urlString do: [ :request | + request + headerAt: 'Authorization' put: 'Basic ', (self user, ':', self password) base64Encoded; + headerAt: 'Connection' put: 'Keep-Alive'; + headerAt: 'Accept' put: '*/*' ] ]! - self class useSharedWebClientInstance ifTrue: [ - "Acquire webClient by atomically storing it in the client variable and setting its value to nil." - client := webClient. - webClient := nil ]. - client - ifNil: [ client := WebClient new ] - ifNotNil: [ - "Attempt to avoid an error on windows by recreating the underlying stream." - client isConnected ifFalse: [ client close ] ]. - response := client - username: self user; - password: self password; - httpGet: urlString do: [ :request | - request - headerAt: 'Authorization' put: 'Basic ', (self user, ':', self password) base64Encoded; - headerAt: 'Connection' put: 'Keep-Alive'; - headerAt: 'Accept' put: '*/*' ]. - result := (response code between: 200 and: 299) - ifFalse: [ - response content. "Make sure content is read." - nil ] - ifTrue: [ (RWBinaryOrTextStream with: (response contentWithProgress: progress)) reset ]. - self class useSharedWebClientInstance - ifTrue: [ - "Save the WebClient instance for reuse, but only if there is no client cached." - webClient - ifNil: [ webClient := client ] - ifNotNil: [ client close ] ] - ifFalse: [ client close ]. - result ifNil: [ NetworkError signal: 'Could not access ', location ]. - ^result! Item was added: + ----- Method: MCHttpRepository>>webClientDo: (in category 'private') ----- + webClientDo: aBlock + + | client attemptsLeft response result | + self class useSharedWebClientInstance ifTrue: [ + "Acquire webClient by atomically storing it in the client variable and setting its value to nil." + client := webClient. + webClient := nil ]. + + client + ifNil: [ client := WebClient new ] + ifNotNil: [ + "Attempt to avoid an error by recreating the underlying stream." + client isConnected ifFalse: [ client close ] ]. + + attemptsLeft := 3. + response := nil. + [ response isNil and: [ attemptsLeft > 0 ] ] whileTrue: [ + response := [ aBlock value: client ] + on: NetworkError + do: [ :error | + attemptsLeft = 0 ifTrue: [ error pass ]. + (3 - attemptsLeft) seconds asDelay wait. + attemptsLeft := attemptsLeft - 1. + nil "The response" ] ]. + + result := (response code between: 200 and: 299) + ifFalse: [ + response content. "Make sure content is read." + nil ] + ifTrue: [ + (RWBinaryOrTextStream with: ( + response contentWithProgress: [ :total :amount | + HTTPProgress new + total: total; + amount: amount; + signal ])) reset ]. + + self class useSharedWebClientInstance + ifTrue: [ + "Save the WebClient instance for reuse, but only if there is no client cached." + webClient + ifNil: [ webClient := client ] + ifNotNil: [ client close ] ] + ifFalse: [ client close ]. + + result ifNil: [ NetworkError signal: 'Could not access ', location ]. + ^result! Item was changed: ----- Method: MCHttpRepository>>writeStreamForFileNamed:replace:do: (in category 'private') ----- writeStreamForFileNamed: aString replace: ignoreBoolean do: aBlock + + | stream urlString | - | stream response statusLine code | stream := RWBinaryOrTextStream on: String new. aBlock value: stream. + urlString := self urlForFileNamed: aString. + urlString := self class rewriteUrl: urlString forDownload: false. + ^self displayProgress: 'Uploading ', aString during: [ + self webClientDo: [ :client | + client + username: self user; + password: self password; + httpPut: urlString + content: stream contents + type: nil + do: [ :request | + request + headerAt: 'Authorization' put: 'Basic ', (self user, ':', self password) base64Encoded; + headerAt: 'Connection' put: 'Keep-Alive'; + headerAt: 'Accept' put: '*/*' ] ] ]! - self displayProgress: 'Uploading ', aString during:[ - response := HTTPSocket - httpPut: stream contents - to: (self urlForFileNamed: aString) - user: self user - passwd: self password. - ]. - "More robust handling of HTTP responses. Instead of enumerating - all possible return codes and http versions, do a quick parse" - (response beginsWith: 'HTTP/') ifTrue:[ - "Looks like an HTTP header, not some error message" - statusLine := response copyUpTo: Character cr. - code := [(statusLine findTokens: ' ') second asInteger] on: Error do:[]. - ]. - (code isInteger and:[code between: 200 and: 299]) - ifFalse:[self error: response].! Item was changed: ----- Method: MCTool>>buildWith: (in category 'toolbuilder') ----- buildWith: builder | windowBuilder | windowBuilder := MCToolWindowBuilder builder: builder tool: self. self widgetSpecs do: [:spec | | send fractions offsets | send := spec first. fractions := (spec at: 2 ifAbsent: [#(0 0 1 1)]) copy. offsets := (spec at: 3 ifAbsent: [#(0 0 0 0)]) copy. + fractions withIndexDo: [:numberOrSymbol :index | - fractions doWithIndex: [:numberOrSymbol :index | numberOrSymbol isSymbol ifTrue: [fractions at: index put: (self perform: numberOrSymbol)]]. + offsets withIndexDo: [:numberOrSymbol :index | - offsets doWithIndex: [:numberOrSymbol :index | numberOrSymbol isSymbol ifTrue: [offsets at: index put: (self perform: numberOrSymbol)]]. windowBuilder frame: (LayoutFrame fractions: (fractions first @ fractions second corner: fractions third @ fractions fourth) offsets: (offsets first @ offsets second corner: offsets third @ offsets fourth)). windowBuilder perform: send first withArguments: send allButFirst]. ^ windowBuilder build ! Item was changed: ----- Method: MCVersionName>>versionName (in category 'accessing') ----- versionName "Answer my version name as a ByteString, without the file suffix or any ancestor-attributes." | end | self isEmpty ifTrue: [^ String empty]. end := self indexOf: $( ifAbsent: [ + | size | + size := self size. + (size > 4 + and: [ (self at: size - 3) == $. + and: [ (self at: size - 2) == $m + and: [ (self at: size - 1) == $c ] ] ]) + ifTrue: [size - 3] + ifFalse: [size + 1]]. - (self size > 4 - and: [ (self at: self size - 3) == $. - and: [ (self at: self size - 2) == $m - and: [ (self at: self size - 1) == $c ] ] ]) - ifTrue: [self size - 3] - ifFalse: [self size + 1]]. ^self first: end - 1!

1 0

The Trunk: System-eem.1173.mcz
by commits＠source.squeak.org 19 Sep '20

19 Sep '20

Eliot Miranda uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-eem.1173.mcz ==================== Summary ==================== Name: System-eem.1173 Author: eem Time: 19 September 2020, 1:33:05.549281 pm UUID: 9d302aad-a895-4450-aa3d-e71424ed4916 Ancestors: System-dtl.1172 Add an accessor for the last deferred ui message. =============== Diff against System-dtl.1172 =============== Item was added: + ----- Method: Project>>lastDeferredUIMessage (in category 'scheduling & debugging') ----- + lastDeferredUIMessage + "Answer the most recently scheduled deferredUIMessage." + + self subclassResponsibility!

1 0

The Trunk: Morphic-eem.1685.mcz
by commits＠source.squeak.org 19 Sep '20

19 Sep '20

Eliot Miranda uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-eem.1685.mcz ==================== Summary ==================== Name: Morphic-eem.1685 Author: eem Time: 19 September 2020, 1:31:52.065024 pm UUID: 6f1a278a-cc16-4e8a-bf3d-487a98cb4b68 Ancestors: Morphic-eem.1684 Add an accessor for the last deferred ui message. =============== Diff against Morphic-eem.1684 =============== Item was added: + ----- Method: MorphicProject>>lastDeferredUIMessage (in category 'scheduling & debugging') ----- + lastDeferredUIMessage + "Answer the most recently scheduled deferredUIMessage." + + ^WorldState lastDeferredUIMessage!

1 0

The Trunk: Morphic-eem.1684.mcz
by commits＠source.squeak.org 19 Sep '20

19 Sep '20

Eliot Miranda uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-eem.1684.mcz ==================== Summary ==================== Name: Morphic-eem.1684 Author: eem Time: 19 September 2020, 1:29:54.075008 pm UUID: 80c69f47-1bc8-4764-9b48-4aa3ff8b40c9 Ancestors: Morphic-mt.1683 Add an accessor for the last deferred ui message. =============== Diff against Morphic-mt.1683 =============== Item was added: + ----- Method: WorldState class>>lastDeferredUIMessage (in category 'class initialization') ----- + lastDeferredUIMessage + "Answer the most recently scheduled deferredUIMessage." + + ^self deferredUIMessages peekLast!

1 0

The Trunk: ST80-eem.260.mcz
by commits＠source.squeak.org 19 Sep '20

19 Sep '20

Eliot Miranda uploaded a new version of ST80 to project The Trunk: http://source.squeak.org/trunk/ST80-eem.260.mcz ==================== Summary ==================== Name: ST80-eem.260 Author: eem Time: 19 September 2020, 1:29:16.901184 pm UUID: 5da36bad-2b6f-4f3f-8cd2-bc339dd22b4f Ancestors: ST80-mt.259 Add an accessor for the last deferred ui message. =============== Diff against ST80-mt.259 =============== Item was added: + ----- Method: ControlManager class>>lastDeferredUIMessage (in category 'class initialization') ----- + lastDeferredUIMessage + "Answer the most recently scheduled deferredUIMessage." + + ^self deferredActionQueue peekLast! Item was added: + ----- Method: MVCProject>>lastDeferredUIMessage (in category 'scheduling & debugging') ----- + lastDeferredUIMessage + "Answer the most recently scheduled deferredUIMessage." + + ^ControlManager lastDeferredUIMessage!

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Packages September 2020