Squeak-dev December 2019

squeak-dev@lists.squeakfoundation.org

32 participants
256 discussions

BUG/REGRESSION while debugging Generator >> #nextPut:
by Thiede, Christoph 15 Nov '21

15 Nov '21

Hi all, I discovered a bug when stepping over a call to Generator >> #nextPut:. !! Save your image before trying the following !! Generator on: [:stream | stream nextPut: #foo] [cid:95952b5e-98f1-4447-bd09-29d396961281] 1. Due to multiprocessing implementation of the Generator, pressing over will hang up the current process forever, because the generator is never queried. 2. If I press cmd-dot, I get an infinite number of debugger windows that show Context >> #cannotReturn:. This will probably damage your image. The first is annoying for newcomers, but I see this behavior is reasonable and without the effect of the second, it wouldn't be a big problem. The second, however, looks like a bigger issue to me. Actually, I think the most serious aspect is that in Squeak 5.1, the same procedure does not crash your image, but you are forwarded to the emergency debugger and can terminate the process: [cid:c8eee8c3-d2de-49c0-b5d4-33bd340d6c98] [cid:6044ecf2-91ab-4f6e-b863-b980586868e9] Also, this is not the first scenario in the last time where I got an infinite debugger chain. See [BUG(s)] in Context control (#jump, #runUntilErrorOrReturnFrom:)<http://forum.world.st/BUG-s-in-Context-control-jump-runUntilErrorOrReturnFr…> for a similar issue. And there were even more situations which I could not yet reproduce exactly. I'm afraid that the recent changes to the debuggers might have weakened its ability to detect recursive errors. Can someone else tell about these problems? I suppose we ignore a large number of recursive errors as in MorphicDebugger >> #openOn:context:label:contents:fullView:, the uiBlock is often triggered as a separate UI message which will be executed after the recursion flag has been cleared by the base class. Would be great if someone could have a look at it or share more information :) Best, Christoph

8 25

The Trunk: Kernel-mt.1244.mcz
by commits＠source.squeak.org 13 Sep '21

13 Sep '21

