Squeak-dev April 2020

squeak-dev@lists.squeakfoundation.org

39 participants
235 discussions

[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

The Inbox: Tools-ct.959.mcz
by commits＠source.squeak.org 18 Apr '21

18 Apr '21

Christoph Thiede uploaded a new version of Tools to project The Inbox: http://source.squeak.org/inbox/Tools-ct.959.mcz ==================== Summary ==================== Name: Tools-ct.959 Author: ct Time: 16 March 2020, 9:03:12.729937 pm UUID: cae0b2d6-e131-7a40-b6a9-62a90172de94 Ancestors: Tools-mt.955 Proposal: Allow simple change sorters to become become dual sorters, and dual change sorters to be split into two separate change sorters. This commit also refactors DualChangeSorter in general. =============== Diff against Tools-mt.955 =============== Item was added: + ----- Method: ChangeSorter>>addModelItemsToWindowMenu: (in category 'as yet unclassified') ----- + addModelItemsToWindowMenu: aMenu + "Add model-related item to the window menu" + + super addModelItemsToWindowMenu: aMenu. + aMenu addLine. + aMenu add: 'Become dual sorter' translated target: self action: #becomeDualSorter.! Item was added: + ----- Method: ChangeSorter>>becomeDualSorter (in category 'as yet unclassified') ----- + becomeDualSorter + "Switch the contents of the receiver's view to represent a DualChangeSorter. Kind of mitosis: We're doing the anaphase right now." + + | dualSorter | + dualSorter := DualChangeSorter withLeft: self right: nil. + dualSorter initializeSides. + self changed: #close. + ToolBuilder open: dualSorter.! Item was added: + ----- Method: DualChangeSorter class>>new (in category 'instance creation') ----- + new + + ^ super new + initializeSides; + yourself! Item was added: + ----- Method: DualChangeSorter class>>withLeft:right: (in category 'instance creation') ----- + withLeft: leftChangeSorter right: rightChangeSorter + + ^ self basicNew + leftChangeSorter: leftChangeSorter; + rightChangeSorter: rightChangeSorter; + yourself! Item was added: + ----- Method: DualChangeSorter>>addModelItemsToWindowMenu: (in category 'user interface') ----- + addModelItemsToWindowMenu: aMenu + "Add model-related item to the window menu" + + super addModelItemsToWindowMenu: aMenu. + aMenu addLine. + aMenu add: 'Split sides' translated target: self action: #splitSides.! Item was changed: ----- Method: DualChangeSorter>>buildWith: (in category 'toolbuilder') ----- buildWith: builder - | windowSpec window | - leftCngSorter := ChangeSorter new myChangeSet: ChangeSet current. - leftCngSorter parent: self. - rightCngSorter := ChangeSorter new myChangeSet: - ChangeSet secondaryChangeSet. - rightCngSorter parent: self. + | windowSpec window | windowSpec := builder pluggableWindowSpec new. windowSpec model: self. windowSpec label: 'Change Sorter'. windowSpec children: OrderedCollection new. windowSpec label: #labelString. leftCngSorter buildWith: builder in: windowSpec rect: (0@0 extent: 0.5@1). rightCngSorter buildWith: builder in: windowSpec rect: (0.5@0 extent: 0.5@1). window := builder build: windowSpec. leftCngSorter addDependent: window. "so it will get changed: #relabel" rightCngSorter addDependent: window. "so it will get changed: #relabel" ^window! Item was added: + ----- Method: DualChangeSorter>>initializeSides (in category 'initialization') ----- + initializeSides + + leftCngSorter ifNil: [ + leftCngSorter := ChangeSorter new myChangeSet: ChangeSet current]. + leftCngSorter parent: self. + rightCngSorter ifNil: [ + rightCngSorter := ChangeSorter new myChangeSet: ChangeSet secondaryChangeSet]. + rightCngSorter parent: self.! Item was changed: + ----- Method: DualChangeSorter>>isLeftSide: (in category 'accessing') ----- - ----- Method: DualChangeSorter>>isLeftSide: (in category 'other') ----- isLeftSide: theOne "Which side am I?" ^ theOne == leftCngSorter! Item was changed: + ----- Method: DualChangeSorter>>labelString (in category 'toolbuilder') ----- - ----- Method: DualChangeSorter>>labelString (in category 'other') ----- labelString "The window label" ^'Changes go to "', ChangeSet current name, '"'.! Item was added: + ----- Method: DualChangeSorter>>leftChangeSorter: (in category 'initialization') ----- + leftChangeSorter: aChangeSorter + + leftCngSorter := aChangeSorter! Item was changed: + ----- Method: DualChangeSorter>>modelWakeUp (in category 'updating') ----- - ----- Method: DualChangeSorter>>modelWakeUp (in category 'other') ----- modelWakeUp "A window with me as model is being entered. Make sure I am up-to-date with the changeSets." "Dumb way" leftCngSorter canDiscardEdits ifTrue: [leftCngSorter update] "does both" ifFalse: [rightCngSorter update]. ! Item was changed: + ----- Method: DualChangeSorter>>okToChange (in category 'updating') ----- - ----- Method: DualChangeSorter>>okToChange (in category 'initialization') ----- okToChange ^ leftCngSorter okToChange & rightCngSorter okToChange! Item was changed: + ----- Method: DualChangeSorter>>other: (in category 'accessing') ----- - ----- Method: DualChangeSorter>>other: (in category 'other') ----- other: theOne "Return the other side's ChangeSorter" ^ theOne == leftCngSorter ifTrue: [rightCngSorter] ifFalse: [leftCngSorter]! Item was added: + ----- Method: DualChangeSorter>>rightChangeSorter: (in category 'initialization') ----- + rightChangeSorter: aChangeSorter + + rightCngSorter := aChangeSorter! Item was added: + ----- Method: DualChangeSorter>>splitSides (in category 'menu commands') ----- + splitSides + "Split the receiver into two independent views. Kind of mitosis: We're doing cytokinesis right now." + + {leftCngSorter. rightCngSorter} do: [:sorter | + ToolBuilder open: sorter]. + self changed: #close.!

8 19

The Inbox: System-ct.1149.mcz
by commits＠source.squeak.org 14 Apr '21

14 Apr '21

Christoph Thiede uploaded a new version of System to project The Inbox: http://source.squeak.org/inbox/System-ct.1149.mcz ==================== Summary ==================== Name: System-ct.1149 Author: ct Time: 29 March 2020, 1:35:58.40756 pm UUID: 1bf6e87f-fc73-7747-af4d-df3e339a0627 Ancestors: System-ul.1148 Proposal: Add some convenience methods for debugging blocks. See examples in #debugFromContextThat:title:. While I know that we already talked about the sense of convenience methods that are not actually used in the base system, I think that these ones actually add value and should be used in the base system. We are experiencing an ascending number of methods that implement "debugging of a specific action", such as "debug action" and "debug get-list invocation" in Morphic, or "debug test" in SUnit (see SUnit-ct.125). As they have little duplication at the moment, it is also hard to make them more convenient: For example, if you try to debug a test case that overrides #performTest in a way that it does not actually invoke the test selector; or for another example, if you try to debug the action of a morphic button that we do not support properly at the moment (e. g. the buttons in a UserDialogBox), the current approach opens a debugger on a terminated process on #newProcess. If we follow this suggestion to refactor that behavior into one place, this will allow us to be a bit smarter and mo re convenient, as you can see in the edge case in #debugFromContextThat:title:. My follow-up proposal would thus be to call this convenience methods from all implementors of #debugAction & Co. This commit also tries to solve the issue mentioned in [1]. However, I'm not sure whether BlockClosure is the optimal place for this. I am open for your suggestions to move this somewhere else, for example into Debugger, Process or ToolSet. [1] http://forum.world.st/The-Inbox-Morphic-ct-1590-mcz-tp5106996p5107059.html =============== Diff against System-ul.1148 =============== Item was added: + ----- Method: BlockClosure>>debug (in category '*System-debugging') ----- + debug + + ^ self debugWithTitle: nil! Item was added: + ----- Method: BlockClosure>>debugFromContextThat: (in category '*System-debugging') ----- + debugFromContextThat: contextBlock + + ^ self debugFromContextThat: contextBlock title: nil! Item was added: + ----- Method: BlockClosure>>debugFromContextThat:title: (in category '*System-debugging') ----- + debugFromContextThat: contextBlock title: title + "Evaluate the receiver on a new process (synchronously). Once the contextBlock criterium is satisfied, open a debugger on that process. If the criterium is never satisfied until the process terminates, offer the user to debug the receiver again without waiting for contextBlock again. + + [self halt] debug. + [15 factorial] debugWithTitle: 'Fun with Math!!'. + [self inform: #foo] debugFromContextThat: [:ctxt | ctxt receiver isMorph] title: 'Debug dialog invocation'. + [15 factorial] debugFromContextThat: [:ctxt | ctxt selector = #+]." + + | process | + process := self newProcess. + process runUntil: contextBlock. + process isTerminated ifTrue: [ + ^ (self confirm: 'Did not reach the desired piece of code.\Would you like to debug the whole process again?' withCRs translated) + ifTrue: [self debugWithTitle: title] + ifFalse: [self]]. + ^ process debugWithTitle: title! Item was added: + ----- Method: BlockClosure>>debugWithTitle: (in category '*System-debugging') ----- + debugWithTitle: title + + ^ self + debugFromContextThat: [:ctx | ctx closure == self] + title: title!

2 1

Problems with #caseError
by Thiede, Christoph 28 Mar '21

28 Mar '21

Hi all, there are two problems with #caseError. First one: Given the following example, you will receive a confusing error message: #foo caseOf: {[#bar] -> [2]. [#baz] -> [3]} "--> Error: Case not found (nil), and no otherwise clause" Either #caseError should be called on #foo, then this would be compiler bug. Otherwise, I don't see any reason to print out the receiver. We could also name it #caseError: anObject and print out this object, but the current message is not helpful IMO ... Second one: I'm not sure whether it is expected behavior how #allLiterals works on the following example: method := Compiler new compiledMethodFor: '#bar caseOf: {[#bar] -> [2]}' in: nil to: nil notifying: nil ifFail: nil. method allLiterals. "--> #(#caseError #bar #caseOf:)"

4 9

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

← Newer
1
2
3
4
5
6
7
...
24
Older →

Jump to page: