diff --git a/packages/DomainCode-Core/Morph.extension.st b/packages/DomainCode-Core/Morph.extension.st index 9c704ec..e6f2189 100644 --- a/packages/DomainCode-Core/Morph.extension.st +++ b/packages/DomainCode-Core/Morph.extension.st @@ -86,6 +86,18 @@ Morph >> hasChildren [ ^ false ] +{ #category : #'*DomainCode-Core' } +Morph >> isExtra [ + + ^ false +] + +{ #category : #'*DomainCode-Core' } +Morph >> isLineBreak [ + + ^ false +] + { #category : #'*DomainCode-Core' } Morph >> isNode: aNode [ diff --git a/packages/DomainCode-Core/SequenceableCollection.extension.st b/packages/DomainCode-Core/SequenceableCollection.extension.st new file mode 100644 index 0000000..2ed439f --- /dev/null +++ b/packages/DomainCode-Core/SequenceableCollection.extension.st @@ -0,0 +1,9 @@ +Extension { #name : #SequenceableCollection } + +{ #category : #'*DomainCode-Core' } +SequenceableCollection >> overlappingPairsLoopedDo: aBlock [ + "Emit overlapping pairs of my elements into aBlock" + + 1 to: self size - 1 do: [:i | aBlock value: (self at: i) value: (self at: i + 1)]. + self size >= 2 ifTrue: [aBlock value: self last value: self first] +] diff --git a/packages/DomainCode-Diff/DCChawatheScriptGenerator.class.st b/packages/DomainCode-Diff/DCChawatheScriptGenerator.class.st index 24594ea..41d9bd3 100644 --- a/packages/DomainCode-Diff/DCChawatheScriptGenerator.class.st +++ b/packages/DomainCode-Diff/DCChawatheScriptGenerator.class.st @@ -32,7 +32,12 @@ DCChawatheScriptGenerator >> delete: aMorph [ | target | target := aMorph replacedParent - ifNotNil: [:p | p isReplacement ifTrue: [p] ifFalse: [p]] + ifNotNil: [:p | + p isReplacement + ifTrue: [ + p queryState replacementDeleted: p. + p] + ifFalse: [p]] ifNil: [aMorph]. target delete. @@ -131,7 +136,7 @@ DCChawatheScriptGenerator >> lcsWith: x and: y in: aMapping [ { #category : #'as yet unclassified' } DCChawatheScriptGenerator >> logChanges [ - ^ true + ^ false ] { #category : #'as yet unclassified' } diff --git a/packages/DomainCode-Parser/DCBlock.class.st b/packages/DomainCode-Parser/DCBlock.class.st index 14b0706..39f97eb 100644 --- a/packages/DomainCode-Parser/DCBlock.class.st +++ b/packages/DomainCode-Parser/DCBlock.class.st @@ -382,35 +382,14 @@ DCBlock class >> smalltalkDeclaration [ (Symbol lookup: id contents) ifNotNil: [:sym | id containingArtefact methodClass bindingOf: sym - environment: id containingArtefact methodClass environment]]) ifNil: [id containingArtefact ifNotNil: [:m | m methodClass instVarNames detect: [:n | n = id contents] ifNone: [nil]]]. + environment: id containingArtefact methodClass environment]]) ifNil: [id containingArtefact ifNotNil: [:m | m methodClass allInstVarNames detect: [:n | n = id contents] ifNone: [nil]]]. {#args. id. decl}]} ] { #category : #'smalltalk - helpers' } DCBlock class >> smalltalkDeclareBlockLocal: aBlock [ - | block decl | - decl := DCBlock new - type: #identifier; - addMorphBack: (DCText new contents: aBlock contents). - block := aBlock orAnyParent: {#block. #method}. - block childSandblocks - detect: [:b | b type = #temporaries] - ifFound: [:temporaries | - aBlock sandblockEditor do: (SBInsertCommand new - morph: decl; - container: temporaries; - index: temporaries submorphCount)] - ifNone: [ | index | - index := block children findFirst: [:s | s treeLabel = '|']. - aBlock sandblockEditor do: (SBInsertCommand new - morph: (DCBlock new - type: #temporaries; - addMorphBack: (DCText new contents: '|'); - addMorphBack: decl; - addMorphBack: (DCText new contents: '|')); - index: (index = 0 ifTrue: [2] ifFalse: [index + 1]); - container: block)] + self smalltalkDeclareTemporary: aBlock inScopes: #(block method) ] { #category : #'smalltalk - helpers' } @@ -434,28 +413,29 @@ DCBlock class >> smalltalkDeclareInstanceVariable: aBlock [ { #category : #'smalltalk - helpers' } DCBlock class >> smalltalkDeclareTemporary: aBlock [ + self smalltalkDeclareTemporary: aBlock inScopes: #(method) +] + +{ #category : #'smalltalk - helpers' } +DCBlock class >> smalltalkDeclareTemporary: aBlock inScopes: aCollection [ + | block decl | decl := DCBlock new type: #identifier; + language: SBTSSmalltalk; addMorphBack: (DCText new contents: aBlock contents). - block := aBlock orAnyParent: {#method}. + block := aBlock orAnyParent: aCollection. block childSandblocks detect: [:b | b type = #temporaries] ifFound: [:temporaries | - aBlock sandblockEditor do: (SBInsertCommand new - morph: decl; - container: temporaries; - index: temporaries submorphCount)] + temporaries + insert: (' {1} ' format: {decl sourceString}) + atChildIndex: temporaries submorphCount] ifNone: [ | index | index := block children findFirst: [:s | s treeLabel = '|']. - aBlock sandblockEditor do: (SBInsertCommand new - morph: (DCBlock new - type: #temporaries; - addMorphBack: (DCText new contents: '|'); - addMorphBack: decl; - addMorphBack: (DCText new contents: '|')); - index: (index = 0 ifTrue: [2] ifFalse: [index + 1]); - container: block)] + block + insert: ('| {1} |' format: {decl sourceString}) + atChildIndex: (index = 0 ifTrue: [2] ifFalse: [index + 1])] ] { #category : #smalltalk } @@ -550,8 +530,8 @@ DCBlock class >> smalltalkInsertWatch [ x registerShortcut: #wrapWithWatch do: [ { [:expr | - expr class = DCWatch - ifTrue: [expr replaceWith: expr expression sourceString] + expr replacedParent class = DCWatch + ifTrue: [expr replaceWith: expr replacedParent expression sourceString] ifFalse: [expr wrapWithBefore: '(DCWatch report: (' after: ') for: ', UUID new asString storeString, ')']]}]]} ] @@ -837,6 +817,7 @@ DCBlock class >> smalltalkWatch [ [:x | true]. self smalltalkMessageSendSelector. [:selector :message | selector = #report:for:]. + [:selector :message | message childrenHaveErrors not]. [:selector :message | (message parent type = 'parenthesized_expression' ifTrue: [message parent] @@ -916,17 +897,19 @@ DCBlock >> absolutePositionOf: aMorph [ DCBlock >> adaptInput: input in: source at: cursorIndex textMorph: textMorph event: anEvent [ "do not place closing pair characters if they are coming up right after" + | index | + index := cursorIndex isNumber ifTrue: [cursorIndex] ifFalse: [cursorIndex start index]. (self pairMap keyAtValue: input ifAbsent: nil) ifNotNil: [:openChar | - (source at: cursorIndex + 1 ifPresent: [:char | input first = char] ifAbsent: [false]) ifTrue: [ - self owner startInputAtSourceIndex: cursorIndex + 1. + (source at: index + 1 ifPresent: [:char | input first = char] ifAbsent: [false]) ifTrue: [ + self owner startInputAtSourceIndex: index + 1. ^ '']]. self pairMap at: input ifPresent: [:complete | "do not autocomplete quotes in words" - (complete = '''' and: [source at: cursorIndex ifPresent: #isAlphaNumeric ifAbsent: [false]]) ifTrue: [^ input]. + (complete = '''' and: [source at: index ifPresent: #isAlphaNumeric ifAbsent: [false]]) ifTrue: [^ input]. "do not autocomplete after backslash" - (source at: (cursorIndex isNumber ifFalse: [cursorIndex start index] ifTrue: [cursorIndex]) ifPresent: [:c | c = $\] ifAbsent: [false]) ifTrue: [^ input]. + (source at: index ifPresent: [:c | c = $\] ifAbsent: [false]) ifTrue: [^ input]. ^ input, complete]. @@ -1042,7 +1025,7 @@ DCBlock >> applyEdit: edit source: newSource cursorAt: newIndex undoDo: aBlock [ oldTree infoForEditDo: [:source | aBlock value: source - value: [:new :undoEdit :undo | oldTree applyEdit: undoEdit source: new cursorAt: undoEdit newEndByte undoDo: nil]]. + value: [:new :undoEdit :undo | oldTree applyEdit: undoEdit source: new cursorAt: (undoEdit ifNotNil: #newEndByte) undoDo: nil]]. nil])] ifNil: [apply value]. @@ -1070,7 +1053,7 @@ DCBlock >> assertConsecutiveRanges [ m class = DCText ifTrue: [ self assert: m range start index = current. current := m range end index]. - m class = DCLineBreak ifTrue: [ + m isLineBreak ifTrue: [ self assert: m range start index = current. current := m range end index]] ] @@ -1135,6 +1118,12 @@ DCBlock >> childrenDo: aBlock [ ifFalse: [aBlock value: c]] ] +{ #category : #'as yet unclassified' } +DCBlock >> childrenHaveErrors [ + + ^ self childNodes anySatisfy: [:c | c type = 'ERROR'] +] + { #category : #hierarchy } DCBlock >> clearDiffCache [ @@ -1164,6 +1153,16 @@ DCBlock >> containingArtefact [ ifFalse: [self parent ifNotNil: [:b | b containingArtefact]] ] +{ #category : #'as yet unclassified' } +DCBlock >> containsPoint: aPoint [ + + | inside | + (super containsPoint: aPoint) ifFalse: [^ false]. + inside := false. + self borderVertices overlappingPairsLoopedDo: [:a :b | (a y > aPoint y ~= (b y > aPoint y) and: [aPoint x < (b x - a x * (b y - a y) / (b y - a y) + a x)]) ifTrue: [inside := inside not]]. + ^ inside +] + { #category : #'as yet unclassified' } DCBlock >> contentsToDisplay [ @@ -1208,9 +1207,9 @@ DCBlock >> deleteBlock [ self infoForEditDo: [:source :textMorph :cursorIndex | | delRange | delRange := textMorph range. - self trailingTerminator ifNotNil: [:t | - delRange := SBTSRange merging: {delRange. t range}. - (source atPin: delRange end index + 1) = Character cr ifTrue: [delRange := SBTSRange start: delRange start end: delRange end + 1]]. + self trailingTerminator ifNotNil: [:t | | clearUntil | + clearUntil := (t nextMorphThat: [:m | m submorphAfter isNil or: [m submorphAfter isExtra not]]) ifNil: [t]. + delRange := SBTSRange merging: {delRange. clearUntil range}]. self class replace: delRange in: source with: '' do: self applyBlock] ] @@ -1254,7 +1253,7 @@ DCBlock >> drawBackgroundOn: aCanvas [ | policy | policy := self colorPolicy. self allMorphsDo: [:c | - c class = DCLineBreak ifTrue: [ | level | + c isLineBreak ifTrue: [ | level | level := 0. c firstOwnerSuchThat: [:o | level := level + 1. @@ -1517,6 +1516,18 @@ DCBlock >> insert: aString [ self batchedChangeStep ] +{ #category : #'as yet unclassified' } +DCBlock >> insert: aString atChildIndex: aNumber [ + + self infoForEditDo: [:source :textMorph :cursorIndex | + self class + insert: aString + in: source + at: (self children at: aNumber) range start index + 1 + do: self applyBlock]. + self batchedChangeStep +] + { #category : #'as yet unclassified' } DCBlock >> insertCommandRequest: aMorph near: aBlock before: aBoolean [ @@ -1526,45 +1537,21 @@ DCBlock >> insertCommandRequest: aMorph near: aBlock before: aBoolean [ { #category : #'as yet unclassified' } DCBlock >> insertStatementAboveOrBelow: anAboveBoolean [ - (self orOwnerSuchThat: [:morph | morph isTSBlock and: [morph isStatement]]) ifNotNil: [:statement | | target insertSeparatorAfter indent point index | - target := (anAboveBoolean not and: [(statement submorphAfter ifNotNil: #treeLabel) = self language statementTerminator]) - ifTrue: [ - insertSeparatorAfter := true. - statement submorphAfter] - ifFalse: [ - "if we do not have a trailing dot, we need to insert the dot before the element" - insertSeparatorAfter := anAboveBoolean. - statement]. - - indent := ''. - [ | cur | - cur := target morphBeforeOrAfter: anAboveBoolean. - [cur notNil and: [cur isExtra and: [anAboveBoolean not or: [cur class ~= DCLineBreak]]]] whileTrue: [ - indent := indent, (cur treeLabel select: [:c | c = Character space or: [c = Character tab]]). - cur := cur morphBeforeOrAfter: anAboveBoolean]] value. - - point := anAboveBoolean ifTrue: [target range start] ifFalse: [target range end]. - index := point index. - self infoForEditDo: [:source | - self class - insert: String cr, indent - in: source - at: index + 1 - do: (self applyBlockWithCursor: index + (anAboveBoolean ifTrue: [-1] ifFalse: [2]) + indent size). - SBToggledCode comment: '' active: 0 do: { - [ - self sandblockEditor do: (SBRelInsertCommand new - near: (target owner submorphs detect: [:m | - anAboveBoolean - ifTrue: [m range start index = index] - ifFalse: [m range end index = (index + (1 + indent size))]]) - before: anAboveBoolean - in: statement owner - morph: (DCEmptyStatement new - language: self language; - range: (SBTSRange point: (anAboveBoolean ifTrue: [point] ifFalse: [point + 1 + indent size])); - insertSeparatorAfter: insertSeparatorAfter; - contents: ''))]}]] + | lineBreak target | + target := self activeTextMorph ifNil: [self]. + lineBreak := anAboveBoolean + ifTrue: [target previousMorphThat: [:c | c isLineBreak]] + ifFalse: [target nextMorphThat: [:c | c isLineBreak]]. + + lineBreak ifNil: [^ self]. + lineBreak containingSandblock containingArtefact = self containingArtefact ifFalse: [^ self]. + + self infoForEditDo: [:source :textMorph :cursorIndex | + self class + insert: String cr, lineBreak getIndentString + in: source + at: lineBreak range start index + 1 + do: (self applyBlockWithCursor: lineBreak range start index + 2)] ] { #category : #'as yet unclassified' } @@ -1722,7 +1709,7 @@ DCBlock >> keyStroke: anEvent [ (input first isPrintable and: [anEvent commandKeyPressed not]) ifTrue: [ (self adaptInput: input in: source at: cursorIndex textMorph: textMorph event: anEvent) ifNotEmpty: [:text | self class - insert: text + insert: (self maybeAddSeparator: text textMorph: textMorph) in: source at: cursorIndex + 1 do: (self applyBlockWithCursor: cursorIndex + (text indexOf: anEvent keyCharacter))]]]. @@ -1757,7 +1744,7 @@ DCBlock >> layoutCommands [ { #category : #'as yet unclassified' } DCBlock >> layoutInset [ - SBToggledCode comment: '' active: 1 do: {[true ifTrue: [^ 2 @ 1]]}. + SBToggledCode comment: '' active: 1 do: {[true ifTrue: [^ 1 @ 1]]}. self isBlockBody ifTrue: [^ 4 @ 3]. @@ -1766,6 +1753,13 @@ DCBlock >> layoutInset [ ifFalse: [2 @ (self submorphCount > 3 ifTrue: [2] ifFalse: [0])] ] +{ #category : #'as yet unclassified' } +DCBlock >> maybeAddSeparator: input textMorph: aTextMorph [ + + aTextMorph isLineBreak ifTrue: [^ input, self language statementTerminator]. + ^ input +] + { #category : #'as yet unclassified' } DCBlock >> minBoundsWith: info [ @@ -1773,6 +1767,15 @@ DCBlock >> minBoundsWith: info [ ^ info bounds ] +{ #category : #'as yet unclassified' } +DCBlock >> nonExtraChildrenBounds [ + + | box | + self submorphs do: [:m | m isExtra ifFalse: [box ifNil: [box := m fullBounds copy] ifNotNil: [box := box quickMerge: m fullBounds]]]. + box ifNil: [^ self bounds]. + ^ box +] + { #category : #hierarchy } DCBlock >> orAllParents: aCollectionOrSymbol [ @@ -1797,6 +1800,7 @@ DCBlock >> orAnyParent: aCollectionOrSymbol [ ifTrue: [{aCollectionOrSymbol}] ifFalse: [aCollectionOrSymbol]. (matches includes: self type) ifTrue: [^ self]. + self parent ifNil: [^ nil]. self isRootBlock ifTrue: [^ nil]. self parent isTSMorph ifFalse: [^ nil]. ^ self parent orAnyParent: aCollectionOrSymbol @@ -1907,7 +1911,7 @@ DCBlock >> prefersNoBorder [ { #category : #'as yet unclassified' } DCBlock >> prettyPrint [ - self infoForEditDo: [:source | | new | + self infoForEditDo: [:source :textMorph :index | | new | new := [ PPFormatter formatString: source @@ -1916,11 +1920,12 @@ DCBlock >> prettyPrint [ on: SyntaxErrorNotification do: [source]. source = new ifFalse: [ - self - applyEdit: nil - source: new - cursorAt: 1 - undoDo: [:undoSource :block | block value: source value: nil value: nil]]] + self restoreCursorAfter: [ + self + applyEdit: nil + source: new + cursorAt: index start index + undoDo: [:undoSource :block | block value: source value: nil value: nil]]]] ] { #category : #'as yet unclassified' } @@ -2060,6 +2065,12 @@ DCBlock >> registerShortcut: aSymbol do: aBlock [ self queryState tryShortcut: aSymbol do: aBlock ] +{ #category : #'as yet unclassified' } +DCBlock >> rejectsEvent: anEvent [ + + ^ (self containsPoint: anEvent position) not +] + { #category : #'as yet unclassified' } DCBlock >> reloadArtefact [ @@ -2128,6 +2139,20 @@ DCBlock >> resolveSource [ ^ self ] +{ #category : #'as yet unclassified' } +DCBlock >> restoreCursorAfter: aBlock [ + + | current textMorph index editor | + editor := self sandblockEditor. + current := editor selection. + textMorph := current activeTextMorph. + index := textMorph ifNotNil: #cursor. + aBlock value. + textMorph + ifNotNil: [editor startInput: current at: index replacingContents: false in: textMorph] + ifNil: [current select] +] + { #category : #'as yet unclassified' } DCBlock >> rootBlock [ @@ -2154,6 +2179,39 @@ DCBlock >> saveTryFixing: aFixBoolean quick: aQuickBoolean [ ^ true ] +{ #category : #'as yet unclassified' } +DCBlock >> selectRightMostBlock [ + + + + | lineBreak | + self activeTextMorph isLineBreak ifTrue: [^ self]. + + lineBreak := (self activeTextMorph ifNil: [self]) nextMorphThat: [:m | m isLineBreak]. + (lineBreak isNil or: [lineBreak containingSandblock containingFloat ~= self containingFloat]) ifTrue: [^ self containingFloat lastDeepChild startInputAtEnd]. + self sandblockEditor + startInput: lineBreak containingSandblock + at: 1 + replacingContents: false + in: lineBreak +] + +{ #category : #'as yet unclassified' } +DCBlock >> selectStartOfStatement [ + + + + | lineBreak first | + lineBreak := (self activeTextMorph ifNil: [self]) previousMorphThat: [:m | m isLineBreak]. + (lineBreak isNil or: [lineBreak containingSandblock containingFloat ~= self containingFloat]) ifTrue: [^ self containingFloat firstDeepChild startInputAtStart]. + first := lineBreak nextMorphThat: [:m | m isExtra not]. + self sandblockEditor + startInput: first containingSandblock + at: 1 + replacingContents: false + in: first +] + { #category : #'as yet unclassified' } DCBlock >> shallowCopyBlock [ diff --git a/packages/DomainCode-Parser/DCEditTest.class.st b/packages/DomainCode-Parser/DCEditTest.class.st index d9b9b7e..7f18803 100644 --- a/packages/DomainCode-Parser/DCEditTest.class.st +++ b/packages/DomainCode-Parser/DCEditTest.class.st @@ -149,7 +149,7 @@ DCEditTest >> testSmalltalkSwapStatementsWithEmpty [ | program editor | program := DCBlock parse: 'a -b . +b. c.' language: SBTSSmalltalk. editor := self editorAndWorldFor: program. diff --git a/packages/DomainCode-Parser/DCEmptyStatement.class.st b/packages/DomainCode-Parser/DCEmptyStatement.class.st deleted file mode 100644 index 823baba..0000000 --- a/packages/DomainCode-Parser/DCEmptyStatement.class.st +++ /dev/null @@ -1,73 +0,0 @@ -Class { - #name : #DCEmptyStatement, - #superclass : #DCReplacement, - #instVars : [ - 'after' - ], - #category : #'DomainCode-Parser' -} - -{ #category : #'as yet unclassified' } -DCEmptyStatement >> adaptInput: input in: source at: cursorIndex textMorph: textMorph event: anEvent [ - - | text | - text := super adaptInput: input in: source at: cursorIndex textMorph: textMorph event: anEvent. - ^ self addSeparator: text -] - -{ #category : #'as yet unclassified' } -DCEmptyStatement >> addSeparator: aString [ - - ^ self insertSeparatorAfter - ifTrue: [aString, self language statementTerminator] - ifFalse: [self language statementTerminator, aString] -] - -{ #category : #'as yet unclassified' } -DCEmptyStatement >> after [ - - ^ after ifNil: [false] -] - -{ #category : #'as yet unclassified' } -DCEmptyStatement >> insert: aString [ - - super insert: (self addSeparator: aString) -] - -{ #category : #'as yet unclassified' } -DCEmptyStatement >> insertSeparatorAfter [ - - ^ self language isStatementTerminatorBetween not or: [after ifNil: [true]] -] - -{ #category : #'as yet unclassified' } -DCEmptyStatement >> insertSeparatorAfter: aBoolean [ - - after := aBoolean -] - -{ #category : #'as yet unclassified' } -DCEmptyStatement >> pasteReplace [ - - - self infoForEditDo: [:source :textMorph :cursorIndex | | str | - str := Clipboard clipboardText string. - str := self insertSeparatorAfter - ifTrue: [str, self language statementTerminator] - ifFalse: [self language statementTerminator, str]. - - self class insert: str in: source at: cursorIndex + 1 do: self applyBlock] -] - -{ #category : #'as yet unclassified' } -DCEmptyStatement >> range: aRange [ - - -] - -{ #category : #'as yet unclassified' } -DCEmptyStatement >> type [ - - ^ #empty -] diff --git a/packages/DomainCode-Parser/DCJumpPlaceholder.class.st b/packages/DomainCode-Parser/DCJumpPlaceholder.class.st index b698fb0..9249a6d 100644 --- a/packages/DomainCode-Parser/DCJumpPlaceholder.class.st +++ b/packages/DomainCode-Parser/DCJumpPlaceholder.class.st @@ -16,13 +16,18 @@ DCJumpPlaceholder >> initialize [ DCJumpPlaceholder >> keyStroke: anEvent [ (anEvent keyCharacter isPrintable and: [anEvent commandKeyPressed not]) ifTrue: [ - self source infoForEditDo: [:source :textMorph :cursorIndex | - self source replaceWith: (self source + self source infoForEditDo: [:source :textMorph :cursorIndex | | text | + text := self source adaptInput: anEvent keyCharacter asString in: source at: cursorIndex textMorph: textMorph - event: anEvent)]]. + event: anEvent. + DCBlock + replace: self source range + in: source + with: text + do: (self source applyBlockWithCursor: self source range start index + (text indexOf: anEvent keyCharacter))]]. self batchedChangeStep ] @@ -30,14 +35,7 @@ DCJumpPlaceholder >> keyStroke: anEvent [ DCJumpPlaceholder >> pasteReplace [ - self infoForEditDo: [:source :textMorph :cursorIndex | | str | - str := Clipboard clipboardText string. - - self - replace: self range - in: source - with: str - do: [:new :edit | self applyEdit: edit source: new cursorAt: cursorIndex + str size]] + self source pasteReplace ] { #category : #'as yet unclassified' } diff --git a/packages/DomainCode-Parser/DCLayout.class.st b/packages/DomainCode-Parser/DCLayout.class.st index 9a43ed3..7164d98 100644 --- a/packages/DomainCode-Parser/DCLayout.class.st +++ b/packages/DomainCode-Parser/DCLayout.class.st @@ -29,7 +29,7 @@ DCLayout >> layout: aMorph in: newBounds [ aMorph submorphsDo: [:morph | | extent | extent := morph minExtent. line add: morph. - morph class = DCLineBreak + morph isLineBreak ifTrue: [flushLine value] ifFalse: [lineHeight := lineHeight max: extent y]]. flushLine value @@ -45,7 +45,7 @@ DCLayout >> minExtentOf: aMorph in: newBounds [ lineLength := 0. aMorph submorphsDo: [:morph | | extent | extent := morph minExtent. - morph class = DCLineBreak ifTrue: [ + morph isLineBreak ifTrue: [ y := y + lineHeight. lineHeight := 0. lineLength := lineLength max: x. diff --git a/packages/DomainCode-Parser/DCLayoutInfo.class.st b/packages/DomainCode-Parser/DCLayoutInfo.class.st index 5f5fa97..7c951c1 100644 --- a/packages/DomainCode-Parser/DCLayoutInfo.class.st +++ b/packages/DomainCode-Parser/DCLayoutInfo.class.st @@ -73,7 +73,7 @@ DCLayoutInfo >> layoutRoot: aMorph at: aPoint [ line do: [:tuple | | bounds | bounds := tuple size = 3 ifTrue: [tuple second @ (lineStartY + baseline) extent: tuple third] - ifFalse: [tuple first submorphBounds expandBy: tuple first layoutInset asEdgeInsets]. + ifFalse: [tuple first nonExtraChildrenBounds expandBy: tuple first layoutInset asEdgeInsets]. tuple first setBoundsDirect: bounds. y := y max: bounds bottom. tuple size = 3 ifTrue: [tuple first doLayoutIn: bounds]]. @@ -84,19 +84,19 @@ DCLayoutInfo >> layoutRoot: aMorph at: aPoint [ baseline := 0]. morphs viewAllButFirstAndLast do: [:m | - m class + true caseOf: { - [Array] -> [ | inset | + [m class = Array] -> [ | inset | "leave" line add: {m second. x}. inset := m second layoutInset asEdgeInsets. x := x + inset right. y := y - inset top. lineStart := lineStart - inset left]. - [DCLineBreak] -> [ + [m isLineBreak] -> [ line add: {m. x. m minExtent}. flushLine value]. - [DCBlock] -> [ | inset | + [m class = DCBlock] -> [ | inset | inset := m layoutInset asEdgeInsets. x := x + inset left. y := y + inset top. diff --git a/packages/DomainCode-Parser/DCLineBreak.class.st b/packages/DomainCode-Parser/DCLineBreak.class.st index ec4ed4b..b430894 100644 --- a/packages/DomainCode-Parser/DCLineBreak.class.st +++ b/packages/DomainCode-Parser/DCLineBreak.class.st @@ -4,6 +4,30 @@ Class { #category : #'DomainCode-Parser' } +{ #category : #'as yet unclassified' } +DCLineBreak >> getIndentString [ + + | s current | + s := ''. + current := self submorphAfter. + [current notNil and: [current isExtra]] whileTrue: [ + s := s, current contents. + current := current submorphAfter]. + ^ s +] + +{ #category : #nil } +DCLineBreak >> isLineBreak [ + + ^ true +] + +{ #category : #'as yet unclassified' } +DCLineBreak >> keyStroke: anEvent [ + + self halt +] + { #category : #'as yet unclassified' } DCLineBreak >> printOn: aStream [ diff --git a/packages/DomainCode-Parser/DCQueryState.class.st b/packages/DomainCode-Parser/DCQueryState.class.st index 3b25e75..36869c7 100644 --- a/packages/DomainCode-Parser/DCQueryState.class.st +++ b/packages/DomainCode-Parser/DCQueryState.class.st @@ -30,11 +30,15 @@ DCQueryState >> addSuggestions: aCollection for: aBlock [ DCQueryState >> ensureReplacement: aClass for: aBlock embed: aClosure initDo: anotherClosure [ | replacement | + " do not replace off-screen nodes " + aBlock sandblockEditor ifNil: [^ self]. + replacement := (aBlock class = aClass or: [(aBlock replacedParent ifNotNil: #class) = aClass]) ifFalse: [ | r hadFocus | hadFocus := (aBlock sandblockEditor ifNotNil: #textFocus) ifNotNil: [:t | (t ownerSatisfying: [:o | o = aBlock]) notNil] ifNil: [false]. + r := aClass new. aBlock replacedParent: r. aBlock replaceBy: r. @@ -124,6 +128,13 @@ DCQueryState >> queueUpdateQueriesFor: aSymbol [ at: Time millisecondClockValue ] +{ #category : #'as yet unclassified' } +DCQueryState >> replacementDeleted: aReplacement [ + + aReplacement passiveUninstall. + self triggers do: [:t | (transientReplacements at: t) remove: aReplacement ifAbsent: []] +] + { #category : #'as yet unclassified' } DCQueryState >> reportError: aDecorator for: aBlock [ @@ -159,6 +170,16 @@ DCQueryState >> suggestionsFor: aBlock [ ^ suggestions key = aBlock ifTrue: [suggestions value] ifFalse: [{}] ] +{ #category : #'as yet unclassified' } +DCQueryState >> textQueriesFor: aSymbol do: aBlock [ + + querySourceOverride ifNotNil: [^ querySourceOverride value: aSymbol value: aBlock]. + + Pragma + withPragmasIn: DCBlock class + do: [:pragma | (pragma keyword = #query: and: [pragma arguments first = aSymbol and: [pragma method hasPragma: #text]]) ifTrue: [aBlock value: (DCBlock perform: pragma selector)]] +] + { #category : #'as yet unclassified' } DCQueryState >> triggers [ @@ -211,7 +232,10 @@ DCQueryState >> updateQueriesFor: aSymbol [ self rerunQueriesFor: aSymbol do: [ self queriesFor: aSymbol - do: [:script | self rootBlock allChildrenDo: [:b | b isSandblock ifTrue: [DCQuery script: script with: b]]]] + do: [:script | self rootBlock allChildrenDo: [:b | b isSandblock ifTrue: [DCQuery script: script with: b]]]. + self + textQueriesFor: aSymbol + do: [:script | self rootBlock allChildrenDo: [:b | b isTextMorph ifTrue: [DCQuery script: script with: b]]]] ] { #category : #'as yet unclassified' } diff --git a/packages/DomainCode-Parser/DCReplacement.class.st b/packages/DomainCode-Parser/DCReplacement.class.st index 4dc2e91..927119a 100644 --- a/packages/DomainCode-Parser/DCReplacement.class.st +++ b/packages/DomainCode-Parser/DCReplacement.class.st @@ -155,7 +155,7 @@ DCReplacement >> layoutCommands [ DCReplacement >> passiveUninstall [ | hadFocus | - currentEmbeds ifNotNil: [:e | e do: [:embed | embed = self source ifFalse: [embed replacedParent uninstall]]]. + self uninstallEmbeds. self source ifNotNil: [self source replacedParent: nil]. self sandblockEditor ifNil: [^ self]. @@ -262,6 +262,12 @@ DCReplacement >> type [ ^ '' ] +{ #category : #'as yet unclassified' } +DCReplacement >> uninstallEmbeds [ + + currentEmbeds ifNotNil: [:e | e do: [:embed | embed = self source ifFalse: [embed replacedParent uninstall]]] +] + { #category : #'as yet unclassified' } DCReplacement >> updateEmbeds [ diff --git a/packages/DomainCode-Parser/DCText.class.st b/packages/DomainCode-Parser/DCText.class.st index 08a80a6..fb15334 100644 --- a/packages/DomainCode-Parser/DCText.class.st +++ b/packages/DomainCode-Parser/DCText.class.st @@ -59,6 +59,12 @@ DCText >> ensureLayouted [ self owner ensureLayouted ] +{ #category : #'as yet unclassified' } +DCText >> ensureReplacement: aClass initDo: aBlock [ + + self queryState ensureReplacement: aClass for: self embed: [:m | {}] initDo: aBlock +] + { #category : #'as yet unclassified' } DCText >> field [ @@ -149,10 +155,21 @@ DCText >> isTSMorph [ ^ true ] +{ #category : #'as yet unclassified' } +DCText >> isTSSymbol [ + ^false +] + +{ #category : #'as yet unclassified' } +DCText >> isTextMorph [ + + ^ (self contents allSatisfy: [:t | t = Character tab]) not or: [self contents isEmpty] +] + { #category : #'as yet unclassified' } DCText >> language [ - ^ self containingSandblock language + ^ self parent language ] { #category : #'as yet unclassified' } @@ -166,7 +183,7 @@ DCText >> ownerWithForegroundColor [ { #category : #'as yet unclassified' } DCText >> parent [ - ^ self owner + ^ self replacedParent ifNotNil: [:p | p isReplacement ifTrue: [p owner] ifFalse: [p]] ifNil: [self parentSandblock] ] { #category : #'as yet unclassified' } @@ -196,6 +213,14 @@ DCText >> printTreeOn: aStream indent: aNumber [ aStream nextPutAll: '"' ] +{ #category : #'as yet unclassified' } +DCText >> queryState [ + + ^ self rootBlock + valueOfProperty: #queryState + ifAbsentPut: [DCQueryState new rootBlock: self] +] + { #category : #'as yet unclassified' } DCText >> range [ @@ -211,7 +236,19 @@ DCText >> range: aRange [ { #category : #'as yet unclassified' } DCText >> replacedParent [ - ^ nil + ^ self valueOfProperty: #replacedParent +] + +{ #category : #'as yet unclassified' } +DCText >> replacedParent: aBlock [ + + self setProperty: #replacedParent toValue: aBlock +] + +{ #category : #'as yet unclassified' } +DCText >> resolveSource [ + + ^ self ] { #category : #'as yet unclassified' } diff --git a/packages/DomainCode-Parser/DCWatch.class.st b/packages/DomainCode-Parser/DCWatch.class.st index a016ce0..c2125c5 100644 --- a/packages/DomainCode-Parser/DCWatch.class.st +++ b/packages/DomainCode-Parser/DCWatch.class.st @@ -70,7 +70,9 @@ DCWatch >> exampleStopped: anExample [ { #category : #'as yet unclassified' } DCWatch >> expression [ - ^ (self source type = 'parenthesized_expression' ifTrue: [self source childSandblocks first] ifFalse: [self source]) children third + ^ (self source type = 'parenthesized_expression' + ifTrue: [self source childNodes second] + ifFalse: [self source]) childNodes third ] { #category : #'as yet unclassified' } diff --git a/packages/Sandblocks-TreeSitter/SBTreeSitter.class.st b/packages/Sandblocks-TreeSitter/SBTreeSitter.class.st index 0ae6029..75eeed0 100644 --- a/packages/Sandblocks-TreeSitter/SBTreeSitter.class.st +++ b/packages/Sandblocks-TreeSitter/SBTreeSitter.class.st @@ -576,11 +576,11 @@ SBTreeSitter >> textBetween: aNode and: anEndNode [ ^ self textBetweenIndex: (aNode ifNil: [ | parent | - parent := self nodeParent: anEndNode. self assert: anEndNode notNil. + parent := self nodeParent: anEndNode. - " the root (node without a parent) starts after all whitespace, so special-case this " - (self nodeIsNull: (self nodeParent: parent)) + " the root (node without a parent) starts after all whitespace, so special-case this " + ((self nodeIsNull: parent) or: [self nodeIsNull: (self nodeParent: parent)]) ifTrue: [1] ifFalse: [(self nodeStartByte: parent) + 1 max: 1]] ifNotNil: [(self nodeEndByte: aNode) + 1])