Marcel Taeumel uploaded a new version of ToolBuilder-Morphic to project The Trunk:
http://source.squeak.org/trunk/ToolBuilder-Morphic-mt.277.mcz
==================== Summary ====================
Name: ToolBuilder-Morphic-mt.277
Author: mt
Time: 21 July 2021, 10:53:59.879807 am
UUID: ea683da3-81f0-4510-9e5c-842fb813f458
Ancestors: ToolBuilder-Morphic-mt.276
Complements System-mt.1240
=============== Diff against ToolBuilder-Morphic-mt.276 ===============
Item was changed:
----- Method: PluggableTextMorphPlus>>useDefaultStyler (in category 'initialize') -----
useDefaultStyler
"This should be changed to a proper registry but as long as there is only shout this will do"
+ (TextStyler for: #Smalltalk)
- (self userInterfaceTheme stylerClass ifNil: [Smalltalk at: #SHTextStylerST80])
ifNotNil: [:stylerClass | self styler: (stylerClass new view: self)].!
Marcel Taeumel uploaded a new version of Compiler to project The Trunk:
http://source.squeak.org/trunk/Compiler-mt.459.mcz
==================== Summary ====================
Name: Compiler-mt.459
Author: mt
Time: 21 July 2021, 10:51:32.236807 am
UUID: 16065aa8-3f46-4a0d-95d2-ceff9f227104
Ancestors: Compiler-nice.458
Complements System-mt.1240
=============== Diff against Compiler-nice.458 ===============
Item was changed:
----- Method: MethodNode>>asColorizedSmalltalk80Text (in category 'converting') -----
asColorizedSmalltalk80Text
"Answer a colorized Smalltalk-80-syntax string description of the parse tree whose root is the receiver."
| printText |
printText := self printString asText.
+ ^(TextStyler for: #Smalltalk)
- ^(Smalltalk at: #SHTextStylerST80 ifAbsent: [nil])
ifNotNil: [:stylerClass| stylerClass new styledTextFor: printText]
ifNil: [printText]!
Marcel Taeumel uploaded a new version of System to project The Trunk:
http://source.squeak.org/trunk/System-mt.1240.mcz
==================== Summary ====================
Name: System-mt.1240
Author: mt
Time: 21 July 2021, 10:50:42.926807 am
UUID: 6c7a59f2-afd8-467e-b0f2-80197d8ae3e1
Ancestors: System-mt.1239
Adds new AppRegistry to manage text stylers for different language syntaxes. With this, you can make you app independent from the particular styler being present in the system.
In Trunk we only have a Shout styler for Smalltalk: #SHTextStylerST80. Yet, there is also one for #Markdown here: https://github.com/hpi-swa-teaching/MarkdownEditor -- There might be more in the future.
Especially Squeak's HelpBrowser can benefit from decoupling the concept of syntax highlighting on help pages from the actual implementation of such stylers. There might not only be Smalltalk code to be styled on the many pages of a help book.
Finally, this AppRegistry removes the need of sprinkling #SHTextStylerST80 all over the place. Just write "TextStyler for: #Smalltalk".
=============== Diff against System-mt.1239 ===============
Item was added:
+ AppRegistry subclass: #TextStyler
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'System-Applications'!
+
+ !TextStyler commentStamp: 'mt 7/21/2021 10:30' prior: 0!
+ I am an AppRegistry that manages multiple provider classes that can style multiple language syntaxes.
+
+ All providers are expected to have the public Shout interface for text styling. For the view-callback protocol, this encompasses:
+ #view:
+ #style: (with #stylerStyled: callback)
+ #styleInBackgroundProcess: (with #stylerStyledInBackground: callack)
+ There is also more direct way to control text attributes in text objects via #styledTextFor: und #unstyledTextFrom:.
+
+ Note that existing model-view composites for text editing apply an extra check on top of such stylers via #okToStyle and #aboutToStyle:(requestor:). From there, models tend to configure text stylers as follows:
+ #environment:
+ #classOrMetaClass:
+ #context:
+ #parseAMethod:
+ #sourceMap:
+ #workspace:
+ While this only applies to #Smalltalk code styling, it might be advisable to stub those methods for better compatibility -- especially if you plan to use your custom styler in models such as Debugger, Inspector, SyntaxError, and Workspace.!
Item was added:
+ ----- Method: TextStyler class>>askForDefault (in category 'defaults - Smalltalk') -----
+ askForDefault
+
+ ^ self askForDefaultFor: #Smalltalk!
Item was added:
+ ----- Method: TextStyler class>>askForDefaultFor: (in category 'defaults') -----
+ askForDefaultFor: syntax
+
+ | knownStylerClasses newDefault |
+ knownStylerClasses := registeredClasses at: syntax ifAbsent: [#()].
+ knownStylerClasses ifEmpty:
+ [self inform: 'There are no stylers for ', syntax printString, ' registered.'.
+ ^ self default: nil for: syntax].
+ knownStylerClasses size = 1 ifTrue:
+ [^ self default: knownStylerClasses anyOne for: syntax].
+ newDefault := UIManager default
+ chooseFrom: (knownStylerClasses collect: [:ea | ea nameForViewer])
+ values: knownStylerClasses
+ title: 'Which styler for ', syntax printString, ' would you prefer?'.
+ self
+ default: (newDefault ifNil: [knownStylerClasses anyOne])
+ for: syntax.
+ ^ self defaultFor: syntax!
Item was added:
+ ----- Method: TextStyler class>>default (in category 'accessing - Smalltalk') -----
+ default
+
+ ^ self defaultFor: #Smalltalk!
Item was added:
+ ----- Method: TextStyler class>>default: (in category 'accessing - Smalltalk') -----
+ default: aClassOrNil
+
+ ^ self default: aClassOrNil for: #Smalltalk.!
Item was added:
+ ----- Method: TextStyler class>>default:for: (in category 'accessing') -----
+ default: aClassOrNil for: syntax
+
+ | oldDefault |
+ oldDefault := default at: syntax ifAbsent: [].
+ aClassOrNil
+ ifNil: [ default removeKey: syntax ifAbsent: []]
+ ifNotNil: [
+ self register: aClassOrNil for: syntax.
+ default at: syntax put: aClassOrNil ].
+ ^ oldDefault!
Item was added:
+ ----- Method: TextStyler class>>defaultFor: (in category 'accessing') -----
+ defaultFor: syntax
+
+ ^ default
+ at: syntax
+ ifAbsent: [self askForDefaultFor: syntax]!
Item was added:
+ ----- Method: TextStyler class>>defaultOrNil (in category 'accessing - Smalltalk') -----
+ defaultOrNil
+
+ ^ self defaultOrNilFor: #Smalltalk!
Item was added:
+ ----- Method: TextStyler class>>defaultOrNilFor: (in category 'accessing') -----
+ defaultOrNilFor: syntax
+
+ ^ default at: syntax ifAbsent: []!
Item was added:
+ ----- Method: TextStyler class>>for: (in category 'accessing') -----
+ for: syntax
+ "For convenience."
+
+ ^ self defaultOrNilFor: syntax!
Item was added:
+ ----- Method: TextStyler class>>initialize (in category 'class initialization') -----
+ initialize
+ "Manage syntax-specific stylers."
+
+ registeredClasses := Dictionary new.
+ default := Dictionary new.!
Item was added:
+ ----- Method: TextStyler class>>register: (in category 'registration - Smalltalk') -----
+ register: aProviderClass
+
+ self register: aProviderClass for: #Smalltalk.!
Item was added:
+ ----- Method: TextStyler class>>register:for: (in category 'registration') -----
+ register: aProviderClass for: syntax
+
+ | knownStylers |
+ knownStylers := registeredClasses at: syntax ifAbsentPut: [Set new].
+ (knownStylers ifAbsentAdd: aProviderClass) ifTrue: [
+ knownStylers size > 1
+ ifTrue: ["Ask for a new default if there are alternatives."
+ self default: nil for: syntax]
+ ifFalse: [
+ self default: aProviderClass for: syntax]].!
Item was added:
+ ----- Method: TextStyler class>>unregister: (in category 'registration - Smalltalk') -----
+ unregister: aProviderClass
+
+ self unregister: aProviderClass for: #Smalltalk.!
Item was added:
+ ----- Method: TextStyler class>>unregister:for: (in category 'registration') -----
+ unregister: aProviderClass for: syntax
+ ((self defaultFor: syntax) = aProviderClass)
+ ifTrue: [self default: nil for: syntax].
+ (self registeredClasses at: syntax ifAbsent: [Set new])
+ remove: aProviderClass ifAbsent: [].!
Eliot Miranda uploaded a new version of Kernel to project The Trunk:
http://source.squeak.org/trunk/Kernel-eem.1407.mcz
==================== Summary ====================
Name: Kernel-eem.1407
Author: eem
Time: 9 July 2021, 2:46:18.688883 pm
UUID: 48a520fa-d6a2-44fa-8508-3405e7e0b8b9
Ancestors: Kernel-mt.1406
Have scanForInstructionSequence: descend into full blocks. Eliminate cases handled by otherwise clause in installVirtualKeyTable. Add error code to resue primitive invocation.
=============== Diff against Kernel-mt.1406 ===============
Item was changed:
----- Method: EventSensor class>>installVirtualKeyTable (in category 'class initialization') -----
installVirtualKeyTable
VirtualKeyTable := Smalltalk windowSystemName
caseOf: {
['Windows'] -> [self virtualKeysOnWindows].
['Win32' "older VMs"] -> [self virtualKeysOnWindows].
['Aqua'] -> [self virtualKeysOnMacOS].
['X11'] -> [self virtualKeysOnX11].
- ['RiscOS'] -> [Dictionary new].
- ['Quartz'] -> [Dictionary new].
} otherwise: [Dictionary new].
"Shift 8 bits to not overwrite virtual-key mappings from above."
self mapControlKeysToCommandKeys ifTrue: [
VirtualKeyTable
at: (2r0010 "ctrl" bitShift: 8)
put: (2r1010 "cmd+ctrl").
VirtualKeyTable
at: (2r0011 "ctrl+shift" bitShift: 8)
put: (2r1011 "cmd+ctrl+shift")].
self mapAltKeysToOptionKeys ifTrue: [
VirtualKeyTable
at: (2r1000 "cmd/alt" bitShift: 8)
put: (2r1100 "cmd/alt+opt").
VirtualKeyTable
at: (2r1001 "cmd/alt+shift" bitShift: 8)
put: (2r1101 "cmd/alt+opt+shift")].!
Item was changed:
----- Method: InstructionStream>>scanForInstructionSequence: (in category 'scanning') -----
scanForInstructionSequence: naryBlock
"naryBlock is a block taking one or more arguments.
Evaluate it for each sequence of instructions of length
n in the receiver until naryBlock evaluates to true.
Answer if naryBlock evaluated to true."
| instructions |
instructions := OrderedCollection withAll: ((1 to: naryBlock numArgs) collect:
[:ign|
+ self atEnd ifFalse:
+ [self nextInstruction]]).
+ instructions last ifNil: "not enough instructions, so no match in this method, but must check for blocks"
+ [instructions do:
+ [:instOrNil|
+ instOrNil ifNil: [^false].
+ (instOrNil selector == #pushFullClosure:numCopied:
+ and: [(self class on: instOrNil argument) scanForInstructionSequence: naryBlock]) ifTrue:
+ [^true]]].
- self atEnd ifTrue: [^false].
- self nextInstruction]).
[(naryBlock valueWithArguments: instructions asArray) ifTrue:
[^true].
+ (instructions first selector == #pushFullClosure:numCopied:
+ and: [(self class on: instructions first argument) scanForInstructionSequence: naryBlock]) ifTrue:
+ [^true].
self atEnd] whileFalse:
[instructions removeFirst; addLast: self nextInstruction].
^false!
Item was changed:
----- Method: Process>>resume (in category 'changing process state') -----
resume
"Primitive. Allow the process that the receiver represents to continue. Put
the receiver in line to become the activeProcess. Fail if the receiver is
already waiting in a queue (in a Semaphore or ProcessScheduler). Fail if
the receiver's suspendedContext is not a context.
Essential. See Object documentation whatIsAPrimitive."
+ <primitive: 87 error: ec>
- <primitive: 87>
self primitiveFailed!
Marcel Taeumel uploaded a new version of Regex-Tests-Core to project The Trunk:
http://source.squeak.org/trunk/Regex-Tests-Core-ct.13.mcz
==================== Summary ====================
Name: Regex-Tests-Core-ct.13
Author: ct
Time: 8 July 2021, 12:45:29.187695 am
UUID: 77b31977-aedb-324b-b792-fc32346ff596
Ancestors: Regex-Tests-Core-ct.12
Adds a regression test for lookbehinds in optional/repeatable groups which should work.
=============== Diff against Regex-Tests-Core-ct.12 ===============
Item was added:
+ ----- Method: RxParserTest>>testOptionalLookbehind (in category 'tests') -----
+ testOptionalLookbehind
+
+ self assert: ['A' matchesRegex: '((?<=^)A)+']!
Marcel Taeumel uploaded a new version of Regex-Tests-Core to project The Trunk:
http://source.squeak.org/trunk/Regex-Tests-Core-ct.14.mcz
==================== Summary ====================
Name: Regex-Tests-Core-ct.14
Author: ct
Time: 8 July 2021, 12:52:32.198695 am
UUID: 7fc43ad7-9987-9f48-aee8-07498df21307
Ancestors: Regex-Tests-Core-ct.13
Adds another regression test for lookbehinds in nullable closures. This one is more serious; it raises a nil MNU because the marker chain is defect.
Just adding this for now as a known bug, I don't have the resources to fix this right now. But if no one else is keen on this, I will probably give this another try in my next holidays ... :-)
=============== Diff against Regex-Tests-Core-ct.12 ===============
Item was added:
+ ----- Method: RxParserTest>>testOptionalLookbehind (in category 'tests') -----
+ testOptionalLookbehind
+
+ self assert: ['A' matchesRegex: '((?<=^)A)+'].
+
+ self assert: [('AB' allRegexMatches: '((?<=a)b)?') asArray = #('A')].!
Marcel Taeumel uploaded a new version of Regex-Core to project The Trunk:
http://source.squeak.org/trunk/Regex-Core-ct.60.mcz
==================== Summary ====================
Name: Regex-Core-ct.60
Author: ct
Time: 8 July 2021, 12:56:00.161695 am
UUID: 6ab872b9-268c-854c-96a3-9d743c137f20
Ancestors: Regex-Core-ct.59
Fixes lookbehinds in particular optional/repeatable groups. See Regex-Tests-Core-ct.13.
Note that is only the tip of the iceberg; unfortunately, I discovered even more serious with lookbehind expresion in nullable groups (see Regex-Tests-Core.ct14). Nevertheless, I'd like to see this particular patch earlier in the Trunk as it at least fixes simple cases like in the test; there seem to be two independent defects in the implementation (one of which is fixed hereby).
=============== Diff against Regex-Core-ct.59 ===============
Item was changed:
----- Method: RxMatcher>>matchAgainstLookbehind:positive:nextLink: (in category 'matching') -----
matchAgainstLookbehind: lookbehind positive: positive nextLink: anRmxLink
| position matchesLookbehind |
position := stream position.
matchesLookbehind := (position to: 0 by: -1)
anySatisfy: [:index |
stream position: index.
(lookbehind matchAgainst: self)
and: [stream position = position]].
+ stream position: position.
matchesLookbehind = positive
ifFalse: [^ false].
- stream position: position.
^ anRmxLink matchAgainst: self!