Marcel Taeumel uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-mt.1244.mcz ==================== Summary ==================== Name: Kernel-mt.1244 Author: mt Time: 12 July 2019, 9:59:41.866568 am UUID: d585f898-09cc-094b-98ed-a74204c82019 Ancestors: Kernel-mt.1243 Refactoring of #literalsDo: - Step 2 of 3. For more information, see http://forum.world.st/Please-Review-Refactoring-for-literalsDo-etc-tp509975…. =============== Diff against Kernel-mt.1243 =============== Item was removed: - ----- Method: AdditionalMethodState>>hasLiteralSuchThat: (in category 'testing') ----- - hasLiteralSuchThat: aBlock - "Answer true if litBlock returns true for any literal in this array, even if embedded in further array structure. - This method is only intended for private use by CompiledMethod hasLiteralSuchThat:" - 1 to: self basicSize do: [:i | - | propertyOrPragma "<Association|Pragma>" | - propertyOrPragma := self basicAt: i. - (propertyOrPragma isVariableBinding - ifTrue: [(aBlock value: propertyOrPragma key) - or: [(aBlock value: propertyOrPragma value) - or: [propertyOrPragma value isArray - and: [propertyOrPragma value hasLiteralSuchThat: aBlock]]]] - ifFalse: [propertyOrPragma hasLiteralSuchThat: aBlock]) ifTrue: - [^true]]. - ^false! Item was removed: - ----- Method: CompiledBlock>>allLiterals (in category 'literals') ----- - allLiterals - ^self homeMethod allLiterals! Item was removed: - ----- Method: CompiledBlock>>allSubLiterals (in category 'literals') ----- - allSubLiterals - | literalsExceptOuter unfoldedSubLiterals | - literalsExceptOuter := self literals allButLast. - unfoldedSubLiterals := literalsExceptOuter - select: [:lit| lit isCompiledCode] - thenCollect: [:blockMethod| blockMethod allSubLiterals]. - unfoldedSubLiterals ifEmpty: - [^literalsExceptOuter]. - ^literalsExceptOuter, (unfoldedSubLiterals fold: [:a :b| a, b])! Item was added: + ----- Method: CompiledBlock>>codeLiteralsDo: (in category 'literals') ----- + codeLiteralsDo: aBlock + "Overwritten to not cause infinite loop." + + aBlock value: self. + + self literalsDo: [:literal | + (literal isCompiledCode and: [literal ~~ self outerCode]) ifTrue: [ + literal codeLiteralsDo: aBlock]].! Item was removed: - ----- Method: CompiledBlock>>hasLiteral: (in category 'literals') ----- - hasLiteral: literal - "Answer whether the receiver references the argument, literal." - 2 to: self numLiterals do: "exclude outerCode" - [:index | | lit | - lit := self objectAt: index. - (lit literalEqual: literal) ifTrue: - [^true]. - (lit isCompiledCode and: [lit hasLiteral: literal]) ifTrue: - [^true]]. - ^false! Item was removed: - ----- Method: CompiledBlock>>hasLiteralSuchThat: (in category 'literals') ----- - hasLiteralSuchThat: litBlock - "Answer true if litBlock returns true for any literal in this method, even if embedded in array structure." - 2 to: self numLiterals do: "exclude outerCode" - [:index | | lit | - lit := self objectAt: index. - ((litBlock value: lit) - or: [(lit isArray or: [lit isCompiledCode]) and: [lit hasLiteralSuchThat: litBlock]]) ifTrue: - [^true]]. - ^false! Item was changed: ----- Method: CompiledCode>>allLiterals (in category 'literals') ----- allLiterals + "Skip compiled-code objects. Keep literal arrays, bindings, etc." + + ^ Array streamContents: [:result | + self allLiteralsDo: [:literal | result nextPut: literal]]! - self subclassResponsibility! Item was added: + ----- Method: CompiledCode>>allLiteralsDo: (in category 'literals') ----- + allLiteralsDo: aBlock + "Enumerate all literals thoroughly. Follow nested instances of CompiledCode. Do not treat compiled code as literals here." + + self codeLiteralsDo: [:compiledCode | compiledCode literalsDo: [:literal | + literal isCompiledCode ifFalse: [literal allLiteralsDo: aBlock] ]]. + + "Enumerate special selectors." + self flag: #todo. + + "Enumerate special literals such as true and false." + self flag: #todo.! Item was added: + ----- Method: CompiledCode>>codeLiterals (in category 'literals') ----- + codeLiterals + + ^ Array streamContents: [:stream | + self codeLiteralsDo: [:compiledCode | stream nextPut: compiledCode]]! Item was added: + ----- Method: CompiledCode>>codeLiteralsDo: (in category 'literals') ----- + codeLiteralsDo: aBlock + "Enumerate all literals that represent instances of CompiledCode. This is especially required for SistaV1." + + aBlock value: self. + + self literalsDo: [:literal | literal isCompiledCode ifTrue: [ + literal codeLiteralsDo: aBlock]].! Item was added: + ----- Method: CompiledCode>>hasLiteral: (in category 'literals') ----- + hasLiteral: aLiteral + "Since we cannot enumerate this code's special literals, we have to overwrite this method to invoke the encoder scanner explicitely." + + | scanBlock | + (super hasLiteral: aLiteral) ifTrue: [^ true]. + + scanBlock := self class + scanBlocksForLiteral: aLiteral + do: [:primaryScanner :secondaryScanner | + "E.g., scanner for SistaV1 or scanner for V3PlusClosures" + self signFlag ifTrue: [secondaryScanner] ifFalse: [primaryScanner]]. + + self codeLiteralsDo: [:compiledCode | + (compiledCode scanFor: scanBlock) ifTrue: [^ true]]. + + ^ false! Item was added: + ----- Method: CompiledCode>>hasMethodReturn (in category 'testing') ----- + hasMethodReturn + "Answer whether the receiver has a method-return ('^') in its code." + + | scanner | + self codeLiteralsDo: [:compiledCode | + scanner := InstructionStream on: compiledCode. + (scanner scanFor: [:x | (scanner willReturn + and: [scanner willBlockReturn not]) + "and: [scanner willReturnTopFromMethod not]" "-> Not supported in EncoderForSistaV1"]) + ifTrue: [^ true]]. + ^ false! Item was added: + ----- Method: CompiledCode>>isQuick (in category 'testing') ----- + isQuick + + self subclassResponsibility.! Item was changed: ----- Method: CompiledCode>>literals (in category 'literals') ----- literals + + ^ Array streamContents: [:result | + self literalsDo: [:lit | result nextPut: lit]]! - "Answer an Array of the literals referenced by the receiver." - | literals numberLiterals | - literals := Array new: (numberLiterals := self numLiterals). - 1 to: numberLiterals do: - [:index | - literals at: index put: (self objectAt: index + 1)]. - ^literals! Item was added: + ----- Method: CompiledCode>>literalsDo: (in category 'literals') ----- + literalsDo: aBlock + "Evaluate aBlock for each of the literals referenced by the receiver. Note that this (raw) enumeration addresses *all* objects stored *after* the method header and *before* the first byte code. If you require a deep and meaningful enumeration of literals use #allLiteralsDo: or #codeLiteralsDo:." + + 1 to: self numLiterals do: [:index | + aBlock value: (self literalAt: index)].! Item was changed: ----- Method: CompiledCode>>messages (in category 'scanning') ----- messages "Answer a Set of all the message selectors sent by this method." + | result | + result := Set new. + self messagesDo: [:selector | result add: selector]. + ^ result! - | encoderClass scanner aSet | - encoderClass := self encoderClass. - aSet := Set new. - scanner := InstructionStream on: self. - scanner scanFor: [ :x | - | selector | - (selector := encoderClass selectorToSendOrItselfFor: scanner in: self at: scanner pc) == scanner - ifFalse: - [aSet add: selector] - ifTrue: - [(encoderClass blockMethodOrNilFor: scanner in: self at: scanner pc) ifNotNil: - [:blockMethod| aSet addAll: blockMethod messages]]. - false "keep scanning" ]. - ^aSet! Item was added: + ----- Method: CompiledCode>>messagesDo: (in category 'scanning') ----- + messagesDo: workBlock + "Evaluate aBlock with all the message selectors sent by me. Duplicate sends possible." + + | scanner selector | + self isQuick ifTrue: [^ self]. + + self codeLiteralsDo: [:compiledCode | + scanner := InstructionStream on: compiledCode. + scanner scanFor: [ :x | + (selector := scanner selectorToSendOrSelf) == scanner + ifFalse: [workBlock value: selector]. + false "keep scanning" ] ].! Item was removed: - ----- Method: CompiledCode>>messagesDo:encoderClass:visitedSet: (in category 'private') ----- - messagesDo: aBlock encoderClass: encoderClass visitedSet: visitedSet - "The inner engine for messagesDo:" - - | scanner | - scanner := InstructionStream on: self. - scanner scanFor: [ :x | - | selector | - (selector := encoderClass selectorToSendOrItselfFor: scanner in: self at: scanner pc) == scanner - ifFalse: - [(visitedSet ifAbsentAdd: selector) ifTrue: - [aBlock value: selector]] - ifTrue: - [(encoderClass blockMethodOrNilFor: scanner in: self at: scanner pc) ifNotNil: - [:blockMethod| - blockMethod messagesDo: aBlock encoderClass: encoderClass visitedSet: visitedSet]]. - false "keep scanning" ]! Item was removed: - ----- Method: CompiledCode>>refersTo:bytecodeScanner:thorough: (in category 'literals') ----- - refersTo: literal bytecodeScanner: scanBlockOrNil thorough: thorough - "Answer if the receiver refers to the literal. If the scan block is non-nil, then - use it to find the literal in bytecode. If thorough is true, dive down into - literal arrays and method properties to locate references to the literal there-in." - 2 to: (self isCompiledBlock - ifTrue: [self numLiterals] "exclude outerCode or methodClass" - ifFalse: [self numLiterals - 1]) "exclude selector/properties and methodClass" - do: [:i| | lit | - lit := self objectAt: i. - (literal == lit or: [literal literalEqual: lit]) ifTrue: [^true]. "== for Float bindingOf: #NaN since NaN ~= NaN" - lit isCompiledCode - ifTrue: - [(lit refersTo: literal bytecodeScanner: scanBlockOrNil thorough: thorough) ifTrue: - [^true]] - ifFalse: - [thorough ifTrue: - [lit isVariableBinding - ifTrue: - [literal == lit key ifTrue: [^true]] - ifFalse: - [(lit isArray - and: [(lit hasLiteral: literal) - or: [literal isVariableBinding - and: [literal key isSymbol - and: [lit hasLiteral: literal key]]]]) ifTrue: - [^true]]]]]. - scanBlockOrNil ifNotNil: - [(self scanFor: scanBlockOrNil) ifTrue: - [^true]]. - ^false! Item was removed: - ----- Method: CompiledCode>>refersTo:primaryBytecodeScanner:secondaryBytecodeScanner:thorough: (in category 'literals') ----- - refersTo: literal primaryBytecodeScanner: primaryScanBlockOrNil secondaryBytecodeScanner: secondaryScanBlockOrNil thorough: thorough - "Answer if the receiver refers to the literal. If the scan blocks are non-nil, then - use them to find the literal in bytecode. If thorough is true, dive down into - literal arrays and method properties to locate references to the literal there-in." - ^self - refersTo: literal - bytecodeScanner: (self signFlag - ifTrue: [secondaryScanBlockOrNil] - ifFalse: [primaryScanBlockOrNil]) - thorough: thorough! Item was changed: ----- Method: CompiledCode>>scanFor: (in category 'scanning') ----- scanFor: byteOrClosure "Answer whether the receiver contains the argument as a bytecode, if it is a number, or evaluates to true if a block. If a block it can take from one to four bytes." | s end | ^(s := InstructionStream on: self) scanFor: (byteOrClosure isBlock ifTrue: [byteOrClosure numArgs caseOf: { [1] -> [byteOrClosure]. [2] -> [[:byte| byteOrClosure value: byte value: s secondByte]]. [3] -> [end := self endPC - 2. [:byte| s pc <= end and: [byteOrClosure value: byte value: s secondByte value: s thirdByte]]]. [4] -> [end := self endPC - 3. [:byte| s pc <= end and: [byteOrClosure value: byte value: s secondByte value: s thirdByte value: s fourthByte]]] }] ifFalse: [[:instr | instr = byteOrClosure]]) " + SystemNavigation default browseAllSelect: [:m | m scanFor: 134] - Smalltalk browseAllSelect: [:m | m scanFor: 134] "! Item was added: + ----- Method: CompiledCode>>sendsMessage: (in category 'testing') ----- + sendsMessage: aSelector + + self messagesDo: [:selector | + selector = aSelector ifTrue: [^ true]]. + ^ false! Item was added: + ----- Method: CompiledCode>>sendsSelector: (in category 'testing') ----- + sendsSelector: aSelector + + self flag: #todo. "mt: Deprecate? AST/Refactoring project needs it..." + ^ self sendsMessage: aSelector! Item was added: + ----- Method: CompiledCode>>sendsToSuper (in category 'testing') ----- + sendsToSuper + "Answer whether the receiver sends any message to super." + + | scanner | + self codeLiteralsDo: [:compiledCode | + scanner := InstructionStream on: compiledCode. + (scanner scanFor: (self encoderClass superSendScanBlockUsing: scanner)) + ifTrue: [^ true]]. + ^ false! Item was removed: - ----- Method: CompiledMethod>>allLiterals (in category 'literals') ----- - allLiterals - | literals unfoldedSubLiterals | - literals := self literals. - unfoldedSubLiterals := literals - select: [:lit| lit isCompiledCode] - thenCollect: [:blockMethod| blockMethod allSubLiterals]. - unfoldedSubLiterals ifEmpty: - [^literals]. - ^literals, (unfoldedSubLiterals fold: [:a :b| a, b])! Item was added: + ----- Method: CompiledMethod>>allLiteralsDo: (in category 'literals') ----- + allLiteralsDo: aBlock + "Overwritten to skip certain (raw) literals." + + " Exclude method selector (or properties) and the method's class." + 1 to: self numLiterals - 2 do: [:index | + (self literalAt: index) allLiteralsDo: aBlock]. + + "Enumerate method selector only through additional method state." + self penultimateLiteral isMethodProperties + ifTrue: [self penultimateLiteral allLiteralsDo: aBlock]. + + "Enumerate special selectors." + self flag: #todo. + + "Enumerate special literals such as true and false." + self flag: #todo.! Item was removed: - ----- Method: CompiledMethod>>hasLiteral: (in category 'literals') ----- - hasLiteral: literal - "Answer whether the receiver references the argument, literal." - 2 to: self numLiterals - 1 do: "exclude selector/properties & methodClass" - [:index | | lit | - lit := self objectAt: index. - (lit literalEqual: literal) ifTrue: - [^true]. - (lit isCompiledCode and: [lit hasLiteral: literal]) ifTrue: - [^true]]. - ^false! Item was removed: - ----- Method: CompiledMethod>>hasLiteralSuchThat: (in category 'literals') ----- - hasLiteralSuchThat: litBlock - "Answer true if litBlock returns true for any literal in this method, even if embedded in array structure." - (self penultimateLiteral isMethodProperties - and: [self penultimateLiteral hasLiteralSuchThat: litBlock]) ifTrue: - [^true]. - 2 to: self numLiterals + 1 do: - [:index | | lit | - lit := self objectAt: index. - ((litBlock value: lit) - or: [(lit isArray or: [lit isCompiledCode]) and: [lit hasLiteralSuchThat: litBlock]]) ifTrue: - [^true]]. - ^false! Item was removed: - ----- Method: CompiledMethod>>hasLiteralThorough: (in category 'literals') ----- - hasLiteralThorough: literal - "Answer true if any literal in this method is literal, - even if embedded in array structure." - - (self penultimateLiteral isMethodProperties - and: [self penultimateLiteral hasLiteralThorough: literal]) ifTrue:[^true]. - 2 to: self numLiterals - 1 "exclude superclass + selector/properties" - do:[:index | | lit | - (((lit := self objectAt: index) literalEqual: literal) - or: [(lit isVariableBinding and: [lit key == literal]) - or: [lit isArray and: [lit hasLiteral: literal]]]) ifTrue: - [^ true]]. - ^ false ! Item was removed: - ----- Method: CompiledMethod>>literalsDo: (in category 'literals') ----- - literalsDo: aBlock - "Evaluate aBlock for each of the literals referenced by the receiver." - 1 to: self numLiterals do: - [:index | - aBlock value: (self objectAt: index + 1)]! Item was removed: - ----- Method: CompiledMethod>>messages (in category 'scanning') ----- - messages - "Answer a Set of all the message selectors sent by this method." - - | scanner aSet | - aSet := Set new. - scanner := InstructionStream on: self. - scanner scanFor: [ :x | - | selector | - (selector := scanner selectorToSendOrSelf) == scanner ifFalse: [ - aSet add: selector ]. - false "keep scanning" ]. - ^aSet! Item was removed: - ----- Method: CompiledMethod>>messagesDo: (in category 'scanning') ----- - messagesDo: aBlock - "Evaluate aBlock exactly once with all the message selectors sent by me." - - self isQuick ifFalse: - [self messagesDo: aBlock - encoderClass: self encoderClass - visitedSet: IdentitySet new]! Item was changed: ----- Method: CompiledMethod>>messagesSequence (in category 'scanning') ----- messagesSequence - "Answer a Set of all the message selectors sent by this method." + self flag: #todo. "mt: Better change #messages to return an array instead of a set?" + ^ self messages asArray! - ^Array streamContents: - [:str| | scanner | - scanner := InstructionStream on: self. - scanner scanFor: - [:x | | selectorOrSelf | - (selectorOrSelf := scanner selectorToSendOrSelf) == scanner ifFalse: - [str nextPut: selectorOrSelf]. - false "keep scanning"]]! Item was changed: ----- Method: CompiledMethod>>objectForDataStream: (in category 'file in/out') ----- objectForDataStream: refStrm + "Reconfigure pragma. Example: #(#FFTPlugin #primitiveFFTTransformData 0 0). See FFT >> #pluginTransformData:." + + self primitive = 117 ifTrue: [(self literalAt: 1) at: 4 put: 0].! - - self primitive = 117 ifTrue: [self literals first at: 4 put: 0]. - ! Item was changed: ----- Method: CompiledMethod>>readsField: (in category 'scanning') ----- readsField: varIndex + "Answer whether the receiver loads the instance variable indexed by the argument." + - "Answer whether the receiver loads the instance variable indexed by the argument." | varIndexCode scanner | varIndexCode := varIndex - 1. + self isQuick ifTrue: [^ self isReturnField and: [self returnField = varIndexCode]]. + + self codeLiteralsDo: [:compiledCode | + scanner := InstructionStream on: compiledCode. + (scanner scanFor: (self encoderClass instVarReadScanBlockFor: varIndexCode using: scanner)) + ifTrue: [^ true]]. + + ^ false! - self isQuick ifTrue: - [^self isReturnField and: [self returnField = varIndexCode]]. - scanner := InstructionStream on: self. - ^scanner scanFor:(self encoderClass instVarReadScanBlockFor: varIndexCode using: scanner)! Item was changed: ----- Method: CompiledMethod>>readsRef: (in category 'scanning') ----- readsRef: variableBinding "Answer whether the receiver reads the value of the argument." "eem 5/24/2008 Rewritten to no longer assume the compler uses the most compact encoding available (for EncoderForLongFormV3 support)." + | litIndex scanner | + (litIndex := self indexOfLiteral: variableBinding) = 0 + ifTrue: [^false]. + + self codeLiteralsDo: [:compiledCode | + scanner := InstructionStream on: compiledCode. + (scanner scanFor: (self encoderClass bindingReadScanBlockFor: litIndex - 1 using: scanner)) + ifTrue: [^ true]]. + + ^ false! - (litIndex := self indexOfLiteral: variableBinding) = 0 ifTrue: - [^false]. - scanner := InstructionStream on: self. - ^scanner scanFor: (self encoderClass bindingReadScanBlockFor: litIndex - 1 using: scanner)! Item was removed: - ----- Method: CompiledMethod>>refersToLiteral: (in category 'literals') ----- - refersToLiteral:aLiteral - - ^self hasLiteral: aLiteral.! Item was removed: - ----- Method: CompiledMethod>>sendsSelector: (in category 'literals') ----- - sendsSelector: aSelector - | scanner | - scanner := InstructionStream on: self. - scanner scanFor: - [:x | - scanner selectorToSendOrSelf == aSelector ifTrue: - [^true]. - false "keep scanning"]. - ^false! Item was removed: - ----- Method: CompiledMethod>>sendsToSuper (in category 'scanning') ----- - sendsToSuper - "Answer whether the receiver sends any message to super." - | scanner | - scanner := InstructionStream on: self. - ^scanner scanFor: (self encoderClass superSendScanBlockUsing: scanner)! Item was changed: ----- Method: CompiledMethod>>writesField: (in category 'scanning') ----- writesField: varIndex + "Answer whether the receiver stores into the instance variable indexed by the argument." - "Answer whether the receiver stores into the instance variable indexed - by the argument." + | varIndexCode scanner | + self isQuick ifTrue: [^ false]. + varIndexCode := varIndex - 1. + + self codeLiteralsDo: [:compiledCode | + scanner := InstructionStream on: compiledCode. + (scanner scanFor: (self encoderClass instVarWriteScanBlockFor: varIndex - 1 using: scanner)) + ifTrue: [^ true]]. + + ^ false! - | scanner | - self isQuick ifTrue: [^false]. - scanner := InstructionStream on: self. - ^scanner scanFor: (self encoderClass instVarWriteScanBlockFor: varIndex - 1 using: scanner)! Item was changed: ----- Method: CompiledMethod>>writesRef: (in category 'scanning') ----- writesRef: variableBinding "Answer whether the receiver writes the value of the argument." "eem 5/24/2008 Rewritten to no longer assume the compler uses the most compact encoding available (for EncoderForLongFormV3 support)." + | litIndex scanner | + (litIndex := self indexOfLiteral: variableBinding) = 0 + ifTrue: [^ false]. + + self codeLiteralsDo: [:compiledCode | + scanner := InstructionStream on: compiledCode. + (scanner scanFor: (self encoderClass bindingWriteScanBlockFor: litIndex - 1 using: scanner)) + ifTrue: [^ true]]. + + ^ false! - (litIndex := self indexOfLiteral: variableBinding) = 0 ifTrue: - [^false]. - scanner := InstructionStream on: self. - ^scanner scanFor: (self encoderClass bindingWriteScanBlockFor: litIndex - 1 using: scanner)! Item was removed: - ----- Method: Pragma>>hasLiteralSuchThat: (in category 'testing') ----- - hasLiteralSuchThat: aBlock - "Answer true if litBlock returns true for any literal in the receiver, even if embedded in further array structure. - This method is only intended for private use by CompiledMethod hasLiteralSuchThat:" - ^(aBlock value: keyword) - or: [arguments hasLiteralSuchThat: aBlock]!

2 1

Announcement: Spelling services
by Tim Felgentreff 23 Aug '21

23 Aug '21

Hi Once upon a time, John M. McIntosh built a spellchecker plugin for the MacVM and there was a fileout that added a spelling service class to use it from Squeak. We have added code to provide the same API (for now) to windows and linux users that have ispell (or a compatible program, like aspell) installed on their systems using system callouts. A metacello configuration is available from the MetacelloRepository on Squeaksource, ConfigurationOfSpellingServices. The development repository is at http://www.hpi.uni-potsdam.de/hirschfeld/squeaksource/SpellingServices.html, the repo has global read+write, so if anybody finds this useful and has changes, feel free to commit to that repository. -Tim

6 8

[BUG(s)] in Context control (#jump, #runUntilErrorOrReturnFrom:)
by Thiede, Christoph 17 May '21

17 May '21

Hi all, I would like to report a bug I found related to debugging the debugger. I actually found the issue when debugging the context simulation of "Over", but let's start with a simple example. Scenario 1 Steps to reproduce: * (Save your image, if it contained any valuable information.) * Type the following into a Workspace: x := 5. thisContext insertSender: (Context contextEnsure: [x := 4]). * Debug it and step: * (into) #contextEnsure * (through) #ensure: * (into) #jump * step over the implementation, and press (into) while returning. Expected behavior: The same should happen as if you would not debug, but normally do the code: It should run without raising any error, and x should finally contain the value 4. Actual behavior: * In Trunk: * An infinite chain of debuggers appears, making it impossible to reuse the image. If you gain the chance to see any debugger, or to receive a non-empty debug log, you can see there is #errorSubscriptBounds: called from within a context. However, it is not possible to find out the complete stack of this error. (At least, I did not manage after a few attempts.) * In Squeak 5.1 (Note: You will need to replace here with MethodContext, for compatibility): * The same error is raised, but instead of endless debuggers, you get endless emergency evaluators: [cid:2c2ee09f-1f81-4969-a2af-0fac1c093119] Workaround: Modify the #contextEnsure: implementation in the following way: [cid:02411c12-9a78-40fe-a3b3-c7f8357c133d] Reason: As the comment in Context>>#jump states, the receiver context "MUST BE a top context (ie. a suspended context or a abandoned [sic] context that was jumped out of)", which, in particular, "already has its return value on its stack".1 However, in the #contextEnsure: example, ctxt is not a top context because is it still running, and on its top, it does not have a return value but the closure vector2 {ctxt. chain}. This leads to the fact that #jump pops away this closure vector so that any attempt to access this vector will result in Context>>#at: to call #errorSubscriptBounds:. I'm not sure where this attempt is made actually, but I suppose each debugger's ContextVariableInspector could do this and so raise another debugger and so forth ... Considerations: A simple solution would be the workaround presented above. However, we would not only need to patch #contextOn:do: the same way, we also wondered why the same problem does not also has had any visible impacts on the other senders of #jump in past, which are #restart and #runUntilErrorOrReturnFrom:. The first refreshes the context and then jumps into it, and from theory, I think it should be possible to call it from a foreign sender in a similar minimal example in order to invalidate the context register. However, I did not manage to construct an appropriate example yet. The same goes for #runUntilErrorOrReturnFrom:, because when "here jump" is executed, "here" again is neither a sender of the block context, nor it has is return value on stack. In a nutshell, to us, it has been keeping an open question so far whether the other senders of #jump are legitime. Should we maybe add a method like "Context >> jumpWith: aReturnValue" which would push aReturnValue on the receiver first and then perform the jump? Or could this have any negative impacts if there is indeed already a return value on stack of the receiver? Scenario 2 Steps to reproduce: The same as Scenario 1, but instead of stepping into #jump, just step over it. Expected behavior: The same expected behavior as in Scenario 1. Actual behavior: (diff to Actual behavior of Scenario 1 highlighted for ease of reading) * In Trunk: * An infinite chain of debuggers appears, making it impossible to reuse the image. If you gain the chance to see any debugger, or to receive a non-empty debug log, you can see there is #cannotReturn:to: called from within a new process. * In Squeak 5.1 (Note: You will need to replace here with MethodContext, for compatibility): * The same error is raised, but instead of endless debuggers, you get endless emergency evaluators: [cid:f7412be3-907b-441a-8a7e-889cbc88f1cd] Note: This issue continues to exist after applying the workaround patch from Scenario 1. Reason: No idea. After applying the workaround from above, I tried to debug #doStep before stepping over the #jump per button, but this lead me to some kind of infinite loop: When I debug the whole debugging logic via Process>>#completeStep: and Process>>#complete: down to Context>>#runUntilErrorOrReturnFrom: and there step *into* the "self jump" statement, the error does not occur. When I step *over* this line instead, the same error occurs. I also tried to debug that #doStep in the second debugger window again, but this bug seems to be a real Heisenbug - it only occurs when you do *not* step into the relevant #jump call. Considerations: As mentioned above, we also could not yet explain whether all calls to #jump in #runUntilErrorOrReturnFrom: are valid with regard to the "return value on stack" precondition. Maybe there is a connection? We will keep investigating the issue, but any help is appreciated, of course! 1 I'm afraid the example method "Interpreter>>primitiveSuspend" further mentioned in the comment does no longer exist. 2 Is "closure vector" an official term? If not, what would be the official term? :) Best, Christoph

3 4

The Inbox: Morphic-ct.1586.mcz
by commits＠source.squeak.org 01 May '21

01 May '21

A new version of Morphic was added to project The Inbox: http://source.squeak.org/inbox/Morphic-ct.1586.mcz ==================== Summary ==================== Name: Morphic-ct.1586 Author: ct Time: 10 November 2019, 4:06:17.228559 pm UUID: d752eb23-2116-0945-b043-aff08fed94fd Ancestors: Morphic-mt.1584 Proposal: Style printIt results as a pluggable link that can be clicked to inspect the result. To enable this behavior, this commit also extends #insertAndSelect:at: to allow for inserting both strings and texts. =============== Diff against Morphic-mt.1584 =============== Item was changed: ----- Method: PluggableTextMorph>>printIt (in category 'menu commands') ----- printIt | oldEditor | textMorph editor selectFrom: selectionInterval first to: selectionInterval last; model: model. "For, eg, evaluateSelection" textMorph handleEdit: [(oldEditor := textMorph editor) evaluateSelectionAndDo: [:result | selectionInterval := oldEditor selectionInterval. textMorph installEditorToReplace: oldEditor. + textMorph handleEdit: [ oldEditor afterSelectionInsertAndSelect: + (oldEditor printTextFor: result)]. - textMorph handleEdit: [oldEditor afterSelectionInsertAndSelect: result printString]. selectionInterval := oldEditor selectionInterval. textMorph editor selectFrom: selectionInterval first to: selectionInterval last. self scrollSelectionIntoView]]! Item was changed: ----- Method: TextEditor>>afterSelectionInsertAndSelect: (in category 'new selection') ----- + afterSelectionInsertAndSelect: aStringOrText - afterSelectionInsertAndSelect: aString + self insertAndSelect: aStringOrText at: self stopIndex ! - self insertAndSelect: aString at: self stopIndex ! Item was changed: ----- Method: TextEditor>>insertAndSelect:at: (in category 'new selection') ----- + insertAndSelect: aStringOrText at: anInteger - insertAndSelect: aString at: anInteger + aStringOrText isString ifTrue: [ + ^ self + insertAndSelect: (Text string: aStringOrText attributes: emphasisHere) + at: anInteger]. - self closeTypeIn. + self closeTypeIn. self selectInvisiblyFrom: anInteger to: anInteger - 1. self openTypeIn. self replace: self selectionInterval + with: (Text string: ' ' attributes: emphasisHere), aStringOrText - with: (Text string: (' ', aString) attributes: emphasisHere) and: []. - self closeTypeIn.! Item was changed: ----- Method: TextEditor>>printIt (in category 'do-its') ----- printIt self evaluateSelectionAndDo: [:result | (model respondsTo: #printIt:result:) ifTrue: [model perform: #printIt:result: with: self selection with: result] + ifFalse: [self afterSelectionInsertAndSelect: (self printTextFor: result)]]! - ifFalse: [self afterSelectionInsertAndSelect: result printString]]! Item was added: + ----- Method: TextEditor>>printTextFor: (in category 'do-its') ----- + printTextFor: anObject + + ^ Text + string: anObject printString + attributes: {PluggableTextAttribute evalBlock: [anObject inspect]}!

