Added build & run, macro expansion, and other actions

src/Carp/CarpCliOutput.class.st

@@ -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
+]

src/Carp/CarpPostMortemDebugger.class.st

@@ -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
-	^ stackFrames ifNil:
+		ifNil: [ ordinal := 1.
-		[ ordinal := 1.
+			stackFrames := OrderedCollection new.
-		stackFrames := OrderedCollection new.
+			(self findTrace: exception trace lines)
-		exception trace lines do: [ :line | 
+				do: [ :line | 
-			(self stackFrameFromLine: line ordinal: ordinal) ifNotNil: [ :frame | 
+					(self stackFrameFromLine: line ordinal: ordinal)
-				stackFrames add: frame.
+						ifNotNil: [ :frame | 
-				ordinal := ordinal + 1 ] ].
+							stackFrames add: frame.
-		stackFrames ].
+							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 }

src/Carp/CarpPostMortemStackFrame.class.st

@@ -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
 ]

src/Carp/GtCarpCoderModel.class.st

@@ -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.
-
+	res := self bindAndExecuteRaw: sourceString.
-	application := carpLinkApplicationStrategy applicationServer.
-	application isRunning ifFalse: [ application start ].
-	commandFactory := application newCommandFactory.
-
-	res := commandFactory
-			<< carpSource;
-			sendAndWait.
 
 	(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
@@ -77,9 +83,10 @@ GtCarpCoderModel >> exception [
 { #category : #accessing }
 GtCarpCoderModel >> initializeAddOns: addOns [
 	super initializeAddOns: addOns.
-	
+
-	addOns addStyler: (GtCoderAstSmaCCParserStyler new smaccStyler: CarpParser gtStyler).
+	addOns
-	
+		addStyler: (GtCoderAstSmaCCParserStyler new smaccStyler: CarpParser gtStyler).
+
 	addOns
 		addMainAction: 'Evaluate' translated
 		icon: BrGlamorousVectorIcons play
@@ -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 }