carpentry/gt4carp
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Added build & run, macro expansion, and other actions

Browse Source
This commit is contained in:
Veit Heller
2022-06-13 17:26:32 +02:00
parent ea5d318b62
commit ee5c032d90
4 changed files with 134 additions and 27 deletions
Download Patch File Download Diff File Expand all files Collapse all files

51
src/Carp/CarpCliOutput.class.st Normal file
View File

@@ -0,0 +1,51 @@
Class {
#name : #CarpCliOutput,
#superclass : #Object,
#instVars : [
'text'
],
#category : #'Carp-Core'
}
{ #category : #accessing }
CarpCliOutput class >> text: aString [
^ self new text: aString
]
{ #category : #accessing }
CarpCliOutput >> gtExitCodeFor: aView [
<gtView>
^ aView forward
title: 'Exit Code';
priority: 2;
object: [ self text lines last asInteger ];
view: #gtLiveFor:
]
{ #category : #accessing }
CarpCliOutput >> gtOutputFor: aView [
<gtView>
^ aView textEditor
title: 'Output';
priority: 1;
text: [ Character lf join: (self text lines allButLast: 2) ]
]
{ #category : #accessing }
CarpCliOutput >> gtRawOutputFor: aView [
<gtView>
^ aView textEditor
title: 'Raw Output';
priority: 3;
text: [ self text ]
]
{ #category : #accessing }
CarpCliOutput >> text [
^ text
]
{ #category : #accessing }
CarpCliOutput >> text: aString [
text := aString
]

45
src/Carp/CarpPostMortemDebugger.class.st
View File

@@ -19,11 +19,20 @@ CarpPostMortemDebugger >> exception: anException [
exception := anException
]
{ #category : #accessing }
CarpPostMortemDebugger >> findTrace: inputLines [
| lines |
lines := inputLines asOrderedCollection.
[ lines isNotEmpty and: [ (lines first = 'Traceback:') not ] ]
whileTrue: [ lines removeFirst ].
^ lines
]
{ #category : #accessing }
CarpPostMortemDebugger >> initialize [
super initialize.
frameRegex := '(.*)\s+at.+([^:]+)\:(\d+)\:(\d+)\.' asRegexIgnoringCase.
frameRegex := '(.*)\s+at\s+([^:]+)\:(\d+)\:(\d+)\.' asRegexIgnoringCase.
]
{ #category : #accessing }
@@ -40,11 +49,10 @@ CarpPostMortemDebugger >> stackFrameFromLine: aString ordinal: ordinal [
| file line column source |
^ (frameRegex search: aString) ifTrue:
[ file := frameRegex subexpression: 2.
[ source := frameRegex subexpression: 2.
file := frameRegex subexpression: 3.
line := frameRegex subexpression: 4.
column := frameRegex subexpression: 5.
self halt.
CarpPostMortemStackFrame new
ordinal: ordinal;
displayString: aString;
@@ -62,17 +70,28 @@ CarpPostMortemDebugger >> stackFrameFromLine: aString ordinal: ordinal [
CarpPostMortemDebugger >> stackFrames [
"Answer a ordered collection of stack frames.
This is called many times by the debugger, so cache"
| ordinal |
^ stackFrames ifNil:
[ ordinal := 1.
stackFrames := OrderedCollection new.
exception trace lines do: [ :line |
(self stackFrameFromLine: line ordinal: ordinal) ifNotNil: [ :frame |
stackFrames add: frame.
ordinal := ordinal + 1 ] ].
stackFrames ].
^ stackFrames
ifNil: [ ordinal := 1.
stackFrames := OrderedCollection new.
(self findTrace: exception trace lines)
do: [ :line |
(self stackFrameFromLine: line ordinal: ordinal)
ifNotNil: [ :frame |
stackFrames add: frame.
ordinal := ordinal + 1 ] ].
(exception trace lines last beginsWith: '[RUNTIME ERROR]')
ifTrue: [ stackFrames
add: (CarpPostMortemStackFrame new
ordinal: 1;
displayString: exception trace lines last;
exception: exception;
source: exception trace lines last;
file: 'REPL' asFileReference;
line: 0;
column: 0) ].
stackFrames ]
]
{ #category : #accessing }

15
src/Carp/CarpPostMortemStackFrame.class.st
View File

@@ -14,5 +14,18 @@ CarpPostMortemStackFrame >> source: aString [
{ #category : #accessing }
CarpPostMortemStackFrame >> sourceText [
^ source
| mySource text indexes lineNumber |
file exists
ifTrue: [ mySource := file contents.
lineNumber := line ]
ifFalse: [ ^ source asRopedText
attribute: (BlTextHighlightAttribute paint: BrGlamorousColors errorBackgroundColor)
beNotOverwritableByStyler ].
text := mySource asRopedText.
indexes := mySource gtIndexOfLineNumber: lineNumber.
indexes
ifNotNil: [ (text from: indexes key + column - 1 to: indexes value)
attribute: (BlTextHighlightAttribute paint: BrGlamorousColors errorBackgroundColor)
beNotOverwritableByStyler ].
^ text
]

46
src/Carp/GtCarpCoderModel.class.st
View File

@@ -4,7 +4,9 @@ Class {
#instVars : [
'pharoBindings',
'carpLinkApplicationStrategy',
'exception'
'exception',
'application',
'commandFactory'
],
#category : #'Carp-Coder'
}
@@ -28,7 +30,7 @@ GtCarpCoderModel >> bindAndExecute: sourceString [
<gtIgnoreConstraint: #GtRBAcceptVisitorCalledFromNonVisitingMethods>
<remoteDebuggerSignal>
| carpSource trimmedSource ast varNames lastStatement application commandFactory res |
| res trimmedSource ast varNames lastStatement carpSource |
trimmedSource := SmaCCString on: sourceString trimRight.
ast := CarpParser parse: trimmedSource. "The variables to be returned are names that are in pharoBindings"
varNames := pharoBindings bindingNames asSet. "Assign the final statement to snippetResult"
@@ -41,14 +43,7 @@ GtCarpCoderModel >> bindAndExecute: sourceString [
carpSource := self
sourceFrom: trimmedSource asString
returnedVarNames: varNames.
application := carpLinkApplicationStrategy applicationServer.
application isRunning ifFalse: [ application start ].
commandFactory := application newCommandFactory.
res := commandFactory
<< carpSource;
sendAndWait.
res := self bindAndExecuteRaw: sourceString.
(res at: #result) = 'success' ifTrue: [ ^ res at: #value ].
exception := (PharoLinkRemoteError new
@@ -58,6 +53,17 @@ GtCarpCoderModel >> bindAndExecute: sourceString [
exception signal
]
{ #category : #accessing }
GtCarpCoderModel >> bindAndExecuteRaw: sourceString [
application := carpLinkApplicationStrategy applicationServer.
application isRunning ifFalse: [ application start ].
commandFactory := application newCommandFactory.
^ commandFactory
<< sourceString;
sendAndWait
]
{ #category : #accessing }
GtCarpCoderModel >> carpLinkApplicationStrategy: anApplicationStrategy [
carpLinkApplicationStrategy := anApplicationStrategy
@@ -78,7 +84,8 @@ GtCarpCoderModel >> exception [
GtCarpCoderModel >> initializeAddOns: addOns [
super initializeAddOns: addOns.
addOns addStyler: (GtCoderAstSmaCCParserStyler new smaccStyler: CarpParser gtStyler).
addOns
addStyler: (GtCoderAstSmaCCParserStyler new smaccStyler: CarpParser gtStyler).
addOns
addMainAction: 'Evaluate' translated
@@ -98,6 +105,23 @@ GtCarpCoderModel >> initializeAddOns: addOns [
element: anElement;
execute ]
id: GtSourceCoderDoItAndGoActionId.
addOns
addMainAction: 'Expand Macros' translated
icon: BrGlamorousVectorIcons repair
action: [ :aCoderUIModel :anElement |
| source |
source := '(expand ''' , sourceCode currentSourceText value text , ')'.
anElement phlow
spawnObject: (CarpParser parse: (aCoderUIModel coder bindAndExecute: source)) ].
addOns
addMainAction: 'Build and Run' translated
icon: BrGlamorousVectorIcons refresh
action: [ :aCoderUIModel :anElement |
| source |
source := '' , sourceCode currentSourceText value text , '(build) (run)'.
anElement phlow
spawnObject: (CarpCliOutput text: ((aCoderUIModel coder bindAndExecuteRaw: source) at: 'value')) ]
id: #'source-coder--macro-expand-action'
]
{ #category : #accessing }