diff --git a/packages/DomainCode-Core/CompiledMethod.extension.st b/packages/DomainCode-Core/CompiledMethod.extension.st index 1ace11d..3e05a5b 100644 --- a/packages/DomainCode-Core/CompiledMethod.extension.st +++ b/packages/DomainCode-Core/CompiledMethod.extension.st @@ -1,9 +1,9 @@ Extension { #name : #CompiledMethod } { #category : #'*DomainCode-Core' } -CompiledMethod >> openDC: convert [ - - +CompiledMethod >> openDC:convert [ + + - convert do: [DCSmalltalkMethod for: self] +convert do:[DCSmalltalkMethod for:self] ] diff --git a/packages/DomainCode-Core/DCQuery.class.st b/packages/DomainCode-Core/DCQuery.class.st index 3230075..4d64b87 100644 --- a/packages/DomainCode-Core/DCQuery.class.st +++ b/packages/DomainCode-Core/DCQuery.class.st @@ -32,6 +32,13 @@ DCQuery class >> does: aDomainObject haveProperty: anObject [ ifAbsent: [false] ] +{ #category : #'as yet unclassified' } +DCQuery class >> firstScript: aCollectionOfCollections with: anObject [ + + aCollectionOfCollections do: [:script | (self script: script with: anObject) ifNotNil: [:res | ^ res]]. + ^ nil +] + { #category : #'as yet unclassified' } DCQuery class >> match: aClosure with: anObject do: anotherClosure [ @@ -52,3 +59,34 @@ DCQuery class >> removeProperty: anObject from: aDomainObject [ at: aDomainObject ifPresent: [:properties | properties remove: aDomainObject] ] + +{ #category : #'as yet unclassified' } +DCQuery class >> script: aCollection first: anotherCollection [ + + anotherCollection do: [:obj | (self script: aCollection with: obj) ifNotNil: [:res | ^ res]]. + ^ nil +] + +{ #category : #'as yet unclassified' } +DCQuery class >> script: aCollection with: anObject [ + + | current | + current := anObject. + aCollection do: [:block | | res | + block isCollection + ifTrue: [ + (self script: block with: current) + ifNil: [^ nil] + ifNotNil: [:o | current := o]] + ifFalse: [ + res := (current isCollection and: [current notEmpty and: [current first = #args]]) + ifTrue: [block valueWithArguments: current allButFirst] + ifFalse: [block value: current]. + res == nil ifTrue: [^ nil]. + res == false ifTrue: [^ nil]. + res isCollection ifTrue: [ + res ifEmpty: [^ nil]. + res first = #args and: [(res anySatisfy: [:subRes | subRes == nil or: [subRes == false or: [subRes isCollection and: [subRes isEmpty]]]]) ifTrue: [^ nil]]]. + res ~~ true ifTrue: [current := res]]]. + ^ current +] diff --git a/packages/DomainCode-Diff/DCChawatheScriptGenerator.class.st b/packages/DomainCode-Diff/DCChawatheScriptGenerator.class.st index 8603724..abb6456 100644 --- a/packages/DomainCode-Diff/DCChawatheScriptGenerator.class.st +++ b/packages/DomainCode-Diff/DCChawatheScriptGenerator.class.st @@ -21,11 +21,8 @@ DCChawatheScriptGenerator >> alignChildrenSrc: w dest: x srcInOrder: srcInOrder s2 do: [:b | s1 do: [:a | - ((aMapping includes: {a. b}) and: [(lcs includes: {a. b}) not]) ifTrue: [ | k | - "FIXME delete first or find position first?" - "a delete." - k := self findPosition: b dest: destInOrder in: aMapping. - self move: a to: w at: k. + ((aMapping includes: {a. b}) and: [(lcs includes: {a. b}) not]) ifTrue: [ + self move: a to: w postDeleteDo: [self findPosition: b dest: destInOrder in: aMapping]. srcInOrder add: a. destInOrder add: b]]] ] @@ -80,10 +77,11 @@ DCChawatheScriptGenerator >> generateFrom: src to: dest in: aMapping [ ifTrue: [ w := aMapping srcForDest: x. w range: x range. - x = dest ifFalse: [ | v | + x = dest ifFalse: [ | v k | v := w owner. w treeLabel = x treeLabel ifFalse: [self update: w with: x contents]. - z = v ifFalse: [self move: w to: z at: (self findPosition: x dest: destInOrder in: aMapping)]]]. + k := self findPosition: x dest: destInOrder in: aMapping. + z = v ifFalse: [self move: w to: z postDeleteDo: [k]]]]. srcInOrder add: w. destInOrder add: x. @@ -134,9 +132,12 @@ DCChawatheScriptGenerator >> maybeAttachFlash: aMorph [ ] { #category : #actions } -DCChawatheScriptGenerator >> move: aMorph to: anOwnerMorph at: aNumber [ +DCChawatheScriptGenerator >> move: aMorph to: anOwnerMorph postDeleteDo: aBlock [ - anOwnerMorph addMorph: aMorph asElementNumber: aNumber + | index | + aMorph delete. + index := aBlock value. + anOwnerMorph addMorph: aMorph asElementNumber: index ] { #category : #actions } diff --git a/packages/DomainCode-Diff/DCCommandScriptGenerator.class.st b/packages/DomainCode-Diff/DCCommandScriptGenerator.class.st index d337eb5..1d370f9 100644 --- a/packages/DomainCode-Diff/DCCommandScriptGenerator.class.st +++ b/packages/DomainCode-Diff/DCCommandScriptGenerator.class.st @@ -51,19 +51,24 @@ DCCommandScriptGenerator >> insert: aMorph at: aNumber in: anOwnerMorph [ { #category : #testing } DCCommandScriptGenerator >> logChanges [ - ^ false +^true ] { #category : #actions } -DCCommandScriptGenerator >> move: aMorph to: anOwnerMorph at: aNumber [ +DCCommandScriptGenerator >> move: aMorph to: anOwnerMorph postDeleteDo: aBlock [ - self editor do: (SBMoveCommand new + | command | + command := SBMoveCommand new shouldMergeWithNext: true; container: anOwnerMorph; morph: aMorph; - index: aNumber). + notePosition. + aMorph delete. + command index: aBlock value. + self editor do: command. + self maybeAttachFlash: aMorph. - self logChanges ifTrue: [Transcript showln: {#move. anOwnerMorph. aNumber. aMorph}] + self logChanges ifTrue: [Transcript showln: {#move. anOwnerMorph. aBlock. aMorph}] ] { #category : #actions } diff --git a/packages/DomainCode-Diff/DCMappingStore.class.st b/packages/DomainCode-Diff/DCMappingStore.class.st index ef188df..789cc71 100644 --- a/packages/DomainCode-Diff/DCMappingStore.class.st +++ b/packages/DomainCode-Diff/DCMappingStore.class.st @@ -91,3 +91,21 @@ DCMappingStore >> srcToDest [ ^ srcToDest ] + +{ #category : #'as yet unclassified' } +DCMappingStore >> visualizeFrom: src to: dest [ + + | destExtent srcExtent editor | + srcExtent := src fullBounds; extent. + destExtent := dest fullBounds; extent. + + "container := SBBlock new. + listDirection: #leftToRight; hResizing: #shrinkWrap; vResizing: #shrinkWrap; changeTableLayout; layoutInset: 10; cellGap: 50; addMorphBack: src; addMorphBack: dest." + + editor := SBEditor openFor: src. + editor openMorphInView: dest. + self keysAndValuesDo: [:from :to | + from layoutInset: 10. + to layoutInset: 10. + ((editor connectFrom: from to: to) color: (Color random alpha: 0.2))]. +] diff --git a/packages/DomainCode-Diff/DCMatcher.class.st b/packages/DomainCode-Diff/DCMatcher.class.st index c827bbc..7a36985 100644 --- a/packages/DomainCode-Diff/DCMatcher.class.st +++ b/packages/DomainCode-Diff/DCMatcher.class.st @@ -30,9 +30,16 @@ DCMatcher >> commonAncestorOf: aCollection root: aTree [ { #category : #'as yet unclassified' } DCMatcher >> doCommandForEditsIn: aDest to: aSrc in: anEditor [ - DCCommandScriptGenerator new - editor: anEditor; - generateFrom: aSrc to: aDest in: (self matchFrom: aSrc to: aDest) + SBToggledCode comment: '' active: 2 do: { + [ + DCChawatheScriptGenerator new + generateFrom: aSrc + to: aDest + in: (self matchFrom: aSrc to: aDest)]. + [ + DCCommandScriptGenerator new + editor: anEditor; + generateFrom: aSrc to: aDest in: (self matchFrom: aSrc to: aDest)]} ] { #category : #'as yet unclassified' } diff --git a/packages/DomainCode-Diff/String.extension.st b/packages/DomainCode-Diff/String.extension.st index 8db4e23..4bb929c 100644 --- a/packages/DomainCode-Diff/String.extension.st +++ b/packages/DomainCode-Diff/String.extension.st @@ -30,3 +30,11 @@ String >> levenshteinRatioTo: anotherString [ lengthSum := self size + anotherString size. ^ (lengthSum - (self levenshteinDistanceTo: anotherString) / lengthSum) asFloat ] + +{ #category : #'*DomainCode-Diff' } +String >> withoutLeading: aCollection [ + + | firstValid | + firstValid := self findFirst: [:m | (aCollection includes: m) not]. + ^ firstValid > 0 ifTrue: [self copyFrom: firstValid to: self size] ifFalse: [''] +] diff --git a/packages/DomainCode-Parser/DCBlock.class.st b/packages/DomainCode-Parser/DCBlock.class.st index 7f64a9a..ba78a4f 100644 --- a/packages/DomainCode-Parser/DCBlock.class.st +++ b/packages/DomainCode-Parser/DCBlock.class.st @@ -135,6 +135,120 @@ DCBlock class >> registerShortcuts: aProvider [ aProvider cmdShortcut: $` do: #wrapInBackticks ] +{ #category : #smalltalk } +DCBlock class >> smalltalkBrowseImplementors [ + + + ^ { + self smalltalkMessageSend. + [:msg | + msg registerShortcut: #browseImplementors do: [ + { + self smalltalkMessageSendSelector. + [:selector :message | {#args. selector. self systemNavigation allImplementorsOf: selector asSymbol. message}]. + [:selector :list :message | + (message sandblockEditor isSingleArtefactView or: [list size > 1]) + ifTrue: [ + (message sandblockEditor model notNil and: [message sandblockEditor model isKindOf: MessageTrace]) + ifTrue: [ + message sandblockEditor model + browseAllImplementorsOf: selector asSymbol + requestor: #modelMenu] + ifFalse: [message systemNavigation browseAllImplementorsOf: selector asSymbol]] + ifFalse: [message sandblockEditor open: list first compiledMethod]]}]]} +] + +{ #category : #smalltalk } +DCBlock class >> smalltalkBrowseReferencesSend [ + + + ^ { + self smalltalkMessageSend. + [:msg | + msg registerShortcut: #browseSenders do: [ + { + self smalltalkMessageSendSelector. + [:sel :message | {#args. message. sel. self systemNavigation allCallsOn: sel asSymbol}]. + [:message :sel :calls | + (message sandblockEditor isSingleArtefactView or: [calls size > 1]) + ifTrue: [ + (message sandblockEditor model notNil and: [message sandblockEditor model isKindOf: MessageTrace]) + ifTrue: [ + message sandblockEditor model + browseAllCallsOn: sel asSymbol + requestor: #modelMenu] + ifFalse: [self systemNavigation browseAllCallsOn: sel asSymbol]] + ifFalse: [message sandblockEditor open: calls first compiledMethod]]}]]} +] + +{ #category : #smalltalk } +DCBlock class >> smalltalkDeclaration [ + + ^ { + [:x | x language = SBTSSmalltalk]. + [:x | x type = #identifier]. + [:id | {#args. id. id orAllParents: #(method block)}]. + [:id :scopes | + DCQuery script: { + [:scope | DCQuery firstScript: { + { "temporaries" + [:block | block childSandblocks detect: [:a | a type = #temporaries] ifNone: [nil]]. + [:args | args childSandblocks detect: [:arg | arg contents = id contents] ifNone: [nil]]. + }. + { "block args" + [:block | block childSandblocks select: [:a | a type = #block_argument]]. + [:args | args detect: [:arg | arg contents allButFirst = id contents] ifNone: [nil]]. + }. + { "method args" + [:method | method queryAll: '[(keyword_selector (identifier) @) (binary_selector (identifier) @)]']. + [:args | args detect: [:arg | arg contents = id contents] ifNone: [nil]]. + }} with: scope]. + } first: scopes + ] + } +] + +{ #category : #smalltalk } +DCBlock class >> smalltalkHighlightIdentifiers [ + + + ^ { + [:x | x isSelected]. + self smalltalkDeclaration. + self smalltalkUsesOfDeclaration. + [:decl :identifiers | identifiers do: #attachHighlight] + } +] + +{ #category : #smalltalk } +DCBlock class >> smalltalkMessageSend [ + + ^ { + [:x | x language = SBTSSmalltalk]. + [:x | #(keyword_message binary_message unary_message keyword binary_operator unary_identifier) includes: x type]. + [:x | x orParent: #(keyword_message binary_message unary_message)]} +] + +{ #category : #smalltalk } +DCBlock class >> smalltalkMessageSendSelector [ + + ^ { + self smalltalkMessageSend. + [:message | {#args. message queryAll: '[(keyword) (binary_operator) (unary_identifier)] @part'. message}]. + [:hits :message | {#args. hits select: [:part | part owner = message]. message}]. + [:hits :message | {#args. hits collect: #contents. message}]. + [:parts :message | {#args. parts joinSeparatedBy: ''. message}]} +] + +{ #category : #smalltalk } +DCBlock class >> smalltalkUsesOfDeclaration [ + + ^ { + [:decl | {#args. decl. decl orAnyParent: #(block method)}]. + [:decl :scope | {#args. decl. scope allBlocksSelect: [:x | (#(identifier block_argument) includes: x type) and: [(x contents withoutLeading: #($:)) = (decl contents withoutLeading: #($:))]]}] + } +] + { #category : #'as yet unclassified' } DCBlock >> absolutePositionOf: aMorph [ @@ -178,13 +292,13 @@ DCBlock >> alias [ ^ nil ] -{ #category : #'as yet unclassified' } +{ #category : #queries } DCBlock >> allParents [ ^ self allParentsUpTo: self rootBlock ] -{ #category : #'as yet unclassified' } +{ #category : #queries } DCBlock >> allParentsUpTo: aBlock [ self = aBlock ifTrue: [^ #()]. @@ -201,6 +315,12 @@ DCBlock >> allTextMorphsDo: aBlock [ self allMorphsDo: [:m | m isTextMorph ifTrue: [aBlock value: m]] ] +{ #category : #'query actions' } +DCBlock >> attachHighlight [ + + self queryState highlight: self +] + { #category : #'as yet unclassified' } DCBlock >> blockFor: aRange [ @@ -499,18 +619,46 @@ DCBlock >> insertStatementHasCandidate [ ^ true ] +{ #category : #'as yet unclassified' } +DCBlock >> intoWorld: aWorld [ + + super intoWorld: aWorld. + + self isRootBlock ifTrue: [ + self sandblockEditor + when: #selectionChanged + send: #updateSelectionQueries + to: self queryState] +] + { #category : #'as yet unclassified' } DCBlock >> isBlockBody [ ^ self language blockBodyTypes includes: self type ] +{ #category : #queries } +DCBlock >> isOrHasParent: aCollectionOrSymbol [ + + | matches | + matches := aCollectionOrSymbol isSymbol + ifTrue: [{aCollectionOrSymbol}] + ifFalse: [aCollectionOrSymbol]. + ^ (matches includes: self type) or: [matches includes: self owner type] +] + { #category : #'as yet unclassified' } DCBlock >> isPart [ ^ self highlight notNil and: [self highlight endsWith: '.part'] ] +{ #category : #'as yet unclassified' } +DCBlock >> isRootBlock [ + + ^ self type = self language rootRuleName +] + { #category : #'as yet unclassified' } DCBlock >> isTSBlock [ @@ -577,11 +725,64 @@ DCBlock >> layoutInset [ self isBlockBody ifTrue: [^ 2 @ 2]. + true ifTrue: [^ super layoutInset]. + ^ (self type = 'ERROR' and: [self childSandblocks notEmpty]) ifTrue: [0] ifFalse: [2 @ (self submorphCount > 3 ifTrue: [1] ifFalse: [0])] ] +{ #category : #'as yet unclassified' } +DCBlock >> orAllParents: aCollectionOrSymbol [ + + | matches current res | + matches := aCollectionOrSymbol isSymbol + ifTrue: [{aCollectionOrSymbol}] + ifFalse: [aCollectionOrSymbol]. + + current := self. + res := OrderedCollection new. + [ + (matches includes: current type) ifTrue: [res add: current]. + current isRootBlock ifTrue: [^ res]. + current := current owner] repeat +] + +{ #category : #'as yet unclassified' } +DCBlock >> orAnyParent: aCollectionOrSymbol [ + + | matches | + matches := aCollectionOrSymbol isSymbol + ifTrue: [{aCollectionOrSymbol}] + ifFalse: [aCollectionOrSymbol]. + (matches includes: self type) ifTrue: [^ self]. + self = self rootBlock ifTrue: [^ nil]. + ^ self owner orAnyParent: aCollectionOrSymbol +] + +{ #category : #queries } +DCBlock >> orParent: aCollectionOrSymbol [ + + | matches | + matches := aCollectionOrSymbol isSymbol + ifTrue: [{aCollectionOrSymbol}] + ifFalse: [aCollectionOrSymbol]. + (matches includes: self type) ifTrue: [^ self]. + (matches includes: self owner type) ifTrue: [^ self owner]. + ^ nil +] + +{ #category : #'as yet unclassified' } +DCBlock >> outOfWorld: aWorld [ + + super outOfWorld: aWorld. + + self isRootBlock ifTrue: [ + self sandblockEditor + removeActionsWithReceiver: self queryState + forEvent: #selectionChanged] +] + { #category : #'as yet unclassified' } DCBlock >> ownerWithForegroundColor [ @@ -596,6 +797,33 @@ DCBlock >> pairMap [ ^ Dictionary newFrom: {'(' -> ')'. '''' -> ''''. '"' -> '"'. '`' -> '`'. '{' -> '}'. '[' -> ']'} ] +{ #category : #'as yet unclassified' } +DCBlock >> parentNode [ + + ^ self parentSandblock ifNotNil: [:p | p isTSBlock ifTrue: [p] ifFalse: [nil]] +] + +{ #category : #'actions smalltalk' } +DCBlock >> pasteReplace [ + + + self tryApplyChange: [:source :textMorph :cursorIndex :apply | | str | + str := Clipboard clipboardText string. + self + insert: str + in: source + at: cursorIndex + do: [:new :edit | apply value: new value: edit value: cursorIndex + str size]] +] + +{ #category : #'as yet unclassified' } +DCBlock >> performAction: aSymbol [ + + (super performAction: aSymbol) ifTrue: [^ true]. + + ^ self queryState performShortcut: aSymbol for: self +] + { #category : #'as yet unclassified' } DCBlock >> placeCursorIn: newTree at: newIndex [ @@ -645,9 +873,18 @@ DCBlock >> queryAll: aString [ ^ Array streamContents: [:stream | self allMorphsDo: [:block | - block isTSMorph ifTrue: [ | captures | - captures := nil. - (SBTSQuery new execute: aString against: block capturesDo: [:cap | captures := cap]) ifTrue: [stream nextPut: captures anyOne]]]] + block isTSMorph ifTrue: [ + (SBTSQuery new + prepare: aString; + executeCaptureAgainst: block) do: [:assoc | stream nextPut: assoc value]]]] +] + +{ #category : #accessing } +DCBlock >> queryState [ + + ^ self rootBlock + valueOfProperty: #queryState + ifAbsentPut: [DCQueryState new rootBlock: self] ] { #category : #'as yet unclassified' } @@ -662,6 +899,12 @@ DCBlock >> range: aRange [ range := aRange ] +{ #category : #'query actions' } +DCBlock >> registerShortcut: aSymbol do: aBlock [ + + self queryState tryShortcut: aSymbol do: aBlock +] + { #category : #'as yet unclassified' } DCBlock >> replace: oldTree with: newTree [ @@ -684,8 +927,7 @@ DCBlock >> replace: oldTree with: newTree [ { #category : #'as yet unclassified' } DCBlock >> rootBlock [ - self owner ifNil: [^ self]. - ^ self ownerSatisfying: [:o | o isTSBlock and: [o type = self language rootRuleName]] + ^ self orOwnerSuchThat: [:o | o isTSBlock and: [o type = self language rootRuleName]] ] { #category : #'as yet unclassified' } @@ -890,7 +1132,9 @@ DCBlock >> type [ { #category : #'as yet unclassified' } DCBlock >> type: aSymbol [ - type := aSymbol + type := aSymbol. + + ] { #category : #'as yet unclassified' } @@ -958,6 +1202,7 @@ DCBlock >> wrapInRoundParenthesis [ DCBlock >> wrapInSingleQuotes [ + self halt. self wrapIn: '''' ] diff --git a/packages/DomainCode-Parser/DCMockSlot.class.st b/packages/DomainCode-Parser/DCMockSlot.class.st index 0c11357..eb7de46 100644 --- a/packages/DomainCode-Parser/DCMockSlot.class.st +++ b/packages/DomainCode-Parser/DCMockSlot.class.st @@ -100,10 +100,11 @@ DCMockSlot >> preferredColorIn: aColorPolicy for: aHighlightString [ ['escape'] -> [aColorPolicy literal]. ['punctuation.bracket'] -> [aColorPolicy builtIn]. ['constant.builtin'] -> [aColorPolicy builtIn]. + ['annotation'] -> [aColorPolicy builtIn]. ['operator'] -> [aColorPolicy identifier]. ['property'] -> [aColorPolicy important]. - ['important'] -> [aColorPolicy important]. - ['major_declaration'] -> [aColorPolicy default]} + ['major_declaration'] -> [aColorPolicy default]. + ['important'] -> [aColorPolicy important]} otherwise: [aColorPolicy default] ] diff --git a/packages/DomainCode-Parser/DCQueryState.class.st b/packages/DomainCode-Parser/DCQueryState.class.st new file mode 100644 index 0000000..798b303 --- /dev/null +++ b/packages/DomainCode-Parser/DCQueryState.class.st @@ -0,0 +1,89 @@ +Class { + #name : #DCQueryState, + #superclass : #Object, + #instVars : [ + 'highlights', + 'newHighlights', + 'rootBlock', + 'selectionUpdateQueued', + 'currentShortcut' + ], + #category : #'DomainCode-Parser' +} + +{ #category : #'as yet unclassified' } +DCQueryState >> highlight: aBlock [ + + newHighlights add: aBlock +] + +{ #category : #'as yet unclassified' } +DCQueryState >> initialize [ + + super initialize. + + highlights := WeakSet new. + selectionUpdateQueued := false +] + +{ #category : #'as yet unclassified' } +DCQueryState >> performShortcut: aSymbol for: aBlock [ + + [ + currentShortcut := aSymbol. + self queriesFor: #shortcut do: [:selector | + DCQuery script: (DCBlock perform: selector) with: aBlock. + currentShortcut ifNil: [^ true]]] ensure: [currentShortcut := nil]. + ^ false +] + +{ #category : #'as yet unclassified' } +DCQueryState >> queriesFor: aSymbol do: aBlock [ + + Pragma + withPragmasIn: DCBlock class + do: [:pragma | (pragma keyword = #query: and: [pragma arguments first includes: aSymbol]) ifTrue: [aBlock value: pragma selector]] +] + +{ #category : #'as yet unclassified' } +DCQueryState >> rerunQueriesDo: aBlock [ + + newHighlights := WeakSet new. + aBlock value. + highlights do: [:block | (newHighlights includes: block) ifFalse: [block detachDecorators: SBHighlightDecorator]]. + newHighlights do: [:block | (highlights includes: block) ifFalse: [block attachDecorator: SBHighlightDecorator new]]. + highlights := newHighlights +] + +{ #category : #'as yet unclassified' } +DCQueryState >> rootBlock [ + + ^ rootBlock +] + +{ #category : #'as yet unclassified' } +DCQueryState >> rootBlock: aBlock [ + + rootBlock := aBlock +] + +{ #category : #'as yet unclassified' } +DCQueryState >> tryShortcut: aSymbol do: aBlock [ + + currentShortcut = aSymbol ifTrue: [ + DCQuery script: aBlock value with: self rootBlock sandblockEditor selection. + currentShortcut := nil] +] + +{ #category : #'as yet unclassified' } +DCQueryState >> updateSelectionQueries [ + + selectionUpdateQueued ifTrue: [^ self]. + selectionUpdateQueued := true. + Project current addDeferredUIMessage: [ + selectionUpdateQueued := false. + self rerunQueriesDo: [ + self + queriesFor: #selection + do: [:selector | self rootBlock allBlocksDo: [:b | DCQuery script: (DCBlock perform: selector) with: b]]]] +] diff --git a/packages/DomainCode-Parser/DCText.class.st b/packages/DomainCode-Parser/DCText.class.st index d2a4d2f..6e796ae 100644 --- a/packages/DomainCode-Parser/DCText.class.st +++ b/packages/DomainCode-Parser/DCText.class.st @@ -111,6 +111,12 @@ DCText >> ownerWithForegroundColor [ ifFalse: [self] ] +{ #category : #'as yet unclassified' } +DCText >> parentNode [ + + ^ self owner +] + { #category : #'as yet unclassified' } DCText >> preferredColorIn: aColorPolicy [ diff --git a/packages/Sandblocks-TSSmalltalk/SBStSqueakRuntime.class.st b/packages/Sandblocks-TSSmalltalk/SBStSqueakRuntime.class.st index b2e20b3..d76e7f1 100644 --- a/packages/Sandblocks-TSSmalltalk/SBStSqueakRuntime.class.st +++ b/packages/Sandblocks-TSSmalltalk/SBStSqueakRuntime.class.st @@ -37,7 +37,7 @@ SBStSqueakRuntime >> evaluate: aString [ { #category : #'as yet unclassified' } SBStSqueakRuntime >> prettyPrint: aString [ - ^ [PPFormatter formatString: aString class: nil class noPattern: false] + ^ [PPFormatter formatString: aString class: nil class noPattern: true] on: SyntaxErrorNotification do: [aString] ] diff --git a/packages/Sandblocks-TSSmalltalk/SBTSSmalltalk.class.st b/packages/Sandblocks-TSSmalltalk/SBTSSmalltalk.class.st index 6b91dcf..899c3f5 100644 --- a/packages/Sandblocks-TSSmalltalk/SBTSSmalltalk.class.st +++ b/packages/Sandblocks-TSSmalltalk/SBTSSmalltalk.class.st @@ -91,6 +91,7 @@ SBTSSmalltalk class >> fileSuffix [ { #category : #'configuration - layout' } SBTSSmalltalk class >> gapBetween: aBlock and: anotherBlock [ + aBlock parentSandblock type = 'pragma' ifTrue: [^ false]. anotherBlock type = 'ERROR' ifTrue: [^ false]. ^ super gapBetween: aBlock and: anotherBlock ] @@ -1141,6 +1142,7 @@ SBTSSmalltalk class >> grammarJson [ { #category : #'configuration - layout' } SBTSSmalltalk class >> hardLineBreakBetween: aBlock and: anotherBlock [ + aBlock type = 'pragma' ifTrue: [^ true]. aBlock contents = '.' ifTrue: [^ true]. anotherBlock type = 'ERROR' ifTrue: [^ false]. anotherBlock contents = '.' ifTrue: [^ false]. @@ -1155,8 +1157,8 @@ SBTSSmalltalk class >> hardLineBreakBetween: aBlock and: anotherBlock [ (#(#'keyword_selector' #'unary_selector' #'binary_selector') includes: aBlock type) ifTrue: [^ true]. ((aBlock slot isStatementIn: aBlock parentSandblock) and: [aBlock ~= aBlock parentSandblock childSandblocks last]) ifTrue: [^ true]. (aBlock field = 'receiver' and: [ - aBlock parentSandblock - ifNotNil: [:p | p parentSandblock ifNotNil: [:p2 | p2 type = #cascade]] + (aBlock parentNode + ifNotNil: [:p | p parentNode ifNotNil: [:p2 | p2 type = #cascade]]) ifNil: [false]]) ifTrue: [^ true]. ^ false ] @@ -1167,6 +1169,8 @@ SBTSSmalltalk class >> highlightQuery [ ^ '[(self) (true) (false) (thisContext) (super) (nil)] @keyword +(pragma) @annotation + (number) @number (string) @string @@ -1185,6 +1189,8 @@ SBTSSmalltalk class >> highlightQuery [ ["^" "[" "]" "{" "}"] @important +["(" ")"] @punctuation + (keyword_selector (keyword) @major_declaration.part) @structure.part (binary_selector (binary_operator) @major_declaration.part) @structure.part (unary_selector (unary_identifier) @major_declaration.part) @structure.part diff --git a/packages/Sandblocks-TreeSitter/SBTSQueryChoice.class.st b/packages/Sandblocks-TreeSitter/SBTSQueryChoice.class.st index b911794..b05aab2 100644 --- a/packages/Sandblocks-TreeSitter/SBTSQueryChoice.class.st +++ b/packages/Sandblocks-TreeSitter/SBTSQueryChoice.class.st @@ -23,9 +23,9 @@ SBTSQueryChoice >> elements: aCollection [ SBTSQueryChoice >> evaluateAgainst: aBlock captures: aDictionary [ self elements do: [:element | | captures | - captures := Dictionary new. + captures := aDictionary species new. (element evaluateAgainst: aBlock captures: captures) ifNotNil: [ - aDictionary addAll: captures associations. + aDictionary addAll: (captures isDictionary ifTrue: [captures associations] ifFalse: [captures]). ^ aBlock]]. ^ nil ]