8 34

Proposal: Geometry Classes
by patrick.rein＠hpi.uni-potsdam.de 11 Mar '21

11 Mar '21

Hi everyone, during some recent clean-up an issue with geometry objects came up. As a result the following idea came up which I thereby would like to put out for an initial discussion. In case we find that this might be useful, I would continue by implementing a first prototype of the package as a foundation of a more in-depth discussion later on. Bests Patrick # Squeak Change Proposal - Geometry Package ## Why? Squeak implements basic geometry logic in too many different places. For example intersection of different kinds of geometric objects is implemented all over Morphic, ST80, Balloon, Graphics, and Etoys. Such extensive scattering across packages and classes impedes modularity, that is, readability and extensibility. An example for this recently came up when we discovered an issue with testing for graphical intersections between PolygonMorph and RectangleMorph. It was not possible to compute that overlapping area because the class Rectangle omits to provide an important method. A quick fix would entail unnecessary dependencies (here: Morphic -> Balloon) or duplicated code (see also http://bugs.squeak.org/view.php?id=7872). Consequently, we might want to modularize the geometry objects and operations. As a side effect, dependent packages such as Morphic can be simplified a little bit (more). ## Scope The proposed package should cover basic 2D geometric objects and their operations represented by the following classes: - Point - Line - LineSegment - Polygon - Rectangle (as an optimization as it could be represented as a special Polygon already) Most classes could simply be moved from their previous packages. Afterwards the interfaces would need to be made consistent with each other to allow interoperability of all geometry classes within the new package. ### Affected classes: - All classes in ST80-Paths - LineSegement, Bezier2Segment, Bezier3Segment (Balloon-Geometry) - Rectangle, Quadrangle, Point (Graphics-Primitives) - LineIntersections, LineIntersectionSegment, LineIntersectionEvent (Etoys-Squeakland-Graphics-Tools-Intersection) ## Open questions - Should this become a single new package or a subcategory in the Graphics package? - Should the package contain an Ellipses class? - Should we model curved line segments as BezierLineSegments, CurvedLineSegment, or Arc? ## Risks - This would potentially deprecate the existing ST80 geometry classes (ST80-Paths) - Some of the new classes will cause name clashes with existing classes. For example Line is currently in ST-80 and represents a line segment, and the class LineSegment is a line segment but not in the geometric sense as it also incorporates arcs. Both names might then be used by new classes with different meanings. This might be mitigated by introducing a pre-/postfix for the names of the new classes.

6 16

find original change set
by Javier Orsaria 09 Mar '21

09 Mar '21

Hi, I was trying to use, in VersionsBrowser, the feature "find original change set" for a method. In old versions (3.8 and earlier) this work fine. But in 3.10 and 3.9 don´t. I followed the sequence and detect the problem at MethodChangeRecord-noteNewMethod: noteNewMethod: newMethod "NEVER do this. It is evil." currentMethod _ nil. should be: noteNewMethod: newMethod "NEVER do this. It is evil." currentMethod _ newMethod. This way work as I expect. But with that comment I understand was intentioned. What is the problem with this? I can´t see it... I'm the devil? Thanks, Javier

3 2

[Test][Squeak5.2rc1][SqueakMap] FFI entry in SqueakMap catalog for 5.2?
by H. Hirzel 12 Jan '21

12 Jan '21

Hello All tests Loading FFI into Sque The load script for FFI is 'community supported' in SqueakMap. The relevant FFI entry has as load script is just Installer new merge: #ffiTests This still applies for 5.2. However the last time FFI shows up in the SqueakMap client list for a particular release is version 4.5. Not in 4.6, 5.0 and 5.1 What do I need to do to make it appear in the list for 5.2. Creating a release for 5.2 would be an option but that seems unnecessary as it had not been done for 4.5 either. Suggestions how to proceed? Regards Hannes

7 23

The Inbox: Collections-nice.869.mcz
by commits＠source.squeak.org 17 Dec '20

17 Dec '20

Nicolas Cellier uploaded a new version of Collections to project The Inbox: http://source.squeak.org/inbox/Collections-nice.869.mcz ==================== Summary ==================== Name: Collections-nice.869 Author: nice Time: 31 December 2019, 11:14:43.388306 pm UUID: e5a9bef5-16d3-4d8a-bf08-040d30e4e907 Ancestors: Collections-nice.868 Remaster Collections-nice.464: opimize RunArray This should not be noticeable for Text, but as a general library, it's important for any other potential use. Among those optimizations, notice one important change: some of the enumerating methods like #collect: won't iterate on each element, but only once per run. Be aware that providing blocks with side effects like (i := i + 1) might lead to different behavior than ordinary ArrayedCollection. Move RunArray off ArrayedCollection which serves nothing to such subclass. Add the ability to remove: since it already has the hability to addFirst: and addLast: Fix a few missing lastIndex cache flush, and advertise about the necessity to do it in class comment. Deprecate mapValues: to the profit of replace:. =============== Diff against Collections-nice.868 =============== Item was changed: + SequenceableCollection subclass: #RunArray - ArrayedCollection subclass: #RunArray instanceVariableNames: 'runs values lastIndex lastRun lastOffset' classVariableNames: '' poolDictionaries: '' category: 'Collections-Arrayed'! + !RunArray commentStamp: 'nice 12/30/2019 00:57' prior: 0! - !RunArray commentStamp: '<historical>' prior: 0! My instances provide space-efficient storage of data which tends to be constant over long runs of the possible indices. Essentially repeated values are stored singly and then associated with a "run" length that denotes the number of consecutive occurrences of the value. My two important variables are runs An array of how many elements are in each run values An array of what the value is over those elements The variables lastIndex, lastRun and lastOffset cache the last access so that streaming through RunArrays is not an N-squared process. + Beware: methods modifying the RunArray contents should reset the lastIndex cache to nil. Many complexities of access can be bypassed by using the method RunArray withStartStopAndValueDo:! Item was changed: ----- Method: RunArray class>>newFrom: (in category 'instance creation') ----- newFrom: aCollection "Answer an instance of me containing the same elements as aCollection." | newCollection | newCollection := self new. + newCollection fillFrom: aCollection with: [:each | each]. - aCollection do: [:x | newCollection addLast: x]. ^newCollection " RunArray newFrom: {1. 2. 2. 3} {1. $a. $a. 3} as: RunArray ({1. $a. $a. 3} as: RunArray) values "! Item was added: + ----- Method: RunArray>>allSatisfy: (in category 'enumerating') ----- + allSatisfy: aBlock + "Only evaluate once per run" + + ^values allSatisfy: aBlock! Item was added: + ----- Method: RunArray>>anySatisfy: (in category 'enumerating') ----- + anySatisfy: aBlock + "Only evaluate once per run" + + ^values anySatisfy: aBlock! Item was added: + ----- Method: RunArray>>asBag (in category 'converting') ----- + asBag + | aBag | + aBag := Bag new: values size. + self runsAndValuesDo: [:run :value | + aBag add: value withOccurrences: run]. + ^aBag! Item was added: + ----- Method: RunArray>>asSet (in category 'converting') ----- + asSet + ^values asSet! Item was changed: + ----- Method: RunArray>>coalesce (in category 'private') ----- - ----- Method: RunArray>>coalesce (in category 'adding') ----- coalesce + "Coalesce theRuns and theValues if ever the values have adjacent equal objects" + + | lastLength lastValue mustCoalesce coalescedRuns coalescedValued runIndex | + mustCoalesce := false. + runIndex := 0. + lastLength := 0. + lastValue := Object new. + runs with: values do: [:run :value | + (lastValue = value or: [run = 0]) + ifTrue: + [mustCoalesce + ifFalse: + [coalescedRuns := (Array new: runs size) writeStream. + coalescedValued := (Array new: values size) writeStream. + coalescedRuns next: runIndex putAll: runs startingAt: 1. + coalescedValued next: runIndex putAll: values startingAt: 1. + mustCoalesce := true]. + lastLength := lastLength + run] + ifFalse: + [lastLength > 0 + ifTrue: + [mustCoalesce + ifTrue: + [coalescedRuns nextPut: lastLength. + coalescedValued nextPut: lastValue]. + runIndex := runIndex + 1]. + lastLength := run. + lastValue := value]]. + mustCoalesce + ifTrue: + [lastLength > 0 + ifTrue: + [coalescedRuns nextPut: lastLength. + coalescedValued nextPut: lastValue]. + self setRuns: coalescedRuns contents setValues: coalescedValued contents]! - "Try to combine adjacent runs" - | ind | - ind := 2. - [ind > values size] whileFalse: [ - (values at: ind-1) = (values at: ind) - ifFalse: [ind := ind + 1] - ifTrue: ["two are the same, combine them" - values := values copyReplaceFrom: ind to: ind with: #(). - runs at: ind-1 put: (runs at: ind-1) + (runs at: ind). - runs := runs copyReplaceFrom: ind to: ind with: #(). - "self error: 'needed to combine runs' "]]. - ! Item was added: + ----- Method: RunArray>>collect: (in category 'enumerating') ----- + collect: aBlock + "Beware, the block will be evaluated only once per group of values." + ^(self class runs: runs copy values: (values collect: aBlock)) coalesce! Item was added: + ----- Method: RunArray>>copyUpThrough: (in category 'copying') ----- + copyUpThrough: value + "Optimized" + + | newSize newValues newRuns | + newSize := values indexOf: value startingAt: 1. + newSize = 0 ifTrue: [^self copy]. + newRuns := runs copyFrom: 1 to: newSize. + newRuns at: newSize put: 1. + newValues := values copyFrom: 1 to: newSize. + ^ self class + runs: newRuns + values: newValues! Item was added: + ----- Method: RunArray>>copyUpTo: (in category 'copying') ----- + copyUpTo: anElement + "Optimized" + + | newValues | + newValues := values copyUpTo: anElement. + ^ self class + runs: (runs copyFrom: 1 to: newValues size) + values: newValues! Item was added: + ----- Method: RunArray>>copyUpToLast: (in category 'copying') ----- + copyUpToLast: value + "Optimized" + + | newSize run newRuns newValues | + newSize := values lastIndexOf: value startingAt: values size. + newSize = 0 ifTrue: [^self copy]. + run := runs at: newSize. + run > 1 + ifTrue: + [newRuns := runs copyFrom: 1 to: newSize. + newRuns at: newSize put: run - 1] + ifFalse: + [newSize := newSize - 1. + newRuns := runs copyFrom: 1 to: newSize]. + newValues := values copyFrom: 1 to: newSize. + ^ self class + runs: newRuns + values: newValues! Item was added: + ----- Method: RunArray>>count: (in category 'enumerating') ----- + count: aBlock + "Beware, the block will be evaluated only once per group of values." + | count | + count := 0. + self runsAndValuesDo: [:run :value | + (aBlock value: value) + ifTrue: + [count := count + run]]. + ^count! Item was added: + ----- Method: RunArray>>detect:ifNone: (in category 'enumerating') ----- + detect: aBlock ifNone: exceptionBlock + "Only evaluate once per run" + + ^values detect: aBlock ifNone: exceptionBlock ! Item was added: + ----- Method: RunArray>>detectMax: (in category 'enumerating') ----- + detectMax: aBlock + "Only evaluate once per run" + + ^values detectMax: aBlock! Item was added: + ----- Method: RunArray>>detectMin: (in category 'enumerating') ----- + detectMin: aBlock + "Only evaluate once per run" + + ^values detectMin: aBlock! Item was added: + ----- Method: RunArray>>detectSum: (in category 'enumerating') ----- + detectSum: aBlock + "Only loop on runs" + | sum | + sum := 0. + self runsAndValuesDo: [:run :value | + sum := (aBlock value: value) * run + sum]. + ^ sum! Item was added: + ----- Method: RunArray>>do: (in category 'enumerating') ----- + do: aBlock + "This is refined for speed" + + 1 to: runs size do: [:i | + | r v | + v := values at: i. + r := runs at: i. + [( r := r - 1) >= 0] + whileTrue: [aBlock value: v]].! Item was added: + ----- Method: RunArray>>fillFrom:with: (in category 'private') ----- + fillFrom: aCollection with: aBlock + "Evaluate aBlock with each of aCollections's elements as the argument. + Collect the resulting values into self. Answer self." + + | newRuns newValues lastLength lastValue | + newRuns := (Array new: aCollection size) writeStream. + newValues := (Array new: aCollection size) writeStream. + lastLength := 0. + lastValue := Object new. + lastIndex := nil. "flush access cache" + aCollection do: [:each | + | value | + value := aBlock value: each. + lastValue = value + ifTrue: [lastLength := lastLength + 1] + ifFalse: + [lastLength > 0 + ifTrue: + [newRuns nextPut: lastLength. + newValues nextPut: lastValue]. + lastLength := 1. + lastValue := value]]. + lastLength > 0 + ifTrue: + [newRuns nextPut: lastLength. + newValues nextPut: lastValue]. + self setRuns: newRuns contents setValues: newValues contents! Item was added: + ----- Method: RunArray>>findFirst: (in category 'enumerating') ----- + findFirst: aBlock + | index | + index := 1. + self runsAndValuesDo: [ :run :value | + (aBlock value: value) ifTrue: [^index]. + index := index + run]. + ^0! Item was added: + ----- Method: RunArray>>findLast: (in category 'enumerating') ----- + findLast: aBlock + | index | + index := values size + 1. + [(index := index - 1) >= 1] whileTrue: + [(aBlock value: (values at: index)) ifTrue: [^(1 to: index) detectSum: [:i | runs at: i]]]. + ^0! Item was added: + ----- Method: RunArray>>includes: (in category 'testing') ----- + includes: anObject + "Answer whether anObject is one of the receiver's elements." + + ^values includes: anObject! Item was added: + ----- Method: RunArray>>indexOf:startingAt: (in category 'accessing') ----- + indexOf: anElement startingAt: start + "Answer the index of the first occurence of anElement after start + within the receiver. If the receiver does not contain anElement, + answer 0." + + | index | + index := 1. + self runsAndValuesDo: [ :run :value | + (index >= start and: [value = anElement]) ifTrue: [^index]. + index := index + run]. + ^0! Item was added: + ----- Method: RunArray>>indexOfAnyOf:startingAt: (in category 'accessing') ----- + indexOfAnyOf: aCollection startingAt: start + "Answer the index of the first occurence of any element included in aCollection after start within the receiver. + If the receiver does not contain anElement, answer zero, which is an invalid index." + + | index | + index := 1. + self runsAndValuesDo: [ :run :value | + (index >= start and: [aCollection includes: value]) ifTrue: [^index]. + index := index + run]. + ^0! Item was added: + ----- Method: RunArray>>isSorted (in category 'testing') ----- + isSorted + ^values isSorted! Item was added: + ----- Method: RunArray>>isSortedBy: (in category 'testing') ----- + isSortedBy: aBlock + ^values isSortedBy: aBlock! Item was added: + ----- Method: RunArray>>lastIndexOf:startingAt: (in category 'accessing') ----- + lastIndexOf: anElement startingAt: lastIndex + "Answer the index of the last occurence of anElement within the + receiver. If the receiver does not contain anElement, answer 0." + + | lastValueIndex | + lastValueIndex := values lastIndexOf: anElement startingAt: values size. + [lastValueIndex > 0] whileTrue: + [| i index | + i := index := 0. + [index <= lastIndex and: [(i := i + 1) <= lastValueIndex]] + whileTrue: [index := index + (runs at: i)]. + index <= lastIndex ifTrue: [^index]. + index - (runs at: lastValueIndex) < lastIndex ifTrue: [^lastIndex]. + lastValueIndex := values lastIndexOf: anElement startingAt: lastValueIndex - 1]. + ^0! Item was added: + ----- Method: RunArray>>lastIndexOfAnyOf:startingAt: (in category 'accessing') ----- + lastIndexOfAnyOf: aCollection startingAt: lastIndex + "Answer the index of the last occurence of any element of aCollection + within the receiver. If the receiver does not contain any of those + elements, answer 0" + + | lastValueIndex | + lastValueIndex := values lastIndexOfAnyOf: aCollection startingAt: values size. + [lastValueIndex > 0] whileTrue: + [| i index | + i := index := 0. + [index <= lastIndex and: [(i := i + 1) <= lastValueIndex]] + whileTrue: [index := index + (runs at: i)]. + index <= lastIndex ifTrue: [^index]. + index - (runs at: lastValueIndex) < lastIndex ifTrue: [^lastIndex]. + lastValueIndex := values lastIndexOfAnyOf: aCollection startingAt: lastValueIndex - 1]. + ^0! Item was removed: - ----- Method: RunArray>>mapValues: (in category 'private') ----- - mapValues: mapBlock - "NOTE: only meaningful to an entire set of runs" - - values := values collect: mapBlock! Item was added: + ----- Method: RunArray>>noneSatisfy: (in category 'enumerating') ----- + noneSatisfy: aBlock + "Only evaluate once per run" + + ^values noneSatisfy: aBlock! Item was changed: + ----- Method: RunArray>>rangeOf:startingAt: (in category 'accessing') ----- - ----- Method: RunArray>>rangeOf:startingAt: (in category 'adding') ----- rangeOf: attr startingAt: startPos "Answer an interval that gives the range of attr at index position startPos. An empty interval with start value startPos is returned when the attribute attr is not present at position startPos. self size > 0 is assumed, it is the responsibility of the caller to test for emptiness of self. Note that an attribute may span several adjancent runs. " self at: startPos setRunOffsetAndValue: [:run :offset :value | ^(value includes: attr) ifFalse: [startPos to: startPos - 1] ifTrue: [ | firstRelevantPosition lastRelevantPosition idxOfCandidateRun | lastRelevantPosition := startPos - offset + (runs at: run) - 1. firstRelevantPosition := startPos - offset. idxOfCandidateRun := run + 1. [idxOfCandidateRun <= runs size and: [(values at: idxOfCandidateRun) includes: attr]] whileTrue: [lastRelevantPosition := lastRelevantPosition + (runs at: idxOfCandidateRun). idxOfCandidateRun := idxOfCandidateRun + 1]. idxOfCandidateRun := run - 1. [idxOfCandidateRun >= 1 and: [(values at: idxOfCandidateRun) includes: attr]] whileTrue: [firstRelevantPosition := firstRelevantPosition - (runs at: idxOfCandidateRun). idxOfCandidateRun := idxOfCandidateRun - 1]. firstRelevantPosition to: lastRelevantPosition] ]! Item was added: + ----- Method: RunArray>>remove:ifAbsent: (in category 'removing') ----- + remove: anObject ifAbsent: exceptionBlock + | index mustCoalesce run | + lastIndex := nil. "flush access cache" + index := values indexOf: anObject ifAbsent: [^exceptionBlock value]. + (run := runs at: index) > 1 + ifTrue: [runs at: index put: run - 1] + ifFalse: + [mustCoalesce := index > 1 and: [index < values size and: [(values at: index - 1) = (values at: index + 1)]]. + runs := runs copyWithoutIndex: index. + values := values copyWithoutIndex: index. + mustCoalesce + ifTrue: + [runs at: index - 1 put: (runs at: index - 1) + (runs at: index). + runs := runs copyWithoutIndex: index. + values := values copyWithoutIndex: index]]. + ^anObject! Item was added: + ----- Method: RunArray>>removeAll (in category 'removing') ----- + removeAll + lastIndex := nil. "flush access cache" + runs := Array new. + values := Array new! Item was added: + ----- Method: RunArray>>replace: (in category 'enumerating') ----- + replace: aBlock + "destructively replace the values in this RunArray with the ones transformed by aBlock." + lastIndex := nil. "flush access cache" + values := values replace: aBlock. + self coalesce! Item was added: + ----- Method: RunArray>>reverseDo: (in category 'enumerating') ----- + reverseDo: aBlock + "This is refined for speed" + + | i | + i := runs size. + [i > 0] + whileTrue: + [ | r v | + v := values at: i. + r := runs at: i. + i := i - 1. + [( r := r - 1) >= 0] + whileTrue: [aBlock value: v]].! Item was added: + ----- Method: RunArray>>select: (in category 'enumerating') ----- + select: aBlock + "Beware, the block will be evaluated only once per group of values." + | newRuns newValues | + newRuns := (Array new: runs size) writeStream. + newValues := (Array new: values size) writeStream. + self runsAndValuesDo: [:run :value | + (aBlock value: value) + ifTrue: + [newRuns nextPut: run. + newValues nextPut: value]]. + ^(self class runs: newRuns contents values: newValues contents) coalesce! Item was changed: ----- Method: SequenceableCollection>>lastIndexOf:startingAt: (in category 'accessing') ----- lastIndexOf: anElement startingAt: lastIndex "Answer the index of the last occurence of anElement within the + receiver. If the receiver does not contain anElement, answer 0." - receiver. If the receiver does not contain anElement, answer the - result of evaluating the argument, exceptionBlock." lastIndex to: 1 by: -1 do: [ :index | (self at: index) = anElement ifTrue: [ ^index ] ]. ^0! Item was changed: ----- Method: Text>>addAttribute:from:to: (in category 'emphasis') ----- addAttribute: att from: start to: stop "Set the attribute for characters in the interval start to stop." runs := runs copyReplaceFrom: start to: stop with: ((runs copyFrom: start to: stop) + replace: - mapValues: [:attributes | Text addAttribute: att toArray: attributes]) ! Item was changed: ----- Method: Text>>removeAttribute:from:to: (in category 'emphasis') ----- removeAttribute: att from: start to: stop "Remove the attribute over the interval start to stop." runs := runs copyReplaceFrom: start to: stop with: ((runs copyFrom: start to: stop) + replace: - mapValues: [:attributes | attributes copyWithout: att]) !

6 14

The Inbox: Morphic-ct.1588.mcz
by commits＠source.squeak.org 16 Nov '20

16 Nov '20

A new version of Morphic was added to project The Inbox: http://source.squeak.org/inbox/Morphic-ct.1588.mcz ==================== Summary ==================== Name: Morphic-ct.1588 Author: ct Time: 15 November 2019, 2:18:46.719005 pm UUID: cd229fb4-796e-a349-9c09-811159cf9e6e Ancestors: Morphic-mt.1587 TextEditor: Add support for different keyboard layouts, fix the 9-enclosing bug and clean up #enclose: You now can do [Editor defaultKeyboardLayout: #qwertz] to adapt the editing behavior of Squeak to the qwertz layout. Squeakers from all the world, feel free to add further keyboard layouts to #specialShiftKeyMaps! We also had an interesting dicussion concerning the 9-enclosing bug (see http://forum.world.st/When-did-it-become-a-good-idea-for-selected-text-to-b…) and wondered whether there would be really anyone willing to press 9 only, without any modifier key, to enclose the selection with brackets. He or she might press 9 and shift together in future (on a qwertz layout), it would be just incon{sist,veni}ent that 8 and 9 had such different behaviors. Depends on Collections-ct.860. =============== Diff against Morphic-mt.1587 =============== Item was changed: Object subclass: #Editor instanceVariableNames: 'morph selectionShowing' + classVariableNames: 'BlinkingCursor DefaultKeyboardLayout DestructiveBackWord DumbbellCursor EnclosingCharacterMap KeystrokeActions SelectionsMayShrink SpecialShiftKeyMaps' - classVariableNames: 'BlinkingCursor DestructiveBackWord DumbbellCursor KeystrokeActions SelectionsMayShrink' poolDictionaries: '' category: 'Morphic-Text Support'! !Editor commentStamp: 'hjh 9/28/2017 11:37' prior: 0! New text editors. TextEditor provides most of the functionality that used to be in TextMorphEditor. SmalltalkEditor is has Smalltalk code specific features. ! Item was added: + ----- Method: Editor class>>defaultKeyboardLayout (in category 'keyboard shortcut tables') ----- + defaultKeyboardLayout + + ^ DefaultKeyboardLayout ifNil: [#qwerty]! Item was added: + ----- Method: Editor class>>defaultKeyboardLayout: (in category 'keyboard shortcut tables') ----- + defaultKeyboardLayout: aSymbol + + DefaultKeyboardLayout := aSymbol! Item was added: + ----- Method: Editor class>>enclosingCharacterMap (in category 'keyboard shortcut tables') ----- + enclosingCharacterMap + + ^ EnclosingCharacterMap ifNil: [EnclosingCharacterMap := + Dictionary fromKeys: '([<{|"''' values: ')]>}|"''']! Item was changed: ----- Method: Editor class>>initialize (in category 'class initialization') ----- initialize " Editor initialize " self initializeKeystrokeActions. + EnclosingCharacterMap := nil. + SpecialShiftKeyMaps := nil. self allSubclassesDo: [ :c | c initialize ]! Item was added: + ----- Method: Editor class>>specialShiftKeyMaps (in category 'keyboard shortcut tables') ----- + specialShiftKeyMaps + + SpecialShiftKeyMaps ifNotNil: [^ SpecialShiftKeyMaps]. + SpecialShiftKeyMaps := Dictionary new + at: #qwerty put: (Dictionary fromKeys: '[]\'',.90' values: '{}|"<>()'); + at: #qwertz put: (Dictionary fromKeys: '89' values: '()'); + yourself. + ^ SpecialShiftKeyMaps! Item was added: + ----- Method: Editor>>enclosingCharacterFor:ifNone: (in category 'as yet unclassified') ----- + enclosingCharacterFor: openingCharacter ifNone: aBlock + + ^ self enclosingCharacterMap + at: openingCharacter + ifAbsent: aBlock! Item was added: + ----- Method: Editor>>enclosingCharacterMap (in category 'as yet unclassified') ----- + enclosingCharacterMap + + ^ self class enclosingCharacterMap! Item was added: + ----- Method: Editor>>keyboardLayout (in category 'accessing') ----- + keyboardLayout + + ^ self class defaultKeyboardLayout! Item was added: + ----- Method: Editor>>mapSpecialKeyToShift: (in category 'private') ----- + mapSpecialKeyToShift: aCharacter + "Maps special characters such as $[ on a qwerty keyboard to their uppercase equivalent, that would be ${ in this example. Probably required by some VM implementations." + + ^ self specialShiftKeys + at: aCharacter + ifAbsent: [aCharacter]! Item was added: + ----- Method: Editor>>specialShiftKeys (in category 'accessing') ----- + specialShiftKeys + + ^ self class specialShiftKeyMaps at: self keyboardLayout! Item was changed: ----- Method: TextEditor>>enclose: (in category 'editing keys') ----- enclose: aKeyboardEvent "Insert or remove bracket characters around the current selection." + | character left right startIndex stopIndex oldSelection text | - | character left right startIndex stopIndex oldSelection which t | - character := aKeyboardEvent shiftPressed - ifTrue: ['{}|"<>' at: ('[]\'',.' indexOf: aKeyboardEvent keyCharacter) ifAbsent: [aKeyboardEvent keyCharacter]] - ifFalse: [aKeyboardEvent keyCharacter]. self closeTypeIn. + + character := aKeyboardEvent keyCharacter. + (aKeyboardEvent shiftPressed + or: ["Allow Control key in lieu of Alt+Shift for certain special keys." + Preferences cmdKeysInText and: [aKeyboardEvent controlKeyPressed]]) + ifTrue: [character := self mapSpecialKeyToShift: aKeyboardEvent keyCharacter]. startIndex := self startIndex. stopIndex := self stopIndex. oldSelection := self selection. + left := character. + right := self enclosingCharacterFor: left ifNone: [^ false]. + + text := self text. + ((startIndex > 1 and: [stopIndex <= text size]) + and: [ (text at: startIndex - 1) = left and: [(text at: stopIndex) = right]]) - which := '([<{|"''9' indexOf: character ifAbsent: [ ^ false ]. - "Allow Control key in lieu of Alt+Shift for (, {, and double-quote." - left := ((Preferences cmdKeysInText and: [ aKeyboardEvent controlKeyPressed ]) - ifTrue: [ '({<{|""(' ] - ifFalse: ['([<{|"''(']) at: which. - right := ((Preferences cmdKeysInText and: [ aKeyboardEvent controlKeyPressed ]) - ifTrue: [ ')}>}|"")' ] - ifFalse: [')]>}|"'')']) at: which. - t := self text. - ((startIndex > 1 and: [stopIndex <= t size]) - and: [ (t at: startIndex-1) = left and: [(t at: stopIndex) = right]]) ifTrue: ["already enclosed; strip off brackets" + self selectFrom: startIndex - 1 to: stopIndex. - self selectFrom: startIndex-1 to: stopIndex. self replaceSelectionWith: oldSelection] ifFalse: ["not enclosed; enclose by matching brackets" + self replaceSelectionWith: (Text + string: (String with: left), oldSelection string, (String with: right) + attributes: emphasisHere). + self selectFrom: startIndex + 1 to: stopIndex]. + ^ true! - self replaceSelectionWith: - (Text string: (String with: left), oldSelection string, (String with: right) attributes: emphasisHere). - self selectFrom: startIndex+1 to: stopIndex]. - ^true!

2 1

Jump to page: