Squeak-dev November 2021

squeak-dev@lists.squeakfoundation.org

27 participants
277 discussions

KernelTests-ct.409
by christoph.thiede＠student.hpi.uni-potsdam.de 03 Jan '22

03 Jan '22

Note that these tests cause multiple failures in a recent VM at the time of writing: - #testPrimitive100/{'not a selector'. {}. Object}: The VM sends #doesNotUnderstand: to the receiver with an invalid selector whereas the simulator has the primitive failed as expected in Object>>perform:withArguments:inSuperclass:. What behavior do we want? (I would opt for the latter one.) - #testPrimitive118/{6. 'not a primitive'. {7}},{6. 9. 'not an array'}: The VM returns an error code of -3 whereas the simulator returns no error code (nil). I have adjust this behavior in the simulator via Kernel-ct.1420. - #testPrimitive118/{6. 118. {9. {7. 13}}}: The VM does not check the number of arguments but ignores the first one whereas the simulator has the primitive failed with #'bad number of arguments'. What behavior do we want? (I would opt for the latter one.) - #testPrimitive118/2: Context>>receiver:tryPrimitive:withArgs: seems pretty buggy; not all arguments are popped from the stack and there occur several serious stack invalidations. In my opinion most of these issues need to be addressed in the VM; if a new release wasn't just around the corner, it would be my pleasure to use these failures as some good starter entrypoints into the VMMaker project during Christmas or so. But if we are in a hurry, probably someone else wants to fix these issues earlier. Or we just mark the relevant tests as expected failures for now. PS: Please don't ask me why the diff was not sent to the list this time. There should not be any special characters! ==================== Summary ==================== Name: KernelTests-ct.409 Author: ct Time: 10 November 2021, 1:45:40.105242 am UUID: ab3db7b1-d980-5b4b-80a2-8c08bef9b23b Ancestors: KernelTests-mt.407 Adds new simulation tests for the reflection primitives 117 (primitiveExternalCall), 118 (primitiveDoPrimitiveWithArgs), and 218 (primitiveDoNamedPrimitiveWithArgs) and revises existing tests for the primitives 83 (primitivePerform), 84 (primitivePerformWithArgs), and 100 (primitivePerformInSuperclass) which do not need to be dispatched via primitive 118. =============== Diff against KernelTests-mt.407 =============== ContextTest>>testPrimitive100 {tests} · ct 11/10/2021 00:38 (changed) testPrimitive100 { {#isNil. {}. Object}. "valid 0-arg message" {#=. {true}. UndefinedObject}. "valid unary message" {#ifNil:ifNotNil:. {[2]. [:x | x]}. Object}. "valid binary message" {{}. #=. {true}. SequenceableCollection}. "mirror primitive" - {#isNil}. "missing arguments" - {#isNil. 'not an array'}. "invalid arguments" - {#isNil. {}}. "missing lookupClass" + {'not a selector'. {}. Object}. "invalid selector" + {#isNil. 'not an array'. Object}. "invalid arguments" {#isNil. {'excess arg'}. Object}. "too many arguments" {#=. {}. UndefinedObject}. "missing argument" + {#isNil. {}. 'not a class'}. "invalid lookupClass" {#isNil. {}. Boolean}. "lookupClass not in inheritance chain" - } do: [:args | + } do: [:args | | block | + block := [[nil + perform: args first + withArguments: args second + inSuperclass: args third] + on: Error do: [:ex | ex messageText]]. self - assert: (nil tryPrimitive: 100 withArgs: args) - equals: (Context runSimulated: [nil tryPrimitive: 100 withArgs: args])]. + assert: block value + equals: (Context runSimulated: block). + + block := [[thisContext + object: nil + perform: args first + withArguments: args second + inClass: args third] + on: Error do: [:ex | ex messageText]]. + self + assert: block value + equals: (Context runSimulated: block)]. ContextTest>>testPrimitive117 {tests} · ct 11/10/2021 00:10 + testPrimitive117 + + | input1 input2 | + "valid 0-arg primitive" + self + assert: #isNil size + equals: (Context runSimulated: [#isNil size]). + + "valid unary primitive" + self + assert: 6 + 9 + equals: (Context runSimulated: [6 + 9]). + + "superfluous arguments" + self "cascade!" + assert: 6 + 9 + equals: (Context runSimulated: [6 + 9]); + assert: true. + + self + assert: ((input1 := {1. 2. 3}) at: 2 put: 4) + equals: (Context runSimulated: [(input2 := {1. 2. 3}) at: 2 put: 4]); + assert: input1 + equals: input2. ContextTest>>testPrimitive118 {tests} · ct 11/10/2021 00:56 + testPrimitive118 + + self testPrimitive118: [:receiver :primitiveIndex :arguments | + receiver tryPrimitive: primitiveIndex withArgs: arguments]. + + self testPrimitive118: [:receiver :primitiveIndex :arguments | + thisContext receiver: receiver tryPrimitive: primitiveIndex withArgs: arguments]. ContextTest>>testPrimitive118: {tests} · ct 11/10/2021 01:23 + testPrimitive118: primitiveBlock + + | input1 input2 | + { + {#isNil. 62. {}}. "valid 0-arg primitive" + {6. 9. {7}}. "valid unary primitive" + {6. 62. {7}}. "failing primitive" + {6. 'not a primitive'. {7}}. "invalid primitive" + {6. 9. 'not an array'}. "invalid arguments" + {#isNil. 62. {1}}. "too many arguments" + {6. 9. {}}. "missing argument" + + {nil. 83. {#=. true}}. "primitivePerform" + {nil. 83. {#isNil. 'excess arg'}}. "primitivePerform - too many arguments" + {nil. 84. {#=. {true}}}. "primitivePerformWithArgs" + {nil. 84. {#isNil. 'excess arg'}}. "primitivePerformWithArgs - invalid arguments" + {nil. 100. {#=. true. Object}}. "primitivePerformInSuperclass" + {nil. 100. {#isNil. {'excess arg'}. Object}}. "primitivePerformInSuperclass - too many arguments" + + {6. 118. {9. {7}}}. "primitiveDoPrimitiveWithArgs" + {6. 118. {9. {7. 13}}}. "primitiveDoPrimitiveWithArgs - superfluous arguments" + {6. 118. {118. {9. {7}}}}. "primitiveDoPrimitiveWithArgs - M3" + {thisContext. 218. {Float32Array >> #sum. Float32Array withAll: {2.0. 3.0}. {}}}. "primitiveDoNamedPrimitiveWithArgs" + {thisContext. 218. {Float32Array >> #sum. Float32Array withAll: {2.0. 3.0}. {4.0}}}. "primitiveDoNamedPrimitiveWithArgs - superfluous arguments" + } do: [:args | | block | + block := [primitiveBlock valueWithArguments: args]. + self + assert: block value + equals: (Context runSimulated: block)]. + + self + assert: (primitiveBlock value: (input1 := {1. 2. 3}) value: 61 value: {2. 4}) + equals: (Context runSimulated: [primitiveBlock value: (input2 := {1. 2. 3}) value: 61 value: {2. 4}]); + assert: input1 + equals: input2. ContextTest>>testPrimitive218 {tests} · ct 11/10/2021 00:13 + testPrimitive218 + + "valid 0-arg primitive" + self + assert: (Float32Array withAll: {2.0. 3.0}) sum + equals: (Context runSimulated: [(Float32Array withAll: {2.0. 3.0}) sum]). + + "valid unary primitive" + self + assert: 'wiffy' = 'wiffy' copy + equals: (Context runSimulated: ['wiffy' = 'wiffy' copy]); + assert: 'wiffy' = 'ziffy' + equals: (Context runSimulated: ['wiffy' = 'ziffy']). + + "superfluous arguments" + self "cascade!" + assert: 'wiffy' = 'wiffy' copy + equals: (Context runSimulated: ['wiffy' = 'wiffy' copy]); + assert: true. ContextTest>>testPrimitive83 {tests} · ct 11/10/2021 00:24 (changed) testPrimitive83 { - {#isNil}. "valid 0-arg message" - {#=. true}. "valid unary message" - {#ifNil:ifNotNil:. [2]. [:x | x]}. "valid binary message" - {#isNil. 'excess arg'}. "too many arguments" - {#=}. "missing argument" - } do: [:args | + [nil perform: #isNil]. "valid 0-arg message" + [nil perform: #= with: true]. "valid unary message" + [nil perform: #ifNil:ifNotNil: with: [2] with: [:x | x]]. "valid binary message" + [nil perform: #isNil with: 'excess arg']. "too many arguments" + [nil perform: #=] + } do: [:block | self - assert: (nil tryPrimitive: 83 withArgs: args) - equals: (Context runSimulated: [nil tryPrimitive: 83 withArgs: args])]. + assert: (block on: Error do: [:ex | ex messageText]) + equals: (Context runSimulated: [block on: Error do: [:ex | ex messageText]])]. ContextTest>>testPrimitive84 {tests} · ct 11/10/2021 00:21 (changed) testPrimitive84 { {#isNil. {}}. "valid 0-arg message" {#=. {true}}. "valid unary message" {#ifNil:ifNotNil:. {[2]. [:x | x]}}. "valid binary message" - {#isNil}. "missing arguments" {#isNil. 'not an array'}. "invalid arguments" {#isNil. {'excess arg'}}. "too many arguments" {#=. {}}. "missing argument" } do: [:args | self - assert: (nil tryPrimitive: 84 withArgs: args) - equals: (Context runSimulated: [nil tryPrimitive: 84 withArgs: args])]. + assert: ([nil perform: args first withArguments: args second] on: Error do: [:ex | ex messageText]) + equals: (Context runSimulated: [[nil perform: args first withArguments: args second] on: Error do: [:ex | ex messageText]])]. --- Sent from Squeak Inbox Talk

1 1

False merge conflicts
by Thiede, Christoph 30 Dec '21

30 Dec '21

Hi all, this is not the first time I am receiving a merge conflict resolution window while updating my image even though there is not a real merge conflict: [cid:cdf93b35-01eb-4934-8ba1-bfc8bef8a86d] Did anyone else of you experience similar issues in the past? Is there something wrong with the detection of merge conflicts? Best, Christoph <http://www.hpi.de/>

7 9

(FSPath / 'foo.bar.zot') extension = 'bar.zot'
by Tony Garnock-Jones 29 Dec '21

29 Dec '21

Hi all, Currently: (FSPath / 'foo.bar.zot') extension = 'bar.zot' Should it be? I expected it to equal 'zot'. For reference, in python3: os.path.splitext('foo.bar.zot') == ('foo.bar', '.zot') and in racket (equal? (path-get-extension "foo.bar.zot") #".zot") Tony

8 15

The Inbox: SUnit-ct.125.mcz
by commits＠source.squeak.org 29 Dec '21

29 Dec '21

Christoph Thiede uploaded a new version of SUnit to project The Inbox: http://source.squeak.org/inbox/SUnit-ct.125.mcz ==================== Summary ==================== Name: SUnit-ct.125 Author: ct Time: 29 March 2020, 1:02:50.60056 pm UUID: 814e778e-04dc-954c-93e3-fb19e307d4c8 Ancestors: SUnit-mt.121 Proposal: Update debugging logic of TestCase. Instead of abusing #halt, open a debugger directly on the test selector. Deprecates #openDebuggerOnFailingTestMethod. Also slightly refactors internal behavior to avoid some duplication, and to get rid of unnecessary semaphores which should not add any value compared to #ensure: unless some really low-level things are broken. Please correct me if I am wrong here! =============== Diff against SUnit-mt.121 =============== Item was added: + ----- Method: TestCase>>assureResourcesDuring: (in category 'private') ----- + assureResourcesDuring: aBlock + + | resources | + resources := self resources. + resources do: [:resource | + resource isAvailable ifFalse: [ + ^ resource signalInitializationError]]. + ^ aBlock ensure: [ + resources do: [:resource | + resource reset]].! Item was changed: ----- Method: TestCase>>debug (in category 'running') ----- debug + "Run the receiver and open a debugger on the first failure or error." + + ^ self assureResourcesDuring: [self runCaseWithoutTimeout]! - self resources do: - [ : res | res isAvailable ifFalse: [ ^ res signalInitializationError ] ]. - [ self runCase ] ensure: - [ self resources do: - [ : each | each reset ] ]! Item was changed: ----- Method: TestCase>>debugAsFailure (in category 'running') ----- debugAsFailure + "Spawn a debugger that is ready to debug the receiver." + + (Process + forBlock: [self debug] + runUntil: [:context | context selector = testSelector]) + debug.! - | semaphore | - semaphore := Semaphore new. - self resources do: [:res | - res isAvailable ifFalse: [^res signalInitializationError]]. - [semaphore wait. self resources do: [:each | each reset]] fork. - (self class selector: testSelector) runCaseAsFailure: semaphore.! Item was changed: ----- Method: TestCase>>openDebuggerOnFailingTestMethod (in category 'running') ----- openDebuggerOnFailingTestMethod + + self deprecated: 'ct: Use #debugAsFailure'. + "SUnit has halted one step in front of the failing test method. Step over the 'self halt' and send into 'self perform: testSelector' to see the failure from the beginning" - self halt; performTest! Item was changed: ----- Method: TestCase>>runCaseAsFailure: (in category 'running') ----- runCaseAsFailure: aSemaphore + + self deprecated: 'ct: Use #runCaseWithoutTimeout and #ensure:'. + ^ [self runCaseWithoutTimeout] + ensure: [aSemaphore signal]! - [self setUp. - self openDebuggerOnFailingTestMethod] ensure: [ - self tearDown. - aSemaphore signal]! Item was added: + ----- Method: TestCase>>runCaseWithoutTimeout (in category 'running') ----- + runCaseWithoutTimeout + + [self setUp. + self performTest] + ensure: [self tearDown].!

4 4

The Trunk: System-cmm.1214.mcz
by commits＠source.squeak.org 26 Dec '21

26 Dec '21

Chris Muller uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-cmm.1214.mcz ==================== Summary ==================== Name: System-cmm.1214 Author: cmm Time: 5 February 2021, 10:09:05.179247 pm UUID: d6f968d9-a638-42ef-89ef-d37af0f31ffd Ancestors: System-mt.1213 Patch the patcher. Smalltalk run: permits the patching of a production system without having to resort to running a custom image, but when the patch.st file has read-only status in the OS, FileStream class>>#fileNamed:do: can't open it, because it tries to open for read/write. But rather htan signal an error, it silently does nothing (wow), leaving the system unpatched. Patch files can and should be read-only anyway, so use DirectoryEntryFile>>#readStreamDo:. =============== Diff against System-mt.1213 =============== Item was changed: ----- Method: SmalltalkImage>>patchSystem (in category 'command line') ----- patchSystem 'patch.st' asDirectoryEntry ifNotNil: [ : patchEntry | patchEntry modificationTime > Smalltalk imageName asDirectoryEntry modificationTime ifTrue: [ Notification signal: 'Patching system...'. + patchEntry readStreamDo: [ : stream | stream fileIn ] ] - FileStream - fileNamed: 'patch.st' - do: - [ : stream | stream fileIn ] ] ifFalse: [ self error: 'patch.st file is older than the image file. Aborting.' ] ]!

3 5

The semantics of halfway-executed unwind contexts during process termination
by Thiede, Christoph 17 Dec '21

17 Dec '21

Hi all, hi Jaromir, I'm raising a new question in this post that is related to the following threads, but I think that it deserves its own thread due to the fundamental criticism expressed: [1, 2] I just took a closer look at ProcessTest >> #testNestedUnwind and I have to say that I don't agree with it. I'm sorry that I did not mention this earlier, but somehow this aspect of Jaromir's large amount of recent work has escaped my attention before today. For reference, so that we all know what we are talking about, here is the test in question: testNestedUnwind "Test all nested unwind blocks are correctly unwound; all unwind blocks halfway through their execution should be completed or at least attempted to complete, not only the innermost one" | p x1 x2 x3 | x1 := x2 := x3 := false. p := [ [ [ ] ensure: [ "halfway through completion when suspended" [ ] ensure: [ "halfway through completion when suspended" Processor activeProcess suspend. x1 := true]. x2 := true] ] ensure: [ "not started yet when suspended" x3 := true] ] fork. Processor yield. p terminate. self assert: x1 & x2 & x3. I'm not convinced about the assertions in this test. :-) In fact, I would only expect x3 to be true but x1 and x2 to be false! IMHO, when terminating a process, halfway-executed unwinded contexts should not be continued. Only not-yet-activated unwind contexts should be triggered. Here are my arguments: * Regular unwinding and process termination should have exactly the same behavior. Assume we manipulated the example from the test like this: [ [ [ [ ] ensure: [ "halfway through completion when suspended" [ ] ensure: [ "halfway through completion when suspended" self error. x1 := true]. x2 := true] ] ensure: [ "not started yet when suspended" x3 := true] ] on: Error do: [] ] fork. I have highlighted the differences, so what I changed was i) to insert an error handler at the bottom of the process and ii) instead of terminating the process, to raise an error in the innermost block. In this example, only x3 will be set to true which is because the exceptional control flow explicitly discontinues the logic running inside the error handler. Only not-yet-activated unwind contexts will be triggered as part of the unwinding, which only applies to the outermost unwind context. In my view, process termination should have exactly the same semantics as using an exception to abort the control flow. If we would not catch the error in the above example but press Abandon in the appearing debugger instead, I see no reason why we would want to execute a different set of unwind contexts. * Last but not least, the fact that an error has been signaled means that the signalerContext is "infected" so under no circumstances, abandoning the process should resume the execution of this infected context! (The only exception is when you consciously do so via the "Proceed" button in a debugger.) This might become more vivid if I replace the innermost block with the following: x1 := (2 / 0 "error!") > 0. Actually, it is enough to run the following stand-alone: [] ensure: [ x1 := (2 / 0 "error!") > 0 ] If you debug the Abandon button, you can see that another error occurs while terminating the process, which is a MessageNotUnderstood for #> in ZeroDivision. The only reason why a second debugger does not appear is the current bug in Process >> #terminate which "absorbs" subsequent error in this situation and which is currently being discussed in [2]. Sorry for the long message! I hope that you agree with my arguments, and if not, I am very excited to hear your ones. :-) Unless contradicted, I would like to request to change #testNestedUnwind as described above and use the changed version as the general basis for the ongoing discussions in [1, 2]. But maybe I am also just committing a fatal case of false reasoning ... :-) Best, Christoph [1] http://forum.world.st/The-Inbox-Kernel-ct-1405-mcz-td5129706.html [2] http://forum.world.st/stepping-over-non-local-return-in-a-protected-block-t…

7 17

The Trunk: Morphic-eem.1786.mcz
by commits＠source.squeak.org 13 Dec '21

13 Dec '21

Eliot Miranda uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-eem.1786.mcz ==================== Summary ==================== Name: Morphic-eem.1786 Author: eem Time: 4 November 2021, 12:44:06.340704 pm UUID: 6a2f11a1-29ae-4254-b9a7-585512357c51 Ancestors: Morphic-mt.1785 Add a Find Workspace... item to teh end of the Find Window menu. This finds and activates a workspace in any project (my life has too many projecvts with too many workspaces in them to lve without this kind of help). Abstracting the facility to search for other kinds of windows is left as an exercise to the reader (I don't see the need for being able to find other than workspaces, but that might be just me). Needs System-eem.1245. =============== Diff against Morphic-mt.1785 =============== Item was added: + ----- Method: MorphicProject>>topMorphicProject (in category 'accessing') ----- + topMorphicProject + parentProject == self ifTrue: [^self]. + parentProject ifNil: [self nilParentError]. + ^parentProject isMorphic + ifTrue: [parentProject topMorphicProject] + ifFalse: [self]! Item was changed: ----- Method: TheWorldMainDockingBar>>listWindowsOn: (in category 'submenu - windows') ----- listWindowsOn: menu | windows | windows := self allVisibleWindows sorted: [:winA :winB | ((winA model isNil or: [winB model isNil]) or: [winA model name = winB model name]) ifTrue: [winA label < winB label] ifFalse: [winA model name < winB model name]]. windows ifEmpty: [ menu addItem: [ :item | item contents: 'No Windows' translated; isEnabled: false ] ]. windows do: [ :each | | windowColor | windowColor := (each model respondsTo: #windowColorToUse) ifTrue: [each model windowColorToUse] ifFalse: [UserInterfaceTheme current get: #uniformWindowColor for: Model]. menu addItem: [ :item | item contents: (self windowMenuItemLabelFor: each); icon: (self colorIcon: windowColor); target: each; selector: #comeToFront; subMenuUpdater: self selector: #windowMenuFor:on: arguments: { each }; action: [ each beKeyWindow; expand ] ] ]. menu addLine; add: 'Collapse all windows' target: (Project current world) selector: #collapseAllWindows; add: 'Close all windows' target: self selector: #closeAllWindowsUnsafe; addItem: [:item | item contents: 'Close all windows without changes'; target: self; icon: MenuIcons smallBroomIcon; selector: #closeAllWindows]; + add: 'Close all windows but workspaces' target: self selector: #closeAllWindowsButWorkspaces; + addItem: + [ :item | + item + contents: 'Find Workspace...'; + target: self; + selector: #findWorkspace; + subMenuUpdater: self + selector: #workspacesMenuFor: + arguments: #()]! - add: 'Close all windows but workspaces' target: self selector: #closeAllWindowsButWorkspaces.! Item was added: + ----- Method: TheWorldMainDockingBar>>selectWorkspace:window:inProject:contents: (in category 'submenu - windows') ----- + selectWorkspace: aWorkspace window: aSystemWindow inProject: aMorphicProject contents: contents + aMorphicProject + addDeferredUIMessage: [aSystemWindow comeToFront]; + enter "Does nothing if already the current project..." + ! Item was added: + ----- Method: TheWorldMainDockingBar>>workspacesMenuFor: (in category 'submenu - windows') ----- + workspacesMenuFor: anUpdatingMenuMorph + | allWorkspaces | + allWorkspaces := Set new. + Project current topMorphicProject withChildrenDo: + [:project| + project world submorphs do: + [:m| + (m model isKindOf: Workspace) ifTrue: + [allWorkspaces add: + { m model. + m. + project. + m model contents ifEmpty: + [(m model dependents detect: [:d| d isTextView] ifNone: nil) textMorph contents] }]]]. + "Sort workspaces with non-empty ones first..." + (allWorkspaces sorted: + [:t1 :t2| + t1 last isEmpty == t2 last isEmpty + ifTrue: [t1 second label <= t2 second label] + ifFalse: [t1 last notEmpty]]) do: + [:tuple| + anUpdatingMenuMorph addItem: + [:item | item + contents: tuple second label, ': ', (tuple last asString contractTo: 128); + target: self; + selector: #selectWorkspace:window:inProject:contents:; + arguments: tuple]]!

7 9

The Trunk: System-ct.1242.mcz
by commits＠source.squeak.org 10 Dec '21

10 Dec '21

Christoph Thiede uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-ct.1242.mcz ==================== Summary ==================== Name: System-ct.1242 Author: ct Time: 3 October 2021, 3:03:42.480874 pm UUID: 65b8dbdb-0855-2440-bec4-b96c5d72468a Ancestors: System-mt.1241 Adds missing standard query to Preferences. =============== Diff against System-mt.1241 =============== Item was added: + ----- Method: Preferences class>>allowEtoyUserCustomEvents (in category 'standard queries') ----- + allowEtoyUserCustomEvents + ^ self + valueOfFlag: #allowEtoyUserCustomEvents + ifAbsent: [false]!

2 1

The Trunk: Morphic-mt.1777.mcz
by commits＠source.squeak.org 10 Dec '21

10 Dec '21

Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.1777.mcz ==================== Summary ==================== Name: Morphic-mt.1777 Author: mt Time: 21 July 2021, 10:52:27.461807 am UUID: 7889f198-c567-42b5-86b7-6ec550f79355 Ancestors: Morphic-mt.1776 Complements System-mt.1240 =============== Diff against Morphic-mt.1776 =============== Item was changed: ----- Method: SmalltalkEditor>>styleSelection (in category 'do-its') ----- styleSelection | styler | self lineSelectAndEmptyCheck: [^ '']. + styler := self styler ifNil: [(TextStyler for: #Smalltalk) new]. - styler := self styler ifNil: [(Smalltalk classNamed: #SHTextStylerST80) new]. ^ styler styledTextFor: self selection!

2 1

The Inbox: Morphic-ct.1792.mcz
by commits＠source.squeak.org 10 Dec '21

10 Dec '21

A new version of Morphic was added to project The Inbox: http://source.squeak.org/inbox/Morphic-ct.1792.mcz ==================== Summary ==================== Name: Morphic-ct.1792 Author: ct Time: 1 November 2021, 7:53:35.595429 pm UUID: d73224ba-841c-b647-a544-0d171ae13e69 Ancestors: Morphic-eem.1784 Editors: Extends autoEnclose and blinkPrevParen: to also support quotes and chevrons, which is just consistent with encloseSelection imho. =============== Diff against Morphic-eem.1784 =============== Item was changed: ----- Method: SmalltalkEditor>>blinkPrevParen: (in category 'parenblinking') ----- blinkPrevParen: aCharacter "Same as super, but tries to follow the Smalltalk syntax." | openDelimiter closeDelimiter level string here inside | string := paragraph text string. here := pointBlock stringIndex. openDelimiter := aCharacter. + closeDelimiter := '([{<"''|' at: (')]}>"''|' indexOf: openDelimiter). - closeDelimiter := '([{' at: (')]}' indexOf: openDelimiter). level := 1. inside := nil. "Tricky." (here > 1 and: [ (string at: here - 1) = $$ ]) ifTrue: [ ^self ]. "Just a character literal." [ level > 0 and: [ here > 1 ] ] whileTrue: [ | hereChar | hereChar := string at: (here := here - 1). inside "Are we inside a comment or string literal?" ifNotNil: [ "Yes." hereChar = inside ifTrue: [ (here > 1 and: [ (string at: here - 1) ~= inside ]) ifTrue: [ inside := nil ] ifFalse: [ here := here - 1 ] ] ] ifNil: [ (here > 1 and: [ (string at: here - 1) = $$ ]) "Just a character literal." ifTrue: [ here := here - 1 ] ifFalse: [ hereChar caseOf: { [ closeDelimiter ] -> [ (level := level - 1) = 0 ifTrue: [ ^self blinkParenAt: here ] ]. [ openDelimiter ] -> [ level := level + 1 ]. [ $" ] -> [ inside := $" ]. [ $' ] -> [ inside := $' ] } otherwise: [] ] ] ]! Item was changed: ----- Method: TextEditor class>>autoEnclose (in category 'preferences') ----- autoEnclose + <preference: 'Auto enclose brackets () {} [] '''' "" || <>' - <preference: 'Auto enclose brackets () {} []' categoryList: #('Morphic' 'editing') description: 'When true, typing an opening parenthesis, bracket or square-bracket will also add its corresponding closing character after the cursor so you can type within the bracket.' type: #Boolean> ^ AutoEnclose ifNil: [ false ]! Item was changed: ----- Method: TextEditor>>autoEncloseFor: (in category 'typing support') ----- autoEncloseFor: typedChar "Answer whether typeChar was handled by auto-enclosure. Caller should call normalCharacter if not." | openers closers | + openers := '([{<"''|'. + closers := ')]}>"''|'. - openers := '([{'. - closers := ')]}'. (closers includes: typedChar) ifTrue: [ | pos | self blinkPrevParen: typedChar. ((pos := self indexOfNextNonwhitespaceCharacter) notNil and: [ (paragraph string at: pos) = typedChar ]) ifTrue: [ self moveCursor: [ : position | position + pos - pointBlock stringIndex + 1 ] forward: true select: false. + ^ true ] ]. - ^ true ] - ifFalse: [ ^ false ] ]. (openers includes: typedChar) ifTrue: [ self openTypeIn; addString: typedChar asString; addString: (closers at: (openers indexOf: typedChar)) asString; insertAndCloseTypeIn; moveCursor: [ : position | position - 1 ] forward: false select: false. ^ true ]. ^ false! Item was changed: ----- Method: TextEditor>>blinkPrevParen: (in category 'parenblinking') ----- blinkPrevParen: aCharacter "Used if not Shout" | openDelimiter closeDelimiter level string here hereChar | string := paragraph string. here := pointBlock stringIndex. openDelimiter := aCharacter. + closeDelimiter := '([{<"''|' at: (')]}>''"|' indexOf: openDelimiter). - closeDelimiter := '([{' at: (')]}' indexOf: openDelimiter). level := 1. [level > 0 and: [here > 1]] whileTrue: [hereChar := string at: (here := here - 1). hereChar = closeDelimiter ifTrue: [level := level - 1. level = 0 ifTrue: [^ self blinkParenAt: here]] ifFalse: [hereChar = openDelimiter ifTrue: [level := level + 1]]]!

2 1

← Newer
1
...
4
5
6
7
8
9
10
...
28
Older →

Jump to page: